Index: LMDZ6/trunk/libf/phylmd/inlandsis/inlandsis.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/inlandsis.F	(revision 5084)
+++ 	(revision )
@@ -1,1510 +1,0 @@
-      subroutine INLANDSIS(SnoMod,BloMod,jjtime,debut)
-
-      USE dimphy
-
-!--------------------------------------------------------------------------+
-!     INLANDSIS module                                                     |
-!     Simplified SISVAT module, containing ice and snow processes for      |
-!     ice-covered surfaces                                                 |
-!     version MARv3, november 2020                                         |
-!     SubRoutine INLANDSIS contains the fortran 77 code of the             |
-!                Soil/Ice Snow Vegetation Atmosphere Transfer Scheme       |
-!                                                                          |
-!--------------------------------------------------------------------------+
-!     PARAMETERS:  klonv: Total Number of columns =                        |
-!     ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-!                       X       Number of Mosaic Cell per grid box         |
-!                                                                          |
-!     INPUT:   daHost   : Date Host Model                                  |
-!     ^^^^^                                                                |
-!                                                                          |
-!     INPUT:   LSmask   : 1:          Land       MASK                      |
-!     ^^^^^               0:          Sea        MASK                      |
-!              isotSV   = 0,...,12:   Soil       Type                      |
-!                         0:          Water,          Liquid (Sea, Lake)   |
-!                        12:          Water, Solid           (Ice)         |
-!                                                                          |
-!     INPUT:   coszSV   : Cosine of the Sun Zenithal Distance          [-] |
-!     ^^^^^    sol_SV   : Surface Downward  Solar      Radiation    [W/m2] |
-!              IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |
-!              drr_SV   : Rain  Intensity                        [kg/m2/s] |
-!              dsn_SV   : Snow  Intensity                      [mm w.e./s] |
-!              dsnbSV   : Snow  Intensity,  Drift Fraction             [-] |
-!              dbs_SV   : Drift Amount                           [mm w.e.] |
-!              za__SV   : Surface Boundary Layer (SBL) Height          [m] |
-!              VV__SV   :(SBL Top)   Wind Velocity                   [m/s] |
-!              TaT_SV   : SBL Top    Temperature                       [K] |
-!              rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
-!              QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
-!              qsnoSV   : SBL Mean   Snow      Content             [kg/kg] |
-!              alb0SV   : Soil Basic Albedo                            [-] |
-!              slopSV   : Surface    Slope                             [-] |
-!              dt__SV   : Time  Step                                   [s] |
-!                                                                          |
-!     INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
-!     OUTPUT:  ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
-!     ^^^^^^   iiceSV   = total Nb of Ice      Layers                      |
-!              istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
-!                                                                          |
-!     INPUT /  alb_SV   : Surface        Albedo                        [-] |
-!     OUTPUT:  emi_SV   : Surface        Emissivity                    [-] |
-!     ^^^^^^   IRs_SV   : Soil           IR Flux  (negative)        [W/m2] |
-!              LMO_SV   : Monin-Obukhov               Scale            [m] |
-!              us__SV   : Friction          Velocity                 [m/s] |
-!              uts_SV   : Temperature       Turbulent Scale          [m/s] |
-!              uqs_SV   : Specific Humidity Velocity                 [m/s] |
-!              uss_SV   : Blowing Snow      Turbulent Scale          [m/s] |
-!              usthSV   : Blowing Snow      Erosion   Threshold      [m/s] |
-!              Z0m_SV   : Momentum     Roughness Length                [m] |
-!              Z0mmSV   : Momentum     Roughness Length (time mean)    [m] |
-!              Z0mnSV   : Momentum     Roughness Length (instantaneous)[m] |
-!              Z0SaSV   : Sastrugi     Roughness Length                [m] |
-!              Z0e_SV   : Erosion Snow Roughness Length                [m] |
-!              Z0emSV   : Erosion Snow Roughness Length (time mean)    [m] |
-!              Z0enSV   : Erosion Snow Roughness Length (instantaneous)[m] |
-!              Z0roSV   : Subgrid Topo Roughness Length                [m] |
-!              Z0h_SV   : Heat         Roughness Length                [m] |
-!              TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
-!                       & Snow     Temperatures (layers  1,2,...,nsno) [K] |
-!              ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
-!              eta_SV   : Soil/Snow Water   Content                [m3/m3] |
-!              G1snSV   : snow dendricity/sphericity                       |
-!              G2snSV   : snow sphericity/grain size                       |
-!              dzsnSV   : Snow Layer        Thickness                  [m] |
-!              agsnSV   : Snow       Age                             [day] |
-!              BufsSV   : Snow Buffer Layer              [kg/m2] .OR. [mm] |
-!              BrosSV   : Snow Buffer Layer Density      [kg/m3]           |
-!              BG1sSV   : Snow Buffer Layer Dendricity / Sphericity    [-] |
-!              BG2sSV   : Snow Buffer Layer Sphericity / Size [-] [0.1 mm] |
-!              rusnSV   : Surficial   Water              [kg/m2] .OR. [mm] |
-!                                                                          |
-!     OUTPUT:  no__SV   : OUTPUT file Unit Number                      [-] |
-!     ^^^^^^   i___SV   : OUTPUT point   i Coordinate                  [-] |
-!              j___SV   : OUTPUT point   j Coordinate                  [-] |
-!              n___SV   : OUTPUT point   n Coordinate                  [-] |
-!              lwriSV   : OUTPUT point vec Index                       [-] |
-!                                                                          |
-!     OUTPUT:  IRu_SV   : Upward     IR Flux (+, upw., effective)      [K] |
-!     ^^^^^^   hSalSV   : Saltating Layer Height                       [m] |
-!              qSalSV   : Saltating Snow  Concentration            [kg/kg] |
-!              RnofSV   : RunOFF Intensity                       [kg/m2/s] |
-!                                                                          |
-!     Internal Variables:                                                  |
-!     ^^^^^^^^^^^^^^^^^^                                                   |
-!              NLaysv   = New            Snow Layer Switch             [-] |
-!              albisv   : Snow/Ice/Water/Soil Integrated Albedo        [-] |
-!              SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
-!              TBr_sv   : Brightness Temperature                       [K] |
-!              IRupsv   : Upward     IR Flux (-, upw.)              [W/m2] |
-!              ram_sv   : Aerodynamic Resistance for Momentum        [s/m] |
-!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
-!              Evp_sv   : Evaporation                              [kg/m2] |
-!              EvT_sv   : Evapotranspiration                       [kg/m2] |
-!              HSs_sv   : Surface    Sensible Heat Flux + => absorb.[W/m2] |
-!              HLs_sv   : Surface    Latent   Heat Flux + => absorb.[W/m2] |
-!              Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
-!              Tsrfsv   : Surface    Temperature                       [K] |
-!              sEX_sv   : Verticaly Integrated Extinction Coefficient  [-] |
-!              LSdzsv   : Vertical   Discretization Factor             [-] |
-!                       =    1. Soil                                       |
-!                       = 1000. Ocean                                      |
-!              z_snsv   : Snow Pack  Thickness                         [m] |
-!              zzsnsv   : Snow Pack  Thickness                         [m] |
-!              albssv   : Soil       Albedo                            [-] |
-!              Eso_sv   : Soil+Snow       Emissivity                   [-] |
-!              Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
-!                                                                          |
-!              ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |
-!              ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |
-!              ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |
-!              EqSn_0   : Snow      Energy, before Phase Change     [J/m2] |
-!              EqSn_1   : Snow      Energy, after  Phase Change     [J/m2] |
-!              EqSn_d   : Snow      Energy,       net    Forcing    [J/m2] |
-!              Enrsvd   : SVAT      Energy Power         Forcing    [W/m2] |
-!              Enrbal   : SVAT      Energy Balance                  [W/m2] |
-!              Wats_0   : Soil Water,  before Forcing                 [mm] |
-!              Wats_1   : Soil Water,  after  Forcing                 [mm] |
-!              Wats_d   : Soil Water          Forcing                 [mm] |
-!              SIWm_0   : Snow        initial Mass               [mm w.e.] |
-!              SIWm_1   : Snow        final   Mass               [mm w.e.] |
-!              SIWa_i   : Snow Atmos. initial Forcing            [mm w.e.] |
-!              SIWa_f   : Snow Atmos. final   Forcing(noConsumed)[mm w.e.] |
-!              SIWe_i   : SnowErosion initial Forcing            [mm w.e.] |
-!              SIWe_f   : SnowErosion final   Forcing(noConsumed)[mm w.e.] |
-!              SIsubl   : Snow sublimed/deposed  Mass            [mm w.e.] |
-!              SImelt   : Snow Melted            Mass            [mm w.e.] |
-!              SIrnof   : Surficial Water + Run OFF Change       [mm w.e.] |
-!              SIvAcr   : Sea-Ice    vertical Acretion           [mm w.e.] |
-!              Watsvd   : SVAT Water          Forcing                 [mm] |
-!              Watbal   : SVAT Water  Balance                       [W/m2] |
-!                                                                          |
-!              vk2      : Square of Von Karman Constant                [-] |
-!              sqrCm0   : Factor of   Neutral Drag Coeffic.Momentum  [s/m] |
-!              sqrCh0   : Factor of   Neutral Drag Coeffic.Heat      [s/m] |
-!              EmiSol   : Soil          Emissivity                     [-] |
-!              EmiSno   : Snow          Emissivity                     [-] |
-!              EmiWat   : Water         Emissivity                     [-] |
-!              Z0mLnd   :          Land Roughness Length               [m] |
-!              sqrrZ0   : u*t/u*                                           |
-!              f_eff    : Marticorena & B. 1995 JGR (20)                   |
-!              A_Fact   : Fundamental * Roughness                          |
-!              Z0mBSn   :         BSnow Roughness Length               [m] |
-!              Z0mBS0   : Mimimum BSnow Roughness Length (blown* )     [m] |
-!              Z0m_Sn   :          Snow Roughness Length (surface)     [m] |
-!              Z0m_S0   : Mimimum  Snow Roughness Length               [m] |
-!              Z0m_S1   : Maximum  Snow Roughness Length               [m] |
-!              Z0_GIM   : Minimum GIMEX Roughness Length               [m] |
-!              Z0_ICE   : Sea Ice ISW   Roughness Length               [m] |
-!                                                                          |
-!                                                                          |
-!--------------------------------------------------------------------------+
-     
-
-
-! Global Variables
-! ================
-
-
-      USE VARphy
-      USE VAR_SV
-      USE VARdSV
-      USE VAR0SV
-      USE VARxSV
-      USE VARySV
-      USE VARtSV
-      USE surface_data, ONLY: is_ok_z0h_rn,
-     .                        is_ok_density_kotlyakov,
-     .                        prescribed_z0m_snow,
-     .                        iflag_z0m_snow,
-     .                        iflag_tsurf_inlandsis,
-     .                        iflag_temp_inlandsis,
-     .                        discret_xf, buf_sph_pol,buf_siz_pol      
-
-      IMPLICIT NONE
-
-      logical   SnoMod
-      logical   BloMod
-      logical   debut
-      integer   jjtime
-
-
-! Internal Variables
-! ==================
-
-! Non Local
-! ---------
-
-      real      TBr_sv(klonv)                 ! Brightness Temperature
-      real      IRdwsv(klonv)                 ! DOWNward   IR Flux
-      real      IRupsv(klonv)                 ! UPward     IR Flux
-      real      d_Bufs,Bufs_N                 ! Buffer Snow Layer Increment
-      real      Buf_ro,Bros_N                 ! Buffer Snow Layer Density
-      real      BufPro                        ! Buffer Snow Layer Density
-      real      Buf_G1,BG1__N                 ! Buffer Snow Layer Dendr/Sphe[-]
-      real      Buf_G2,BG2__N                 ! Buffer Snow Layer Spher/Size[-]
-      real      Bdzssv(klonv)                 ! Buffer Snow Layer Thickness
-      real      z_snsv(klonv)                 ! Snow-Ice, current Thickness
-
-
-
-! Local
-! -----
-
-      integer   iwr
-      integer   ikl   ,isn   ,isl   ,ist      !
-      integer   ist__s,ist__w                 ! Soil/Water Body Identifier
-      integer   growth                        ! Seasonal               Mask
-      integer   LISmsk                        ! Land+Ice / Open    Sea Mask
-      integer   LSnMsk                        ! Snow-Ice / No Snow-Ice Mask
-      integer   IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
-      integer   SnoMsk                        ! Snow     / No Snow     Mask
-      real      roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
-      real      Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
-      real      Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
-      real      Polair                        ! Polar  Snow Switch
-      real      PorSno,Salt_f,PorRef   !
-c #sw real      PorVol,rWater                 !
-c #sw real      rusNEW,rdzNEW,etaNEW          !
-      real      ro_new                        !
-      real      TaPole                        ! Maximum     Polar Temperature
-      real      T__Min                        ! Minimum realistic Temperature
-      real      EmiSol                        ! Emissivity of       Soil
-      real      EmiSno                        ! Emissivity of            Snow
-      real      EmiWat                        ! Emissivity of a Water Area
-      real      vk2                           ! Square of Von Karman Constant
-      real      u2star                        !(u*)**2
-      real      Z0mLnd                        !          Land Roughness Length
-c #ZN real      sqrrZ0                        ! u*t/u*
-      real      f_eff                         ! Marticorena & B. 1995 JGR (20)
-      real      A_Fact                        ! Fundamental * Roughness
-      real      Z0m_nu                        ! Smooth R Snow Roughness Length
-      real      Z0mBSn                        !         BSnow Roughness Length
-      real      Z0mBS0                        ! Mimimum BSnow Roughness Length
-      real      Z0m_S0                        ! Mimimum  Snow Roughness Length
-      real      Z0m_S1                        ! Maximum  Snow Roughness Length
-c #SZ real      Z0Sa_N                        ! Regime   Snow Roughness Length
-c #SZ real      Z0SaSi                        ! 1.IF Rgm Snow Roughness Length 
-c #GL real      Z0_GIM                        ! Mimimum GIMEX Roughness Length
-      real      Z0_ICE                        ! Ice ISW   Roughness Length
-      real      Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
-      real      SnoWat                        ! Snow Layer    Switch
-      real      rstar,alors                   !
-      real      rstar0,rstar1,rstar2          !
-      real      SameOK                        ! 1. => Same Type of Grains
-      real      G1same                        ! Averaged G1,  same Grains
-      real      G2same                        ! Averaged G2,  same Grains
-      real      typ__1                        ! 1. => Lay1 Type: Dendritic
-      real      zroNEW                        ! dz X ro, if fresh Snow
-      real      G1_NEW                        ! G1,      if fresh Snow
-      real      G2_NEW                        ! G2,      if fresh Snow
-      real      zroOLD                        ! dz X ro, if old   Snow
-      real      G1_OLD                        ! G1,      if old   Snow
-      real      G2_OLD                        ! G2,      if old   Snow
-      real      SizNEW                        ! Size,    if fresh Snow
-      real      SphNEW                        ! Spheric.,if fresh Snow
-      real      SizOLD                        ! Size,    if old   Snow
-      real      SphOLD                        ! Spheric.,if old   Snow
-      real      Siz_av                        ! Averaged    Grain Size
-      real      Sph_av                        ! Averaged    Grain Spher.
-      real      Den_av                        ! Averaged    Grain Dendr.
-      real      G1diff                        ! Averaged G1, diff. Grains
-      real      G2diff                        ! Averaged G2, diff. Grains
-      real      G1                            ! Averaged G1
-      real      G2                            ! Averaged G2
-      real      param                         ! Polynomial   fit z0=f(T)
-      real      Z0_obs                        ! Fit Z0_obs=f(T) (m)
-      real      tamin                         ! min T of linear fit (K)
-      real      tamax                         ! max T of linear fit (K)
-      real      coefa,coefb,coefc,coefd       ! Coefs for z0=f(T)
-      real      ta1,ta2,ta3                   ! Air temperature thresholds
-      real      z01,z02,z03                   ! z0 thresholds
-      real      tt_c,vv_c                     ! Critical param.
-      real      tt_tmp,vv_tmp,vv_virt         ! Temporary variables
-      real      e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
-      real      zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
-! for Aeolian erosion and blowing snow
-      integer   nit   ,iit
-      real      Fac                           ! Correc. factor for drift ratio
-      real      dusuth,signus
-      real      sss__F,sss__N
-      real      sss__K,sss__G
-      real      us_127,us_227,us_327,us_427,us_527
-      real      VVa_OK, usuth0
-      real      ssstar
-      real      SblPom
-      real      rCd10n                        ! Square root of drag coefficient
-      real      DendOK                        ! Dendricity Switch
-      real      SaltOK                        ! Saltation  Switch
-      real      MeltOK                        ! Saltation  Switch (Melting Snow)
-      real      SnowOK                        ! Pack Top   Switch
-      real      SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
-      real      ShearX, ShearS                ! Arg. Max Shear Stress
-      real      Por_BS                        ! Snow Porosity
-      real      Salt_us                       ! New thresh.friction velocity u*t
-      real      Fac_Mo,ArguSi,FacRho          ! Numerical factors for u*t
-      real      SaltSI(klonv,0:nsno)          ! Snow Drift Index              !
-      real      MIN_Mo                        ! Minimum Mobility Fresh Fallen *
-      character*3    qsalt_param              ! Switch for saltation flux param.
-      character*3    usth_param               ! Switch for u*t param
-
-
-! Internal DATA
-! =============
-
-      data      T__Min / 200.00/              ! Minimum realistic Temperature
-      data      TaPole / 268.15/              ! Maximum Polar Temperature (value from C. Agosta)
-      data      roSMin / 300.  /              ! Minimum Snow  Density
-      data      roSMax / 400.  /              ! Max Fresh Snow Density
-      data      tt_c   / -2.0  /              ! Critical Temp. (degC)
-      data      vv_c   / 14.3  /              ! Critical Wind speed (m/s)
-      data      roSn_1 / 109.  /              ! Fall.Sno.Density, Indep. Param.
-      data      roSn_2 /   6.  /              ! Fall.Sno.Density, Temper.Param.
-      data      roSn_3 /  26.  /              ! Fall.Sno.Density, Wind   Param.
-      data      Dendr1 /  17.12/              ! Fall.Sno.Dendric.,Wind 1/Param.
-      data      Dendr2 / 128.  /              ! Fall.Sno.Dendric.,Wind 2/Param.
-      data      Dendr3 / -20.  /              ! Fall.Sno.Dendric.,Indep. Param.
-      data      Spher1 /   7.87/              ! Fall.Sno.Spheric.,Wind 1/Param.
-      data      Spher2 /  38.  /              ! Fall.Sno.Spheric.,Wind 2/Param.
-      data      Spher3 /  50.  /              ! Fall.Sno.Spheric.,Wind 3/Param.
-      data      Spher4 /  90.  /              ! Fall.Sno.Spheric.,Indep. Param.
-      data      EmiSol /   0.99999999/        ! 0.94Emissivity of Soil
-      data      EmiWat /   0.99999999/        ! Emissivity of a Water Area
-      data      EmiSno /   0.99999999/        ! Emissivity of Snow
-
-      
-!     DATA      Emissivities                  ! Pielke, 1984, pp. 383,409
-
-      data      Z0mBS0 /   0.5e-6/            ! MINimum Snow Roughness Length 
-                                              ! for Momentum if Blowing Snow
-                                              ! Gallee et al. 2001 BLM 99 (19)
-      data      Z0m_S0/    0.00005/           ! MINimum Snow Roughness Length
-                                              ! MegaDunes    included
-      data      Z0m_S1/    0.030  /           ! MAXimum Snow Roughness Length
-                                              !        (Sastrugis)
-c #GL data      Z0_GIM/    0.0013/            ! Ice Min Z0 = 0.0013 m (Broeke)
-!                                             ! Old Ice Z0 = 0.0500 m (Bruce)
-!                                             !              0.0500 m (Smeets)
-!                                             !              0.1200 m (Broeke)
-      data      Z0_ICE/    0.0010/            ! Sea-Ice Z0 = 0.0010 m (Andreas)
-!                                             !    (Ice Station Weddel -- ISW)
-! for aerolian erosion
-      data      SblPom/ 1.27/   ! Lower Boundary Height Parameter
-C +                             ! for Suspension
-C +                             ! Pommeroy, Gray and Landine 1993,
-C +                             ! J. Hydrology, 144(8) p.169
-      data      nit   / 5   /   ! us(is0,uth) recursivity: Nb Iterations
-cc#AE data      qsalt_param/"bin"/ ! saltation part. conc. from Bintanja 2001 (p
-      data      qsalt_param/"pom"/ ! saltation part. conc. from Pomeroy and Gray
-cc#AE data      usth_param/"lis"/  ! u*t from Liston et al. 2007
-      data      usth_param/"gal"/  ! u*t from Gallee et al. 2001
-      data      SaltMx/-5.83e-2/
-
-      vk2    =  vonKrm  *  vonKrm             ! Square of Von Karman Constant
-
-
-! BEGIN.main.
-! ===========================
-
-
-
-
-! "Soil" Humidity of Water Bodies
-! ===============================
-
-      DO ikl=1,knonv
-
-          ist    =      isotSV(ikl)                       ! Soil Type
-          ist__s =  min(ist, 1)                           ! 1 => Soil
-          ist__w =  1 - ist__s                            ! 1 => Water Body
-        DO isl=-nsol,0
-          eta_SV(ikl,isl) = eta_SV(ikl,isl) * ist__s      ! Soil 
-     .                    + etadSV(ist)     * ist__w      ! Water Body
-        END DO
-
-
-! Vertical Discretization Factor
-! ==============================
-
-          LSdzsv(ikl)     =                   ist__s      ! Soil
-     .                    + OcndSV          * ist__w      ! Water Body
-      END DO
-
-
-
-
-
-      IF (SnoMod)                            THEN
-
- 
-C +--Aeolian erosion and Blowing Snow
-C +==================================
-
-
-
-        DO ikl=1,knonv
-            usthSV(ikl) =                     1.0e+2
-        END DO
-
-
-        IF (BloMod) THEN
- 
-        if (klonv.eq.1) then
-          if(isnoSV(1).ge.2                   .and.
-     .         TsisSV(1,max(1,isnoSV(1)))<273.  .and.
-     .         ro__SV(1,max(1,isnoSV(1)))<500.  .and.
-     .         eta_SV(1,max(1,isnoSV(1)))<epsi) then
-C +                       **********
-                     call SISVAT_BSn
-          endif
-         else
-                     call SISVAT_BSn
-C +                       **********
-        endif
-
-
-
-
-
-
-
-! Calculate threshold erosion velocity for next time step
-! Unlike in sisvat, computation is of threshold velocity made here (instead of sisvaesbl)
-! since we do not use sisvatesbl for the coupling with LMDZ
-
-C +--Computation of threshold friction velocity for snow erosion
-C --------------------------------------------------------------- 
-
-        rCd10n =  1. / 26.5 ! Vt / u*t = 26.5
-                     ! Budd et al. 1965, Antarct. Res. Series Fig.13
-                     ! ratio developped during assumed neutral conditions
- 
-
-C +--Snow Properties
-C +  ~~~~~~~~~~~~~~~
-
-        DO ikl = 1,knonv
-
-          isn      =  isnoSV(ikl)
-
-
- 
-          DendOK   =  max(zero,sign(unun,epsi-G1snSV(ikl,isn)  ))  !
-          SaltOK   =  min(1   , max(istdSV(2)-istoSV(ikl,isn),0))  !
-          MeltOK   =     (unun                                     !
-     .             -max(zero,sign(unun,TfSnow-epsi                 !
-     .             -TsisSV(ikl,isn)  )))                           ! Melting Snow
-     .             *  min(unun,DendOK                              !
-     .                  +(1.-DendOK)                               !
-     .                      *sign(unun,     G2snSV(ikl,isn)-1.0))  ! 1.0 for 1mm
-          SnowOK   =  min(1   , max(isnoSV(ikl)      +1 -isn ,0))  ! Snow Switch
- 
-          G1snSV(ikl,isn) =      SnowOK *    G1snSV(ikl,isn)
-     .                  + (1.- SnowOK)*min(G1snSV(ikl,isn),G1_dSV)
-          G2snSV(ikl,isn) =      SnowOK *    G2snSV(ikl,isn)
-     .                  + (1.- SnowOK)*min(G2snSV(ikl,isn),G1_dSV)
- 
-          SaltOK   =  min(unun, SaltOK + MeltOK) * SnowOK
- 
- 
-C +--Mobility Index (Guyomarc'h & Merindol 1997, Ann.Glaciol.)
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          SaltM1   = -0.750e-2 * G1snSV(ikl,isn)
-     .             -0.500e-2 * G2snSV(ikl,isn)+ 0.500e00 !dendritic case
-C +     CAUTION:  Guyomarc'h & Merindol Dendricity Sign is +
-C +     ^^^^^^^^                    MAR Dendricity Sign is -
-          SaltM2   = -0.833d-2 * G1snSV(ikl,isn)
-     .             -0.583d-2 * G2snSV(ikl,isn)+ 0.833d00 !non-dendritic case
- 
-c       SaltMo   = (DendOK   * SaltM1 + (1.-DendOK) *     SaltM2       )
-          SaltMo   = 0.625 !SaltMo pour d=s=0.5
- 
-!weighting SaltMo with surface snow density (Vionnet et al. 2012)
-cc#AE   FacRho   = 1.25 - 0.0042 * ro__SV(ikl,isn)
-cc#AE   SaltMo   = 0.34 * SaltMo + 0.66 * FacRho !needed for polar snow
-          MIN_Mo   =  0.
-c       SaltMo   =  max(SaltMo,MIN_Mo)
-c       SaltMo   =  SaltOK   * SaltMo + (1.-SaltOK) * min(SaltMo,SaltMx)
-c #TUNE SaltMo   =  SaltOK   * SaltMo - (1.-SaltOK) *     0.9500
-          SaltMo   =  max(SaltMo,epsi-unun)
- 
-C +--Influence of Density on Threshold Shear Stress
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          Por_BS =  1. - 300. / ro_Ice
-          ShearS = Por_BS / (1.-Por_BS)
-C +...         SheaBS =  Arg(sqrt(shear = max shear stress in snow)):
-C +            shear  =  3.420d00 * exp(-(Por_BS      +Por_BS)
-C +  .                                  /(unun        -Por_BS))
-C +            SheaBS :  see de Montmollin         (1978),
-C +                      These Univ. Sci. Medic. Grenoble, Fig. 1 p. 124
- 
-C +--Snow Drift Index (Guyomarc'h & Merindol 1997, Ann.Glaciol.)
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          ArguSi      =     -0.085 *us__SV(ikl)/rCd10n
-!V=u*/sqrt(CD) eqs 2 to 4 Gallee et al. 2001
- 
-          SaltSI(ikl,isn) = -2.868 * exp(ArguSi) + 1 + SaltMo
- 
-
-C +--Threshold Friction Velocity
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          if(ro__SV(ikl,isn)>300.) then
-             Por_BS      =  1.000       - ro__SV(ikl,isn)     /ro_Ice
-          else
-             Por_BS      =  1.000  - 300. /ro_Ice
-          endif
- 
-          ShearX =  Por_BS/max(epsi,1.-Por_BS)
-          Fac_Mo = exp(-ShearX+ShearS)
-C +     Gallee et al., 2001    eq 5, p5
- 
-          if (usth_param .eq. "gal") then
-            Salt_us   =   (log(2.868) - log(1 + SaltMo)) * rCd10n/0.085
-            Salt_us   = Salt_us * Fac_Mo
-C +...  Salt_us   :  Extension of  Guyomarc'h & Merindol 1998 with
-C +...              de Montmollin (1978). Gallee et al. 2001
-          endif
- 
-          if (usth_param .eq. "lis") then !Liston et al. 2007
-            if(ro__SV(ikl,isn)>300.) then
-              Salt_us   = 0.005*exp(0.013*ro__SV(ikl,isn))
-            else
-              Salt_us   = 0.01*exp(0.003*ro__SV(ikl,isn))
-            endif
-          endif
- 
-          SnowOK   =  1 -min(1,iabs(isn-isnoSV(ikl))) !Switch new vs old snow
- 
-          usthSV(ikl) =     SnowOK *   (Salt_us)
-     .                + (1.-SnowOK)*    usthSV(ikl)
- 
-        END DO
-
-
- 
-!  Feeback between blowing snow turbulent Scale  u* (commented here
-!  since ustar is an input variable (not in/out) of inlandsis)
-!  -----------------------------------------------------------------
-
-
-!           VVa_OK      =  max(0.000001,       VVaSBL(ikl))
-!           sss__N      =  vonkar      *       VVa_OK
-!           sss__F      = (sqrCm0(ikl) - psim_z + psim_0)
-!           usuth0      =  sss__N /sss__F                ! u* if NO Blow. Snow
- 
-!           sss__G      =  0.27417     * gravit
- 
-! !  ______________               _____
-! !  Newton-Raphson (! Iteration, BEGIN)
-! !  ~~~~~~~~~~~~~~               ~~~~~
-!           DO iit=1,nit
-!           sss__K      =  gravit      * r_Turb * A_Turb *za__SV(ikl)
-!      .                                     *rCDmSV(ikl)*rCDmSV(ikl)
-!      .                           /(1.+0.608*QaT_SV(ikl)-qsnoSV(ikl))
-!           us_127      =  exp(    SblPom *log(us__SV(ikl)))
-!           us_227      =  us_127         *    us__SV(ikl)
-!           us_327      =  us_227         *    us__SV(ikl)
-!           us_427      =  us_327         *    us__SV(ikl)
-!           us_527      =  us_427         *    us__SV(ikl)
- 
-!           us__SV(ikl) =  us__SV(ikl)
-!      .    - (  us_527     *sss__F     /sss__N
-!      .      -  us_427
-!      .      -  us_227     *qsnoSV(ikl)*sss__K
-!      .      + (us__SV(ikl)*us__SV(ikl)-usthSV(ikl)*usthSV(ikl))/sss__G)
-!      .     /(  us_427*5.27*sss__F     /sss__N
-!      .      -  us_327*4.27
-!      .      -  us_127*2.27*qsnoSV(ikl)*sss__K
-!      .      +  us__SV(ikl)*2.0                                 /sss__G)
- 
-!           us__SV(ikl)= min(us__SV(ikl),usuth0)
-!           us__SV(ikl)= max(us__SV(ikl),epsi  )
-!           rCDmSV(ikl)=     us__SV(ikl)/VVa_OK
-! ! #AE     sss__F     =     vonkar     /rCDmSV(ikl)
-!           ENDDO
- 
-! !  ______________               ___
-! !  Newton-Raphson (! Iteration, END  )
-! !  ~~~~~~~~~~~~~~               ~~~
- 
-!           us_127      =  exp(    SblPom *log(us__SV(ikl)))
-!           us_227      =  us_127         *    us__SV(ikl)
- 
-! !  Momentum            Turbulent Scale  u*: 0-Limit in case of no Blow. Snow
-! !  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!           dusuth      =  us__SV(ikl) - usthSV(ikl)       ! u* - uth*
-!           signus      =  max(sign(unun,dusuth),zero)     ! 1 <=> u* - uth* > 0
-!           us__SV(ikl) =                                  !
-!      .                   us__SV(ikl)  *signus  +         ! u* (_BS)
-!      .                   usuth0                          ! u* (nBS)
-!      .                            *(1.-signus)           !        
-
-
-
-
-!  Blowing Snow        Turbulent Scale ss*
-!  ---------------------------------------
- 
-        hSalSV(ikl) = 8.436e-2  * us__SV(ikl)**SblPom
- 
-        if (qsalt_param .eq. "pom") then
-          qSalSV(ikl) = (us__SV(ikl)**2 - usthSV(ikl)**2) *signus
-     .               / (hSalSV(ikl) * gravit * us__SV(ikl) * 3.25)
-        endif
- 
-        if (qsalt_param .eq. "bin") then
-          qSalSV(ikl) = (us__SV(ikl) * us__SV(ikl)
-     .                -usthSV(ikl) * usthSV(ikl))*signus
-     .                * 0.535 / (hSalSV(ikl) * gravit)
-        endif
- 
-        qSalSV(ikl) = qSalSV(ikl)/rht_SV(ikl) ! conversion kg/m3 to kg/kg
- 
-        ssstar      = rCDmSV(ikl) * (qsnoSV(ikl) - qSalSV(ikl))
-     .              * r_Turb !Bintanja 2000, BLM
-!r_Turb compensates for an overestim. of the blown snow part. fall velocity
- 
-        uss_SV(ikl) = min(zero    , us__SV(ikl) *ssstar)
-        uss_SV(ikl) = max(-0.0001 , uss_SV(ikl))   
-
-
-
-
-        ENDIF   ! BloMod
- 
-C + ------------------------------------------------------
-C +--Buffer Layer
-C +  -----------------------------------------------------
- 
-          DO ikl=1,knonv
-c  BufsSV(ikl) [mm w.e.] i.e, i.e., [kg/m2]
-            d_Bufs      =  max(dsn_SV(ikl) *dt__SV,0.)  !
-            dsn_SV(ikl) =      0.                       !
-            Bufs_N      =      BufsSV(ikl) +d_Bufs      !
- 
- 
-C +--Snow Density
-C +  ^^^^^^^^^^^^
-            Polair      =      zero
-c #NP       Polair      =  max(zero,                    !
-c #NP.                         sign(unun,TaPole         !
-c #NP.                                  -TaT_SV(ikl)))  !
-            Polair      =  max(zero,                    !
-     .                         sign(unun,TaPole         !
-     .                                  -TaT_SV(ikl)))  !
-            Buf_ro      =  max( rosMin,                 ! Fallen Snow Density
-     .      roSn_1+roSn_2*     (TaT_SV(ikl)-TfSnow)     ! [kg/m3]
-     .            +roSn_3*sqrt( VV__SV(ikl)))           ! Pahaut    (CEN), Etienne: use wind speed at first model level instead of 10m wind
-c #NP       BufPro      =  max( rosMin,                 ! Fallen Snow Density
-c #NP.         104. *sqrt( max( VV10SV(ikl)-6.0,0.0)))  ! Kotlyakov (1961)
- 
-!          C.Agosta option for snow density, same as for BS i.e.
-!          is_ok_density_kotlyakov=.false.
-c #BS       density_kotlyakov = .false.  !C.Amory BS 2018
-C + ...     Fallen Snow Density, Adapted for Antarctica
-            if (is_ok_density_kotlyakov) then
-                tt_tmp = TaT_SV(ikl)-TfSnow
-                !vv_tmp = VV10SV(ikl)
-                vv_tmp=VV__SV(ikl) ! Etienne: use wind speed at first model level instead of 10m wind
-C + ...         [ A compromise between
-C + ...           Kotlyakov (1961) and Lenaerts (2012, JGR, Part1) ]
-                if (tt_tmp.ge.-10) then
-                  BufPro   =  max( rosMin,
-     .            104. *sqrt( max( vv_tmp-6.0,0.0))) ! Kotlyakov (1961)
-                else
-                  vv_virt = (tt_c*vv_tmp+vv_c*(tt_tmp+10))
-     .                     /(tt_c+tt_tmp+10)
-                  BufPro  = 104. *sqrt( max( vv_virt-6.0,0.0))
-                endif
-            else
-C + ...         [ density derived from observations of the first 50cm of
-C + ...           snow - cf. Rajashree Datta - and multiplied by 0.8 ]
-C + ...           C. Agosta, 2016-09
-cc #SD           BufPro = 149.2 + 6.84*VV10SV(ikl) + 0.48*Tsrfsv(ikl)
-cc #SD           BufPro = 125 + 14*VV10SV(ikl) + 0.6*Tsrfsv(ikl) !MAJ CK and CAm
-!                BufPro = 200 + 21 * VV10SV(ikl)!CK 29/07/19
-                 BufPro = 200 + 21 * VV__SV(ikl)!Etienne: use wind speed at first model level instead of 10m wind
-            endif
- 
-            Bros_N      = (1. - Polair) *   Buf_ro      ! Temperate Snow
-     .                        + Polair  *   BufPro      ! Polar     Snow
- 
-            Bros_N = max( 20.,max(rosMin,  Bros_N))
-            Bros_N = min(400.,min(rosMax-1,Bros_N)) ! for dz_min in SISVAT_zSn
- 
- 
-!    Density of deposited blown snow
-!    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 
-         if (BloMod) then
-         Bros_N      = frsno
-         ro_new      = ro__SV(ikl,max(1,isnoSV(ikl)))
-         ro_new      = max(Bros_N,min(roBdSV,ro_new))
-         Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl)))
-     .               -roBdSV)/(500.-roBdSV))
-         Fac         = max(0.,min(1.,Fac))
-         dsnbSV(ikl) = Fac*dsnbSV(ikl)
-         Bros_N      = Bros_N     * (1.0-dsnbSV(ikl))
-     .               + ro_new     *      dsnbSV(ikl)
-         endif
-
- 
-!    Time averaged Density of deposited blown Snow
-!    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-           
-            BrosSV(ikl) =(Bros_N     *      d_Bufs      !
-     .                   +BrosSV(ikl)*      BufsSV(ikl))!
-     .                   /         max(epsi,Bufs_N)     !
- 
- 
-C +-- S.Falling Snow Properties (computed as in SISVAT_zAg)
-C +     ^^^^^^^^^^^^^^^^^^^^^^^
-            Buf_G1      =  max(-G1_dSV,                 ! Temperate Snow
-     .               min(Dendr1*VV__SV(ikl)-Dendr2,     !     Dendricity
-     .                   Dendr3                   ))    !
-            Buf_G2      =  min( Spher4,                 ! Temperate Snow
-     .               max(Spher1*VV__SV(ikl)+Spher2,     !     Sphericity
-     .                   Spher3                   ))    !
-! EV: now control buf_sph_pol and bug_siz_pol in physiq.def
-            Buf_G1      = (1. - Polair) *   Buf_G1      ! Temperate Snow
-     .                        + Polair  *   buf_sph_pol ! Polar Snow 
-            Buf_G2      = (1. - Polair) *   Buf_G2      ! Temperate Snow
-     .                        + Polair  *   buf_siz_pol ! Polar Snow
-                G1      =                   Buf_G1      ! NO  Blown Snow
-                G2      =                   Buf_G2      ! NO  Blown Snow
-
-
-
-            IF (BloMod) THEN 
-
-!     S.1. Meme  Type  de Neige  / same Grain Type
-!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-           SameOK  =  max(zero,
-     .         sign(unun,    Buf_G1             *G1_dSV
-     .                            - eps_21                    ))
-           G1same  = ((1.0-dsnbSV(ikl))*Buf_G1+dsnbSV(ikl) *G1_dSV)
-           G2same  = ((1.0-dsnbSV(ikl))*Buf_G2+dsnbSV(ikl) *ADSdSV)
-!           Blowing Snow Properties:                         G1_dSV, ADSdSV
- 
-!     S.2. Types differents / differents Types
-!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-           typ__1  =  max(zero,sign(unun,epsi-Buf_G1))   ! =1.=> Dendritic
-           zroNEW  =     typ__1  *(1.0-dsnbSV(ikl))      ! fract.Dendr.Lay.
-     .            + (1.-typ__1) *     dsnbSV(ikl)       !
-           G1_NEW  =     typ__1  *Buf_G1                 ! G1 of Dendr.Lay.
-     .            + (1.-typ__1) *G1_dSV                 !
-           G2_NEW  =     typ__1  *Buf_G2                 ! G2 of Dendr.Lay.
-     .            + (1.-typ__1) *ADSdSV                 !
-           zroOLD  = (1.-typ__1) *(1.0-dsnbSV(ikl))      ! fract.Spher.Lay.
-     .            +     typ__1  *     dsnbSV(ikl)       !
-           G1_OLD  = (1.-typ__1) *Buf_G1                 ! G1 of Spher.Lay.
-     .            +     typ__1  *G1_dSV                 !
-           G2_OLD  = (1.-typ__1) *Buf_G2                 ! G2 of Spher.Lay.
-     .            +     typ__1  *ADSdSV                 !
-           SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV          ! Size  Dendr.Lay.
-     .            +(1.+G1_NEW         /G1_dSV)          !
-     .                  *(G2_NEW  *DScdSV/G1_dSV        !
-     .            +(1.-G2_NEW         /G1_dSV)*DFcdSV)  !
-           SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
-           SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
-           SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
-           Siz_av  =     (zroNEW*SizNEW+zroOLD*SizOLD)   ! Averaged Size
-           Sph_av  = min( zroNEW*SphNEW+zroOLD*SphOLD    !
-     .                 ,  unun)                         ! Averaged Sphericity
-           Den_av  = min((Siz_av -(    Sph_av *DScdSV    !
-     .            +(1.-Sph_av)*DFcdSV))                 !
-     .            / (DDcdSV -(    Sph_av *DScdSV        !
-     .            +(1.-Sph_av)*DFcdSV))                 !
-     .                   ,  unun)                       !
-           DendOK  = max(zero,                           !
-     .                    sign(unun,     Sph_av *DScdSV   ! Small   Grains
-     .                              +(1.-Sph_av)*DFcdSV   ! Faceted Grains
-     .                              -    Siz_av        )) !
-C +...      REMARQUE: le  type moyen (dendritique ou non) depend
-C +         ^^^^^^^^  de la  comparaison avec le diametre optique
-C +                   d'une neige recente de   dendricite nulle
-C +...      REMARK:   the mean type  (dendritic   or not) depends
-C +         ^^^^^^    on the comparaison with the optical diameter
-C +                   of a recent snow    having zero dendricity
- 
-           G1diff  =(   -DendOK *Den_av
-     .            +(1.-DendOK)*Sph_av) *G1_dSV
-           G2diff  =     DendOK *Sph_av  *G1_dSV
-     .            +(1.-DendOK)*Siz_av
-           G1      =     SameOK *G1same
-     .            +(1.-SameOK)*G1diff
-           G2      =     SameOK *G2same
-     .            +(1.-SameOK)*G2diff
-           ENDIF
-
-
- 
-!     S.1. Meme  Type  de Neige  / same Grain Type
-!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-            SameOK  =  max(zero,
-     .                     sign(unun,    Buf_G1 *BG1sSV(ikl)
-     .                                 - eps_21                    ))
-            G1same  = (d_Bufs*Buf_G1+BufsSV(ikl)*BG1sSV(ikl))
-     .                     /max(epsi,Bufs_N)
-            G2same  = (d_Bufs*Buf_G2+BufsSV(ikl)*BG2sSV(ikl))
-     .                     /max(epsi,Bufs_N)
- 
-!     S.2. Types differents / differents Types
-!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-            typ__1  =  max(zero,sign(unun,epsi-Buf_G1))   ! =1.=> Dendritic
-            zroNEW  =(    typ__1  *d_Bufs                 ! fract.Dendr.Lay.
-     .              + (1.-typ__1) *BufsSV(ikl))           !
-     .                   /max(epsi,Bufs_N)                !
-            G1_NEW  =     typ__1  *Buf_G1                 ! G1 of Dendr.Lay.
-     .              + (1.-typ__1) *BG1sSV(ikl)            !
-            G2_NEW  =     typ__1  *Buf_G2                 ! G2 of Dendr.Lay.
-     .              + (1.-typ__1) *BG2sSV(ikl)            !
-            zroOLD  =((1.-typ__1) *d_Bufs                 ! fract.Spher.Lay.
-     .              +     typ__1  *BufsSV(ikl))           !
-     .                   /max(epsi,Bufs_N)                !
-            G1_OLD  = (1.-typ__1) *Buf_G1                 ! G1 of Spher.Lay.
-     .              +     typ__1  *BG1sSV(ikl)            !
-            G2_OLD  = (1.-typ__1) *Buf_G2                 ! G2 of Spher.Lay.
-     .              +     typ__1  *BG2sSV(ikl)            !
-            SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV          ! Size  Dendr.Lay.
-     .               +(1.+G1_NEW         /G1_dSV)         !
-     .                  *(G2_NEW  *DScdSV/G1_dSV          !
-     .               +(1.-G2_NEW         /G1_dSV)*DFcdSV) !
-            SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
-            SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
-            SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
-            Siz_av  =   ( zroNEW  *SizNEW+zroOLD*SizOLD)  ! Averaged Size
-            Sph_av = min( zroNEW  *SphNEW+zroOLD*SphOLD   !
-     .                  ,   unun                       )  ! Averaged Sphericity
-            Den_av = min((Siz_av  - (    Sph_av *DScdSV   !
-     .                              +(1.-Sph_av)*DFcdSV)) !
-     .                 / (DDcdSV  - (    Sph_av *DScdSV   !
-     .                              +(1.-Sph_av)*DFcdSV)) !
-     .                  ,   unun                         )!
-            DendOK  = max(zero,                           !
-     .                    sign(unun,     Sph_av *DScdSV   ! Small   Grains
-     .                              +(1.-Sph_av)*DFcdSV   ! Faceted Grains
-     .                              -    Siz_av        )) !
-C +...      REMARQUE: le  type moyen (dendritique ou non) depend
-C +         ^^^^^^^^  de la  comparaison avec le diametre optique
-C +                   d'une neige recente de   dendricite nulle
-C +...      REMARK:   the mean type  (dendritic   or not) depends
-C +         ^^^^^^    on the comparaison with the optical diameter
-C +                   of a recent snow    having zero dendricity
- 
-            G1diff  =(   -DendOK *Den_av
-     .               +(1.-DendOK)*Sph_av) *G1_dSV
-            G2diff  =     DendOK *Sph_av  *G1_dSV
-     .               +(1.-DendOK)*Siz_av
-            G1      =     SameOK *G1same
-     .               +(1.-SameOK)*G1diff
-            G2      =     SameOK *G2same
-     .               +(1.-SameOK)*G2diff
- 
-            BG1sSV(ikl) =                       G1      !
-     .                  *       Bufs_N/max(epsi,Bufs_N) !
-            BG2sSV(ikl) =                       G2      !
-     .                  *       Bufs_N/max(epsi,Bufs_N) !
- 
-
-C +--Update of Buffer Layer Content & Decision about creating a new snow layer
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-            BufsSV(ikl) =       Bufs_N                  !     [mm w.e.]
-            NLaysv(ikl) = min(unun,                     !
-     .                    max(zero,                     ! Allows to create
-     .                        sign(unun,BufsSV(ikl)     ! a new snow Layer
-     .                                 -SMndSV     ))   ! if Buffer > SMndSV
-     .                   *max(zero,                     ! Except if * Erosion
-     .                        sign(unun,0.50            ! dominates
-     .                                 -dsnbSV(ikl)))   !
-     .                   +max(zero,                     ! Allows to create
-     .                        sign(unun,BufsSV(ikl)     ! a new snow Layer
-     .                                 -SMndSV*3.00)))  ! is Buffer > SMndSV*3
-            Bdzssv(ikl) = 1.e-3*BufsSV(ikl)*ro_Wat      ! [mm w.e.] -> [m w.e.]
-     .                            /max(epsi,BrosSV(ikl))!& [m w.e.] -> [m]
- 
- 
-          END DO
- 
-
-
-! Snow Pack Discretization(option XF in MAR)
-! ==========================================
-
-          
-      if (discret_xf.AND.klonv.eq.1) then
-
-       if(isnoSV(1).ge.1.or.NLaysv(1).ge.1) then
-C +          **********
-         call SISVAT_zSn
-C +          **********
-       endif
-      else
-C +          **********
-        call SISVAT_zSn
-C +          **********
-      endif
- 
-C +          **********
-! #ve   call SISVAT_wEq('_zSn  ',0)
-C +          **********
-
-! Add a new Snow Layer
-! ====================
-
-          DO ikl=1,knonv
-
-            isnoSV(ikl)     = isnoSV(ikl)         +NLaysv(ikl)
-            isn             = isnoSV(ikl)
-            dzsnSV(ikl,isn) = dzsnSV(ikl,isn) * (1-NLaysv(ikl))
-     .                      + Bdzssv(ikl)     *    NLaysv(ikl) 
-            TsisSV(ikl,isn) = TsisSV(ikl,isn) * (1-NLaysv(ikl))
-     .                  + min(TaT_SV(ikl),Tf_Sno) *NLaysv(ikl) 
-            ro__SV(ikl,isn) = ro__SV(ikl,isn) * (1-NLaysv(ikl))
-     .                      + Brossv(ikl)     *    NLaysv(ikl) 
-            eta_SV(ikl,isn) = eta_SV(ikl,isn) * (1-NLaysv(ikl))   ! + 0. 
-            agsnSV(ikl,isn) = agsnSV(ikl,isn) * (1-NLaysv(ikl))   ! + 0. 
-            G1snSV(ikl,isn) = G1snSV(ikl,isn) * (1-NLaysv(ikl))
-     .                      + BG1ssv(ikl)     *    NLaysv(ikl)
-            G2snSV(ikl,isn) = G2snSV(ikl,isn) * (1-NLaysv(ikl))
-     .                      + BG2ssv(ikl)     *    NLaysv(ikl)
-            istoSV(ikl,isn) = istoSV(ikl,isn) * (1-NLaysv(ikl))
-     .   + max(zer0,sign(un_1,TaT_SV(ikl)
-     .                       -Tf_Sno-eps_21)) *    istdSV(2)
-     .                                        *    NLaysv(ikl)
-            BufsSV(ikl)     = BufsSV(ikl)     * (1-NLaysv(ikl))
-            NLaysv(ikl)     = 0
-
-
-          END DO
-
-
-! Snow Pack Thickness
-! -------------------
-
-        DO ikl=1,knonv
-            z_snsv(ikl)     = 0.0
-        END DO
-        DO   isn=1,nsno
-          DO ikl=1,knonv
-            z_snsv(ikl)     = z_snsv(ikl) + dzsnSV(ikl,isn)
-            zzsnsv(ikl,isn) = z_snsv(ikl)
-          END DO
-        END DO
-
-
-
-      END IF  ! SnoMod
-
-
-
-! Soil Albedo: Soil Humidity Correction
-! ==========================================
-
-!         REFERENCE: McCumber and Pielke (1981), Pielke (1984)
-!         ^^^^^^^^^
-          DO ikl=1,knonv
-            albssv(ikl) = 
-     .      alb0SV(ikl) *(1.0-min(half,eta_SV(       ikl,0)
-     .                                /etadSV(isotSV(ikl))))
-!         REMARK:    Albedo of Water Surfaces (isotSV=0): 
-!         ^^^^^^     alb0SV := 2  X  effective value, while 
-!                    eta_SV :=          etadSV
-          END DO
-
-
-! Snow Pack Optical Properties
-! ============================
-
-      IF (SnoMod)                                                 THEN
-
-!            ******
-        call SnOptP(jjtime)
-!            ******
-
-      ELSE
-        DO ikl=1,knonv
-          sEX_sv(ikl,1) = 1.0
-          sEX_sv(ikl,0) = 0.0
-          albisv(ikl)   = albssv(ikl)
-        END DO
-      END IF
-
-
-
-! Soil optical properties
-! =============================
-!Etienne: as in inlandis we do not call vgopt, we need to define
-!the albedo alb_SV and to calculate the
-!absorbed Solar Radiation by Surfac (Normaliz)[-] SoSosv
-
- 
-      DO ikl=1,klonv
-
-            e_pRad = 2.5   *  coszSV(ikl)       ! exponential argument,
-                                                ! V/nIR radiation partitioning,
-                                                ! DR97, 2, eqn (2.53) & (2.54)
-            e1pRad = 1.-exp(-e_pRad)            ! exponential, V/nIR Rad. Part.
-            exdRad= 1.
- 
-! Visible Part of the Solar Radiation Spectrum (V,   0.4--0.7mi.m) 
-            A_Rad0 =      0.25 + 0.697 * e1pRad ! Absorbed    Vis. Radiation
-            absg_V = (1.-albisv(ikl))*(A_Rad0*exdRad)  !
- 
-! Near-IR Part of the Solar Radiation Spectrum (nIR, 0.7--2.8mi.m)
- 
-            A_Rad0 =      0.80 + 0.185 * e1pRad ! Absorbed    nIR. Radiation
-            absgnI = (1.-albisv(ikl))*(A_Rad0*exdRad)  !
-
-            SoSosv(ikl) = (absg_V+absgnI)*0.5d0
-
-            alb_SV(ikl) = albisv(ikl)
-
-      END DO
- 
-!            **********
-! #ve   call SISVAT_wEq('SnOptP',0)
-!            **********
-
-
-! Surface Emissivity (Etienne: simplified calculation for landice)
-! =============================================================
-!
-       DO ikl=1,knonv
-            LSnMsk     =     min( 1,isnoSV(ikl))
-            Eso_sv(ikl)=  EmiSol*(1-LSnMsk)+EmiSno*LSnMsk  ! Sol+Sno Emissivity
-            emi_SV(ikl)= EmiSol*(1-LSnMsk) + EmiSno*LSnMsk
-        END DO
-
-
-
-
-!  Upward IR (INPUT, from previous time step)
-! ===================================================================
-
-        DO ikl=1,knonv
-! #e1     Enrsvd(ikl) =    - IRs_SV(ikl)
-           IRupsv(ikl) =      IRs_SV(ikl) 
-        END DO
-
-
-! Turbulence
-! ==========
-
-! Latent Heat of Vaporization/Sublimation
-! ---------------------------------------
-
-        DO ikl=1,knonv
-          SnoWat      =                     min(isnoSV(ikl),0)
-          Lx_H2O(ikl) =
-     .    (1.-SnoWat) * LhvH2O 
-     .  +     SnoWat  *(LhsH2O * (1.-eta_SV(ikl,isnoSV(ikl)))
-     .                 +LhvH2O *     eta_SV(ikl,isnoSV(ikl)) )
-        END DO
-
-
-
-
-! Aerodynamic Resistance (calculated from drags given by LMDZ)
-! Commented because already calculated in surf_inlandsis_mod
-! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-!       DO ikl=1,knonv
-!          ram_sv(ikl) = 1./(cdM_SV(ikl)*max(VV__SV(ikl),eps6))
-!          rah_sv(ikl) = 1./(cdH_SV(ikl)*max(VV__SV(ikl),eps6))
-!        END DO
-
-
-
-! Soil   Energy Balance
-! =====================
-
-
-      if (iflag_temp_inlandsis .eq. 0) then
-
-       call SISVAT_TSo
-
-      else
-        DO ikl=1,knonv
-        Tsf_SV(ikl)=Tsrfsv(ikl)
-        END DO
-
-       call SISVAT_TS2
-
-      end if
-
-
-!            **********
-! #ve   call SISVAT_wEq('_TSo  ',0)
-!            **********
-
-
-
-! Soil Water     Potential
-! ------------------------
-
-      DO   isl=-nsol,0
-        DO ikl=1,knonv
-          ist             =     isotSV(ikl)        ! Soil Type
-          psi_sv(ikl,isl) =     psidSV(ist)        ! DR97, Eqn.(3.34)
-     .  *(etadSV(ist) /max(eps6,eta_SV(ikl,isl)))  !
-     .  **bCHdSV(ist)                              !
-
-
-! Soil Hydraulic Conductivity
-! ---------------------------
-
-          Khydsv(ikl,isl) =    s2__SV(ist)         ! DR97, Eqn.(3.35)
-     .  *(eta_SV(ikl,isl)**(2.*bCHdSV(ist)+3.))    !  
-        END DO
-      END DO
-
-
-! Melting / Refreezing in the Snow Pack
-! =====================================
-
-      IF (SnoMod)                                                 THEN
-
-!            **********
-        call SISVAT_qSn
-!            **********
-
-!            **********
-! #ve   call SISVAT_wEq('_qSn  ',0)
-!            **********
-
-
-! Snow Pack Thickness
-! -------------------
-
-          DO ikl=1,knonv
-            z_snsv(ikl)     = 0.0
-          END DO
-        DO   isn=1,nsno
-          DO ikl=1,knonv
-            z_snsv(ikl)     = z_snsv(ikl) + dzsnSV(ikl,isn)
-            zzsnsv(ikl,isn) = z_snsv(ikl)
-          END DO
-        END DO
-
-
-! Energy in Excess is added to the first Soil Layer
-! -------------------------------------------------
-        DO ikl=1,knonv
-            z_snsv(ikl)   = max(zer0,
-     .                          sign(un_1,eps6-z_snsv(ikl)))
-            TsisSV(ikl,0) = TsisSV(ikl,0)    + EExcsv(ikl)
-     .                                       /(rocsSV(isotSV(ikl))
-     .                                        +rcwdSV*eta_SV(ikl,0))
-            EExcsv(ikl)   = 0.
-        END DO
-
-
-      END IF
-
-
-! Soil   Water  Balance
-! =====================
-
-!            **********
-        call SISVAT_qSo
-! #m0.                 (Wats_0,Wats_1,Wats_d)
-!            **********
-
-
-! Surface Fluxes
-! =====================
-
-        DO ikl=1,knonv
-         IRdwsv(ikl)=IRd_SV(ikl)*Eso_sv(ikl) ! Downward IR
-!         IRdwsv(ikl)=tau_sv(ikl) *IRd_SV(ikl)*Eso_sv(ikl) ! Downward IR
-!    .          +(1.0-tau_sv(ikl))*IRd_SV(ikl)*Evg_sv(ikl) !  ! Etienne, remove vegetation component
-          IRupsv(ikl) =      IRupsv(ikl)                   ! Upward   IR
-          IRu_SV(ikl) =     -IRupsv(ikl)                   ! Upward   IR
-     .                      +IRd_SV(ikl)                   ! (effective)
-     .                      -IRdwsv(ikl)                   ! (positive)
-
-          TBr_sv(ikl) =sqrt(sqrt(IRu_SV(ikl)/StefBo))      ! Brightness
-!                                                          ! Temperature
-          uts_SV(ikl) =     (HSv_sv(ikl) +HSs_sv(ikl))     ! u*T*
-     .                     /(rhT_SV(ikl) *cp)          !
-          uqs_SV(ikl) =     (HLv_sv(ikl) +HLs_sv(ikl))     ! u*q*
-     .                     /(rhT_SV(ikl) *LhvH2O)          !
-          LMO_SV(ikl) = TaT_SV(ikl)*(us__SV(ikl)**3)
-     .                     /gravit/uts_SV(ikl)/vonKrm      ! MO length
-     
-
-! Surface Temperature
-! ^^^^^^^^^^^^^^^^^^^^
-
-          IF (iflag_tsurf_inlandsis .EQ. 0) THEN   
-
-            Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
-
-          ELSE IF (iflag_tsurf_inlandsis .GT. 0) THEN
-! Etienne: extrapolation from the two uppermost levels:
-
-         if (isnoSV(ikl) >=2) then
-           zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
-           zm2=-(dzsnSV(ikl,isnoSV(ikl)) + dzsnSV(ikl,isnoSV(ikl)-1)/2.)
-         else if (isnoSV(ikl) .EQ. 1) then
-           zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
-           zm2=-(dzsnSV(ikl,isnoSV(ikl))+dz_dSV(0)/2.)
-         else
-           zm1=-dz_dSV(0)/2.
-           zm2=-(dz_dSV(0)+dz_dSV(-1)/2.)
-
-         end if
-
-           coefslope=(TsisSV(ikl,isnoSV(ikl))-TsisSV(ikl,isnoSV(ikl)-1)) 
-     .               /(zm1-zm2)
-           Tsrfsv(ikl)=TsisSV(ikl,isnoSV(ikl))+coefslope*(0. - zm1)
-
-
-         ELSE !(default)
-
-           Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
-
-         END IF
-
-
-         END DO
-
-! Snow Pack Properties (sphericity, dendricity, size)
-! ===================================================
-
-      IF (SnoMod)                                                 THEN
-
-      if (discret_xf .AND. klonv.eq.1) then
-      if(isnoSV(1).ge.1) then
-C +          **********
-      call SISVAT_GSn
-C +          **********
-      endif
-      else
-C +          **********
-        call SISVAT_GSn
-C +          **********
-      endif
-
-
-      END IF
-
-
-! Roughness Length for next time step
-!====================================
-
-! Note that in INLANDSIS, we treat only ice covered surfaces so calculation
-! of z0 is much simpler (no subgrid fraction of ocean or land)
-! old calculations are commented below
-
-
-C +--Roughness Length for Momentum
-C +  -----------------------------
-
-! ETIENNE WARNING: changes have been made wrt original SISVAT
- 
-C +--Land+Sea-Ice / Ice-free Sea Mask
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-        DO ikl=1,knonv
-          IcIndx(ikl) = 0
-        ENDDO
-        DO isn=1,nsno
-        DO ikl=1,knonv
-
-          IcIndx(ikl) = max(IcIndx(ikl),
-     .                  isn*max(0,
-     .                  sign(1,
-     .                  int(ro__SV(ikl,isn)-900.))))
-        ENDDO
-        ENDDO
- 
-        DO ikl=1,knonv
-          LISmsk    =     1. ! in inlandsis, land only
-          IceMsk    =     max(0,sign(1   ,IcIndx(ikl)-1)  )
-          SnoMsk    = max(min(isnoSV(ikl)-iiceSV(ikl),1),0)
-
-
-C +--Z0 Smooth Regime over Snow (Andreas 1995, CRREL Report 95-16, p. 8)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-          Z0m_nu =       5.e-5 ! z0s~(10-d)*exp(-vonkar/sqrt(1.1e-03))
-
-C +--Z0 Saltat.Regime over Snow (Gallee  et al., 2001, BLM 99 (19) p.11)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-          u2star =       us__SV(ikl) *us__SV(ikl)
-          Z0mBSn =       u2star      *0.536e-3   -  61.8e-6
-          Z0mBSn =   max(Z0mBS0      ,Z0mBSn)
-
-C +--Z0 Smooth + Saltat. Regime
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-          Z0enSV(ikl) =  Z0m_nu
-     .                +  Z0mBSn
-
-        
-! Calculation of snow roughness length
-!=====================================
-          IF (iflag_z0m_snow .EQ. 0) THEN
-
-          Z0m_Sn=prescribed_z0m_snow
-
-          ELSE IF (iflag_z0m_snow .EQ. 1) THEN
-
-          Z0m_Sn=Z0enSV(ikl) 
-
-          ELSE IF (iflag_z0m_snow .EQ. 2) THEN                             
-
-C +--Rough   Snow Surface Roughness Length (Variable Sastrugi Height)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          A_Fact      =  1.0000        ! Andreas et al., 2004, p.4
-                                       ! ams.confex.com/ams/pdfpapers/68601.pdf
- 
-! Parameterization of z0 dependance on Temperature (C. Amory, 2017)
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! Z0=f(T) deduced from observations, Adelie Land, dec2012-dec2013
-
-          
-          coefa = 0.1658 !0.1862 !Ant
-          coefb = -50.3869 !-55.7718 !Ant
-          ta1 = 253.15 !255. Ant
-          ta2 = 273.15
-          ta3 = 273.15+3
-          z01 = exp(coefa*ta1 + coefb) !~0.2 ! ~0.25 mm
-          z02 = exp(coefa*ta2 + coefb) !~6  !~7 mm
-          z03 = z01
-          coefc = log(z03/z02)/(ta3-ta2)
-          coefd = log(z03)-coefc*ta3
-
-          if (TaT_SV(ikl) .lt. ta1) then
-            Z0_obs = z01
-          else if (TaT_SV(ikl).ge.ta1 .and. TaT_SV(ikl).lt.ta2) then
-            Z0_obs = exp(coefa*TaT_SV(ikl) + coefb)
-          else if (TaT_SV(ikl).ge.ta2 .and. TaT_SV(ikl).lt.ta3) then
-            ! if st > 0, melting induce smooth surface
-            Z0_obs = exp(coefc*TaT_SV(ikl) + coefd)
-          else
-            Z0_obs = z03
-          endif
- 
-          Z0m_Sn=Z0_obs
-
-
-          ELSE
-
-          Z0m_Sn=0.500e-3  ! default=0.500e-3m (tuning of MAR) 
-
-          ENDIF
- 
-
-
-!          param = Z0_obs/1. ! param(s) | 1.(m/s)=TUNING 
-c #SZ     Z0Sa_N =                   (us__SV(ikl) -0.2)*param   ! 0.0001=TUNING
-c #SZ.           * max(zero,sign(unun,TfSnow-eps9
-c #SZ.                               -TsisSV(ikl , isnoSV(ikl))))
-!!#SZ     Z0SaSi = max(zero,sign(unun,Z0Sa_N                  ))! 1 if erosion
-c #SZ     Z0SaSi = max(zero,sign(unun,zero  -eps9 -uss_SV(ikl)))!
-c #SZ     Z0Sa_N = max(zero,          Z0Sa_N)
-c #SZ     Z0SaSV(ikl) =
-c #SZ.             max(Z0SaSV(ikl)   ,Z0SaSV(ikl)
-c #SZ.               + Z0SaSi*(Z0Sa_N-Z0SaSV(ikl))*exp(-dt__SV/43200.))
-c #SZ.               -            min(dz0_SV(ikl) ,     Z0SaSV(ikl))
- 
-c #SZ     A_Fact      =               Z0SaSV(ikl) *  5.0/0.15   ! A=5 if h~10cm
-C +...    CAUTION: The influence of the sastrugi direction is not yet included
- 
-c #SZ     Z0m_Sn =                    Z0SaSV(ikl)               !
-c #SZ.                              - Z0m_nu                    !
- 
-C +--Z0 Saltat.Regime over Snow (Shao & Lin, 1999, BLM 91 (46)  p.222)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-c #ZN     sqrrZ0 =       usthSV(ikl)/max( us__SV(ikl),0.001)
-c #ZN     sqrrZ0 =                   min( sqrrZ0     ,0.999)
-c #ZN     Z0mBSn =       0.55 *0.55 *exp(-sqrrZ0     *sqrrZ0)
-c #ZN.                  *us__SV(ikl)*     us__SV(ikl)*grvinv*0.5
- 
-C +--Z0 Smooth + Saltat. Regime (Shao & Lin, 1999, BLM 91 (46)  p.222)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-c #ZN     Z0enSV(ikl) = (Z0m_nu     **    sqrrZ0 )
-c #ZN.                * (Z0mBSn     **(1.-sqrrZ0))
-c #ZN     Z0enSV(ikl) =  max(Z0enSV(ikl), Z0m_nu)
- 
-
-C +--Z0 Smooth Regime over Snow (Andreas etAl., 2004
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
-c #ZA     Z0m_nu = 0.135*akmol  / max(us__SV(ikl) , epsi)
- 
-C +--Z0 Saltat.Regime over Snow (Andreas etAl., 2004
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
-c #ZA     Z0mBSn = 0.035*u2star      *grvinv
- 
-C +--Z0 Smooth + Saltat. Regime (Andreas etAl., 2004
-!    (      used by Erosion)     ams.confex.com/ams/pdfpapers/68601.pdf)
-!    ^^^^^^^^^^^^^^^^^^^^^^^^^^
-c #ZA     Z0enSV(ikl) =  Z0m_nu
-c #ZA.                +  Z0mBSn
- 
-C +--Z0 Rough  Regime over Snow (Andreas etAl., 2004
-C +  (.NOT. used by Erosion)     ams.confex.com/ams/pdfpapers/68601.pdf)
-!    ^^^^^^^^^^^^^^^^^^^^^^^^^^
-!!#ZA     u2star =      (us__SV(ikl) -0.1800)     / 0.1
-!!#ZA     Z0m_Sn =A_Fact*Z0mBSn *exp(-u2star*u2star)
-c #ZA     Z0m_90 =(10.-0.025*VVs_SV(ikl)/5.)
-c #ZA.            *exp(-0.4/sqrt(.00275+.00001*max(0.,VVs_SV(ikl)-5.)))
-c #ZA     Z0m_Sn =           DDs_SV(ikl)* Z0m_90 / 45.
-c #ZA.         - DDs_SV(ikl)*DDs_SV(ikl)* Z0m_90 /(90.*90.)
-
-
-
-
-C +--Z0  (Erosion)    over Snow (instantaneous)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-          Z0e_SV(ikl) =  Z0enSV(ikl)
- 
-C +--Momentum  Roughness Length (Etienne: changes wrt original SISVAT)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                              
-          Z0mnSV(ikl) =  Z0m_nu *(1-SnoMsk)                     ! Ice z0
-     .                + (Z0m_Sn)*SnoMsk                         ! Snow Sastrugi Form and Snow Erosion
- 
-
-C +--GIS  Roughness Length
-C +  ^^^^^^^^^^^^^^^^^^^^^
-c #GL     Z0mnSV(ikl) =
-c #GL.      (1-LSmask(ikl)) *     Z0mnSV(ikl)
-c #GL.    +    LSmask(ikl)  * max(Z0mnSV(ikl),max(Z0_GIM,
-c #GL.                                            Z0_GIM+
-c #GL.      (0.0032-Z0_GIM)*(ro__SV(ikl,isnoSV(ikl))-600.)   !
-c #GL.                     /(920.00                 -600.))) !
- 
-C +--Mom. Roughness Length, Instantaneous
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          Z0m_SV(ikl) =  Z0mnSV(ikl)                         ! Z0mnSV  instant.
- 
- 
-C +--Roughness Length for Scalars
-C +  ----------------------------
- 
-          Z0hnSV(ikl) =     Z0mnSV(ikl)/  7.4
- 
-          IF (is_ok_z0h_rn) THEN
-
-          rstar       =     Z0mnSV(ikl) * us__SV(ikl) / akmol
-          rstar       = max(epsi,min(rstar,R_1000))
-          alors       =          log(rstar)
-          rstar0      = 1.250e0 * max(zero,sign(unun,0.135e0 - rstar))
-     .                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
-     .                *(0.149e0 * max(zero,sign(unun,2.500e0 - rstar))
-     .                + 0.317e0
-     .                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
-          rstar1      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
-     .                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
-     .                *(-0.55e0 * max(zero,sign(unun,2.500e0 - rstar))
-     .                - 0.565
-     .                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
-          rstar2      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
-     .                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
-     .                *(0.      * max(zero,sign(unun,2.500e0 - rstar))
-     .                - 0.183
-     .                *(unun    - max(zero,sign(unun,2.500e0 - rstar))))
- 
-          
-
-!XF    #RN (is_ok_z0h_rn) does not work well over bare ice
-!XF    MAR is then too warm and not enough melt
- 
-         if(ro__SV(ikl,isnoSV(ikl))>50
-     .  .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)then
- 
-             Z0hnSV(ikl) = max(zero
-     .                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi))
-     .                * exp(rstar0+rstar1*alors+rstar2*alors*alors)
-     .                * 0.001e0 + Z0hnSV(ikl) * ( 1. - max(zero
-     .                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)))
- 
-          endif
-
-
-          ENDIF
-  
-          Z0h_SV(ikl) =     Z0hnSV(ikl)
- 
-
-c #MT     Z0m_SV(ikl) = max(2.0e-6     ,Z0m_SV(ikl)) ! Min Z0_m (Garrat Scheme)
-!          Z0m_SV(ikl) = min(Z0m_SV(ikl),za__SV(ikl)*0.3333)
-     
-
-       END DO
- 
-
-       return
-       end
-
-
-
-
-
-
-
-
-
-
- 
Index: LMDZ6/trunk/libf/phylmd/inlandsis/inlandsis.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/inlandsis.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/inlandsis.f90	(revision 5246)
@@ -0,0 +1,1510 @@
+subroutine INLANDSIS(SnoMod,BloMod,jjtime,debut)
+
+  USE dimphy
+
+  !--------------------------------------------------------------------------+
+  ! INLANDSIS module                                                     |
+  ! Simplified SISVAT module, containing ice and snow processes for      |
+  ! ice-covered surfaces                                                 |
+  ! version MARv3, november 2020                                         |
+  ! SubRoutine INLANDSIS contains the fortran 77 code of the             |
+  !            Soil/Ice Snow Vegetation Atmosphere Transfer Scheme       |
+  !                                                                      |
+  !--------------------------------------------------------------------------+
+  ! PARAMETERS:  klonv: Total Number of columns =                        |
+  ! ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  !                   X       Number of Mosaic Cell per grid box         |
+  !                                                                      |
+  ! INPUT:   daHost   : Date Host Model                                  |
+  ! ^^^^^                                                                |
+  !                                                                      |
+  ! INPUT:   LSmask   : 1:          Land       MASK                      |
+  ! ^^^^^               0:          Sea        MASK                      |
+  !          isotSV   = 0,...,12:   Soil       Type                      |
+  !                     0:          Water,          Liquid (Sea, Lake)   |
+  !                    12:          Water, Solid           (Ice)         |
+  !                                                                      |
+  ! INPUT:   coszSV   : Cosine of the Sun Zenithal Distance          [-] |
+  ! ^^^^^    sol_SV   : Surface Downward  Solar      Radiation    [W/m2] |
+  !          IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |
+  !          drr_SV   : Rain  Intensity                        [kg/m2/s] |
+  !          dsn_SV   : Snow  Intensity                      [mm w.e./s] |
+  !          dsnbSV   : Snow  Intensity,  Drift Fraction             [-] |
+  !          dbs_SV   : Drift Amount                           [mm w.e.] |
+  !          za__SV   : Surface Boundary Layer (SBL) Height          [m] |
+  !          VV__SV   :(SBL Top)   Wind Velocity                   [m/s] |
+  !          TaT_SV   : SBL Top    Temperature                       [K] |
+  !          rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
+  !          QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
+  !          qsnoSV   : SBL Mean   Snow      Content             [kg/kg] |
+  !          alb0SV   : Soil Basic Albedo                            [-] |
+  !          slopSV   : Surface    Slope                             [-] |
+  !          dt__SV   : Time  Step                                   [s] |
+  !                                                                      |
+  ! INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! OUTPUT:  ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+  ! ^^^^^^   iiceSV   = total Nb of Ice      Layers                      |
+  !          istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+  !                                                                      |
+  ! INPUT /  alb_SV   : Surface        Albedo                        [-] |
+  ! OUTPUT:  emi_SV   : Surface        Emissivity                    [-] |
+  ! ^^^^^^   IRs_SV   : Soil           IR Flux  (negative)        [W/m2] |
+  !          LMO_SV   : Monin-Obukhov               Scale            [m] |
+  !          us__SV   : Friction          Velocity                 [m/s] |
+  !          uts_SV   : Temperature       Turbulent Scale          [m/s] |
+  !          uqs_SV   : Specific Humidity Velocity                 [m/s] |
+  !          uss_SV   : Blowing Snow      Turbulent Scale          [m/s] |
+  !          usthSV   : Blowing Snow      Erosion   Threshold      [m/s] |
+  !          Z0m_SV   : Momentum     Roughness Length                [m] |
+  !          Z0mmSV   : Momentum     Roughness Length (time mean)    [m] |
+  !          Z0mnSV   : Momentum     Roughness Length (instantaneous)[m] |
+  !          Z0SaSV   : Sastrugi     Roughness Length                [m] |
+  !          Z0e_SV   : Erosion Snow Roughness Length                [m] |
+  !          Z0emSV   : Erosion Snow Roughness Length (time mean)    [m] |
+  !          Z0enSV   : Erosion Snow Roughness Length (instantaneous)[m] |
+  !          Z0roSV   : Subgrid Topo Roughness Length                [m] |
+  !          Z0h_SV   : Heat         Roughness Length                [m] |
+  !          TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+  !                   & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+  !          ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+  !          eta_SV   : Soil/Snow Water   Content                [m3/m3] |
+  !          G1snSV   : snow dendricity/sphericity                       |
+  !          G2snSV   : snow sphericity/grain size                       |
+  !          dzsnSV   : Snow Layer        Thickness                  [m] |
+  !          agsnSV   : Snow       Age                             [day] |
+  !          BufsSV   : Snow Buffer Layer              [kg/m2] .OR. [mm] |
+  !          BrosSV   : Snow Buffer Layer Density      [kg/m3]           |
+  !          BG1sSV   : Snow Buffer Layer Dendricity / Sphericity    [-] |
+  !          BG2sSV   : Snow Buffer Layer Sphericity / Size [-] [0.1 mm] |
+  !          rusnSV   : Surficial   Water              [kg/m2] .OR. [mm] |
+  !                                                                      |
+  ! OUTPUT:  no__SV   : OUTPUT file Unit Number                      [-] |
+  ! ^^^^^^   i___SV   : OUTPUT point   i Coordinate                  [-] |
+  !          j___SV   : OUTPUT point   j Coordinate                  [-] |
+  !          n___SV   : OUTPUT point   n Coordinate                  [-] |
+  !          lwriSV   : OUTPUT point vec Index                       [-] |
+  !                                                                      |
+  ! OUTPUT:  IRu_SV   : Upward     IR Flux (+, upw., effective)      [K] |
+  ! ^^^^^^   hSalSV   : Saltating Layer Height                       [m] |
+  !          qSalSV   : Saltating Snow  Concentration            [kg/kg] |
+  !          RnofSV   : RunOFF Intensity                       [kg/m2/s] |
+  !                                                                      |
+  ! Internal Variables:                                                  |
+  ! ^^^^^^^^^^^^^^^^^^                                                   |
+  !          NLaysv   = New            Snow Layer Switch             [-] |
+  !          albisv   : Snow/Ice/Water/Soil Integrated Albedo        [-] |
+  !          SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
+  !          TBr_sv   : Brightness Temperature                       [K] |
+  !          IRupsv   : Upward     IR Flux (-, upw.)              [W/m2] |
+  !          ram_sv   : Aerodynamic Resistance for Momentum        [s/m] |
+  !          rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+  !          Evp_sv   : Evaporation                              [kg/m2] |
+  !          EvT_sv   : Evapotranspiration                       [kg/m2] |
+  !          HSs_sv   : Surface    Sensible Heat Flux + => absorb.[W/m2] |
+  !          HLs_sv   : Surface    Latent   Heat Flux + => absorb.[W/m2] |
+  !          Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
+  !          Tsrfsv   : Surface    Temperature                       [K] |
+  !          sEX_sv   : Verticaly Integrated Extinction Coefficient  [-] |
+  !          LSdzsv   : Vertical   Discretization Factor             [-] |
+  !                   =    1. Soil                                       |
+  !                   = 1000. Ocean                                      |
+  !          z_snsv   : Snow Pack  Thickness                         [m] |
+  !          zzsnsv   : Snow Pack  Thickness                         [m] |
+  !          albssv   : Soil       Albedo                            [-] |
+  !          Eso_sv   : Soil+Snow       Emissivity                   [-] |
+  !          Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
+  !                                                                      |
+  !          ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |
+  !          ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |
+  !          ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |
+  !          EqSn_0   : Snow      Energy, before Phase Change     [J/m2] |
+  !          EqSn_1   : Snow      Energy, after  Phase Change     [J/m2] |
+  !          EqSn_d   : Snow      Energy,       net    Forcing    [J/m2] |
+  !          Enrsvd   : SVAT      Energy Power         Forcing    [W/m2] |
+  !          Enrbal   : SVAT      Energy Balance                  [W/m2] |
+  !          Wats_0   : Soil Water,  before Forcing                 [mm] |
+  !          Wats_1   : Soil Water,  after  Forcing                 [mm] |
+  !          Wats_d   : Soil Water          Forcing                 [mm] |
+  !          SIWm_0   : Snow        initial Mass               [mm w.e.] |
+  !          SIWm_1   : Snow        final   Mass               [mm w.e.] |
+  !          SIWa_i   : Snow Atmos. initial Forcing            [mm w.e.] |
+  !          SIWa_f   : Snow Atmos. final   Forcing(noConsumed)[mm w.e.] |
+  !          SIWe_i   : SnowErosion initial Forcing            [mm w.e.] |
+  !          SIWe_f   : SnowErosion final   Forcing(noConsumed)[mm w.e.] |
+  !          SIsubl   : Snow sublimed/deposed  Mass            [mm w.e.] |
+  !          SImelt   : Snow Melted            Mass            [mm w.e.] |
+  !          SIrnof   : Surficial Water + Run OFF Change       [mm w.e.] |
+  !          SIvAcr   : Sea-Ice    vertical Acretion           [mm w.e.] |
+  !          Watsvd   : SVAT Water          Forcing                 [mm] |
+  !          Watbal   : SVAT Water  Balance                       [W/m2] |
+  !                                                                      |
+  !          vk2      : Square of Von Karman Constant                [-] |
+  !          sqrCm0   : Factor of   Neutral Drag Coeffic.Momentum  [s/m] |
+  !          sqrCh0   : Factor of   Neutral Drag Coeffic.Heat      [s/m] |
+  !          EmiSol   : Soil          Emissivity                     [-] |
+  !          EmiSno   : Snow          Emissivity                     [-] |
+  !          EmiWat   : Water         Emissivity                     [-] |
+  !          Z0mLnd   :          Land Roughness Length               [m] |
+  !          sqrrZ0   : u*t/u*                                           |
+  !          f_eff    : Marticorena & B. 1995 JGR (20)                   |
+  !          A_Fact   : Fundamental * Roughness                          |
+  !          Z0mBSn   :         BSnow Roughness Length               [m] |
+  !          Z0mBS0   : Mimimum BSnow Roughness Length (blown* )     [m] |
+  !          Z0m_Sn   :          Snow Roughness Length (surface)     [m] |
+  !          Z0m_S0   : Mimimum  Snow Roughness Length               [m] |
+  !          Z0m_S1   : Maximum  Snow Roughness Length               [m] |
+  !          Z0_GIM   : Minimum GIMEX Roughness Length               [m] |
+  !          Z0_ICE   : Sea Ice ISW   Roughness Length               [m] |
+  !                                                                      |
+  !                                                                      |
+  !--------------------------------------------------------------------------+
+
+
+
+  ! Global Variables
+  ! ================
+
+
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VAR0SV
+  USE VARxSV
+  USE VARySV
+  USE VARtSV
+  USE surface_data, ONLY: is_ok_z0h_rn, &
+        is_ok_density_kotlyakov, &
+        prescribed_z0m_snow, &
+        iflag_z0m_snow, &
+        iflag_tsurf_inlandsis, &
+        iflag_temp_inlandsis, &
+        discret_xf, buf_sph_pol,buf_siz_pol
+
+  IMPLICIT NONE
+
+  logical :: SnoMod
+  logical :: BloMod
+  logical :: debut
+  integer :: jjtime
+
+
+  ! Internal Variables
+  ! ==================
+
+  ! Non Local
+  ! ---------
+
+  real :: TBr_sv(klonv)                 ! Brightness Temperature
+  real :: IRdwsv(klonv)                 ! DOWNward   IR Flux
+  real :: IRupsv(klonv)                 ! UPward     IR Flux
+  real :: d_Bufs,Bufs_N                 ! Buffer Snow Layer Increment
+  real :: Buf_ro,Bros_N                 ! Buffer Snow Layer Density
+  real :: BufPro                        ! Buffer Snow Layer Density
+  real :: Buf_G1,BG1__N                 ! Buffer Snow Layer Dendr/Sphe[-]
+  real :: Buf_G2,BG2__N                 ! Buffer Snow Layer Spher/Size[-]
+  real :: Bdzssv(klonv)                 ! Buffer Snow Layer Thickness
+  real :: z_snsv(klonv)                 ! Snow-Ice, current Thickness
+
+
+
+  ! Local
+  ! -----
+
+  integer :: iwr
+  integer :: ikl   ,isn   ,isl   ,ist      !
+  integer :: ist__s,ist__w                 ! Soil/Water Body Identifier
+  integer :: growth                        ! Seasonal               Mask
+  integer :: LISmsk                        ! Land+Ice / Open    Sea Mask
+  integer :: LSnMsk                        ! Snow-Ice / No Snow-Ice Mask
+  integer :: IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
+  integer :: SnoMsk                        ! Snow     / No Snow     Mask
+  real :: roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
+  real :: Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
+  real :: Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
+  real :: Polair                        ! Polar  Snow Switch
+  real :: PorSno,Salt_f,PorRef   !
+  ! #sw real      PorVol,rWater                 !
+  ! #sw real      rusNEW,rdzNEW,etaNEW          !
+  real :: ro_new                        !
+  real :: TaPole                        ! Maximum     Polar Temperature
+  real :: T__Min                        ! Minimum realistic Temperature
+  real :: EmiSol                        ! Emissivity of       Soil
+  real :: EmiSno                        ! Emissivity of            Snow
+  real :: EmiWat                        ! Emissivity of a Water Area
+  real :: vk2                           ! Square of Von Karman Constant
+  real :: u2star                        !(u*)**2
+  real :: Z0mLnd                        !          Land Roughness Length
+  ! #ZN real      sqrrZ0                        ! u*t/u*
+  real :: f_eff                         ! Marticorena & B. 1995 JGR (20)
+  real :: A_Fact                        ! Fundamental * Roughness
+  real :: Z0m_nu                        ! Smooth R Snow Roughness Length
+  real :: Z0mBSn                        !         BSnow Roughness Length
+  real :: Z0mBS0                        ! Mimimum BSnow Roughness Length
+  real :: Z0m_S0                        ! Mimimum  Snow Roughness Length
+  real :: Z0m_S1                        ! Maximum  Snow Roughness Length
+  ! #SZ real      Z0Sa_N                        ! Regime   Snow Roughness Length
+  ! #SZ real      Z0SaSi                        ! 1.IF Rgm Snow Roughness Length
+  ! #GL real      Z0_GIM                        ! Mimimum GIMEX Roughness Length
+  real :: Z0_ICE                        ! Ice ISW   Roughness Length
+  real :: Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
+  real :: SnoWat                        ! Snow Layer    Switch
+  real :: rstar,alors                   !
+  real :: rstar0,rstar1,rstar2          !
+  real :: SameOK                        ! 1. => Same Type of Grains
+  real :: G1same                        ! Averaged G1,  same Grains
+  real :: G2same                        ! Averaged G2,  same Grains
+  real :: typ__1                        ! 1. => Lay1 Type: Dendritic
+  real :: zroNEW                        ! dz X ro, if fresh Snow
+  real :: G1_NEW                        ! G1,      if fresh Snow
+  real :: G2_NEW                        ! G2,      if fresh Snow
+  real :: zroOLD                        ! dz X ro, if old   Snow
+  real :: G1_OLD                        ! G1,      if old   Snow
+  real :: G2_OLD                        ! G2,      if old   Snow
+  real :: SizNEW                        ! Size,    if fresh Snow
+  real :: SphNEW                        ! Spheric.,if fresh Snow
+  real :: SizOLD                        ! Size,    if old   Snow
+  real :: SphOLD                        ! Spheric.,if old   Snow
+  real :: Siz_av                        ! Averaged    Grain Size
+  real :: Sph_av                        ! Averaged    Grain Spher.
+  real :: Den_av                        ! Averaged    Grain Dendr.
+  real :: G1diff                        ! Averaged G1, diff. Grains
+  real :: G2diff                        ! Averaged G2, diff. Grains
+  real :: G1                            ! Averaged G1
+  real :: G2                            ! Averaged G2
+  real :: param                         ! Polynomial   fit z0=f(T)
+  real :: Z0_obs                        ! Fit Z0_obs=f(T) (m)
+  real :: tamin                         ! min T of linear fit (K)
+  real :: tamax                         ! max T of linear fit (K)
+  real :: coefa,coefb,coefc,coefd       ! Coefs for z0=f(T)
+  real :: ta1,ta2,ta3                   ! Air temperature thresholds
+  real :: z01,z02,z03                   ! z0 thresholds
+  real :: tt_c,vv_c                     ! Critical param.
+  real :: tt_tmp,vv_tmp,vv_virt         ! Temporary variables
+  real :: e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
+  real :: zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
+  ! for Aeolian erosion and blowing snow
+  integer :: nit   ,iit
+  real :: Fac                           ! Correc. factor for drift ratio
+  real :: dusuth,signus
+  real :: sss__F,sss__N
+  real :: sss__K,sss__G
+  real :: us_127,us_227,us_327,us_427,us_527
+  real :: VVa_OK, usuth0
+  real :: ssstar
+  real :: SblPom
+  real :: rCd10n                        ! Square root of drag coefficient
+  real :: DendOK                        ! Dendricity Switch
+  real :: SaltOK                        ! Saltation  Switch
+  real :: MeltOK                        ! Saltation  Switch (Melting Snow)
+  real :: SnowOK                        ! Pack Top   Switch
+  real :: SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
+  real :: ShearX, ShearS                ! Arg. Max Shear Stress
+  real :: Por_BS                        ! Snow Porosity
+  real :: Salt_us                       ! New thresh.friction velocity u*t
+  real :: Fac_Mo,ArguSi,FacRho          ! Numerical factors for u*t
+  real :: SaltSI(klonv,0:nsno)          ! Snow Drift Index              !
+  real :: MIN_Mo                        ! Minimum Mobility Fresh Fallen *
+  character(len=3) :: qsalt_param              ! Switch for saltation flux param.
+  character(len=3) :: usth_param               ! Switch for u*t param
+
+
+  ! Internal DATA
+  ! =============
+
+  data      T__Min / 200.00/              ! Minimum realistic Temperature
+  data      TaPole / 268.15/              ! Maximum Polar Temperature (value from C. Agosta)
+  data      roSMin / 300.  /              ! Minimum Snow  Density
+  data      roSMax / 400.  /              ! Max Fresh Snow Density
+  data      tt_c   / -2.0  /              ! Critical Temp. (degC)
+  data      vv_c   / 14.3  /              ! Critical Wind speed (m/s)
+  data      roSn_1 / 109.  /              ! Fall.Sno.Density, Indep. Param.
+  data      roSn_2 /   6.  /              ! Fall.Sno.Density, Temper.Param.
+  data      roSn_3 /  26.  /              ! Fall.Sno.Density, Wind   Param.
+  data      Dendr1 /  17.12/              ! Fall.Sno.Dendric.,Wind 1/Param.
+  data      Dendr2 / 128.  /              ! Fall.Sno.Dendric.,Wind 2/Param.
+  data      Dendr3 / -20.  /              ! Fall.Sno.Dendric.,Indep. Param.
+  data      Spher1 /   7.87/              ! Fall.Sno.Spheric.,Wind 1/Param.
+  data      Spher2 /  38.  /              ! Fall.Sno.Spheric.,Wind 2/Param.
+  data      Spher3 /  50.  /              ! Fall.Sno.Spheric.,Wind 3/Param.
+  data      Spher4 /  90.  /              ! Fall.Sno.Spheric.,Indep. Param.
+  data      EmiSol /   0.99999999/        ! 0.94Emissivity of Soil
+  data      EmiWat /   0.99999999/        ! Emissivity of a Water Area
+  data      EmiSno /   0.99999999/        ! Emissivity of Snow
+
+
+  ! DATA      Emissivities                  ! Pielke, 1984, pp. 383,409
+
+  data      Z0mBS0 /   0.5e-6/            ! MINimum Snow Roughness Length
+                                          ! ! for Momentum if Blowing Snow
+                                          ! ! Gallee et al. 2001 BLM 99 (19)
+  data      Z0m_S0/    0.00005/           ! MINimum Snow Roughness Length
+                                          ! ! MegaDunes    included
+  data      Z0m_S1/    0.030  /           ! MAXimum Snow Roughness Length
+                                          ! !        (Sastrugis)
+  ! #GL data      Z0_GIM/    0.0013/            ! Ice Min Z0 = 0.0013 m (Broeke)
+                                          ! ! Old Ice Z0 = 0.0500 m (Bruce)
+                                          ! !              0.0500 m (Smeets)
+                                          ! !              0.1200 m (Broeke)
+  data      Z0_ICE/    0.0010/            ! Sea-Ice Z0 = 0.0010 m (Andreas)
+                                          ! !    (Ice Station Weddel -- ISW)
+  ! for aerolian erosion
+  data      SblPom/ 1.27/   ! Lower Boundary Height Parameter
+  ! +                             ! for Suspension
+  ! +                             ! Pommeroy, Gray and Landine 1993,
+  ! +                             ! J. Hydrology, 144(8) p.169
+  data      nit   / 5   /   ! us(is0,uth) recursivity: Nb Iterations
+  !c#AE data      qsalt_param/"bin"/ ! saltation part. conc. from Bintanja 2001 (p
+  data      qsalt_param/"pom"/ ! saltation part. conc. from Pomeroy and Gray
+  !c#AE data      usth_param/"lis"/  ! u*t from Liston et al. 2007
+  data      usth_param/"gal"/  ! u*t from Gallee et al. 2001
+  data      SaltMx/-5.83e-2/
+
+  vk2    =  vonKrm  *  vonKrm             ! Square of Von Karman Constant
+
+
+  ! BEGIN.main.
+  ! ===========================
+
+
+
+
+  ! "Soil" Humidity of Water Bodies
+  ! ===============================
+
+  DO ikl=1,knonv
+
+      ist    =      isotSV(ikl)                       ! Soil Type
+      ist__s =  min(ist, 1)                           ! 1 => Soil
+      ist__w =  1 - ist__s                            ! 1 => Water Body
+    DO isl=-nsol,0
+      eta_SV(ikl,isl) = eta_SV(ikl,isl) * ist__s & ! Soil
+            + etadSV(ist)     * ist__w      ! Water Body
+    END DO
+
+
+  ! Vertical Discretization Factor
+  ! ==============================
+
+      LSdzsv(ikl)     =                   ist__s & ! Soil
+            + OcndSV          * ist__w      ! Water Body
+  END DO
+
+
+
+
+
+  IF (SnoMod)                            THEN
+
+
+  ! +--Aeolian erosion and Blowing Snow
+  ! +==================================
+
+
+
+    DO ikl=1,knonv
+        usthSV(ikl) =                     1.0e+2
+    END DO
+
+
+    IF (BloMod) THEN
+
+    if (klonv.eq.1) then
+      if(isnoSV(1).ge.2                   .and. &
+            TsisSV(1,max(1,isnoSV(1)))<273.  .and. &
+            ro__SV(1,max(1,isnoSV(1)))<500.  .and. &
+            eta_SV(1,max(1,isnoSV(1)))<epsi) then
+  ! +                       **********
+                 call SISVAT_BSn
+      endif
+     else
+                 call SISVAT_BSn
+  ! +                       **********
+    endif
+
+
+
+
+
+
+
+  ! Calculate threshold erosion velocity for next time step
+  ! Unlike in sisvat, computation is of threshold velocity made here (instead of sisvaesbl)
+  ! since we do not use sisvatesbl for the coupling with LMDZ
+
+  ! +--Computation of threshold friction velocity for snow erosion
+  ! ---------------------------------------------------------------
+
+    rCd10n =  1. / 26.5 ! Vt / u*t = 26.5
+                 ! ! Budd et al. 1965, Antarct. Res. Series Fig.13
+                 ! ! ratio developped during assumed neutral conditions
+
+
+  ! +--Snow Properties
+  ! +  ~~~~~~~~~~~~~~~
+
+    DO ikl = 1,knonv
+
+      isn      =  isnoSV(ikl)
+
+
+
+      DendOK   =  max(zero,sign(unun,epsi-G1snSV(ikl,isn)  ))  !
+      SaltOK   =  min(1   , max(istdSV(2)-istoSV(ikl,isn),0))  !
+      MeltOK   =     (unun & !
+            -max(zero,sign(unun,TfSnow-epsi & !
+            -TsisSV(ikl,isn)  ))) & ! Melting Snow
+            *  min(unun,DendOK & !
+            +(1.-DendOK) & !
+            *sign(unun,     G2snSV(ikl,isn)-1.0))  ! 1.0 for 1mm
+      SnowOK   =  min(1   , max(isnoSV(ikl)      +1 -isn ,0))  ! Snow Switch
+
+      G1snSV(ikl,isn) =      SnowOK *    G1snSV(ikl,isn) &
+            + (1.- SnowOK)*min(G1snSV(ikl,isn),G1_dSV)
+      G2snSV(ikl,isn) =      SnowOK *    G2snSV(ikl,isn) &
+            + (1.- SnowOK)*min(G2snSV(ikl,isn),G1_dSV)
+
+      SaltOK   =  min(unun, SaltOK + MeltOK) * SnowOK
+
+
+  ! +--Mobility Index (Guyomarc'h & Merindol 1997, Ann.Glaciol.)
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      SaltM1   = -0.750e-2 * G1snSV(ikl,isn) &
+            -0.500e-2 * G2snSV(ikl,isn)+ 0.500e00 !dendritic case
+  ! +     CAUTION:  Guyomarc'h & Merindol Dendricity Sign is +
+  ! +     ^^^^^^^^                    MAR Dendricity Sign is -
+      SaltM2   = -0.833d-2 * G1snSV(ikl,isn) &
+            -0.583d-2 * G2snSV(ikl,isn)+ 0.833d00 !non-dendritic case
+
+    ! SaltMo   = (DendOK   * SaltM1 + (1.-DendOK) *     SaltM2       )
+      SaltMo   = 0.625 !SaltMo pour d=s=0.5
+
+  !weighting SaltMo with surface snow density (Vionnet et al. 2012)
+  !c#AE   FacRho   = 1.25 - 0.0042 * ro__SV(ikl,isn)
+  !c#AE   SaltMo   = 0.34 * SaltMo + 0.66 * FacRho !needed for polar snow
+      MIN_Mo   =  0.
+    ! SaltMo   =  max(SaltMo,MIN_Mo)
+    ! SaltMo   =  SaltOK   * SaltMo + (1.-SaltOK) * min(SaltMo,SaltMx)
+  ! #TUNE SaltMo   =  SaltOK   * SaltMo - (1.-SaltOK) *     0.9500
+      SaltMo   =  max(SaltMo,epsi-unun)
+
+  ! +--Influence of Density on Threshold Shear Stress
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      Por_BS =  1. - 300. / ro_Ice
+      ShearS = Por_BS / (1.-Por_BS)
+  ! +...         SheaBS =  Arg(sqrt(shear = max shear stress in snow)):
+  ! +            shear  =  3.420d00 * exp(-(Por_BS      +Por_BS)
+  ! +  .                                  /(unun        -Por_BS))
+  ! +            SheaBS :  see de Montmollin         (1978),
+  ! +                      These Univ. Sci. Medic. Grenoble, Fig. 1 p. 124
+
+  ! +--Snow Drift Index (Guyomarc'h & Merindol 1997, Ann.Glaciol.)
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      ArguSi      =     -0.085 *us__SV(ikl)/rCd10n
+  !V=u*/sqrt(CD) eqs 2 to 4 Gallee et al. 2001
+
+      SaltSI(ikl,isn) = -2.868 * exp(ArguSi) + 1 + SaltMo
+
+
+  ! +--Threshold Friction Velocity
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if(ro__SV(ikl,isn)>300.) then
+         Por_BS      =  1.000       - ro__SV(ikl,isn)     /ro_Ice
+      else
+         Por_BS      =  1.000  - 300. /ro_Ice
+      endif
+
+      ShearX =  Por_BS/max(epsi,1.-Por_BS)
+      Fac_Mo = exp(-ShearX+ShearS)
+  ! +     Gallee et al., 2001    eq 5, p5
+
+      if (usth_param .eq. "gal") then
+        Salt_us   =   (log(2.868) - log(1 + SaltMo)) * rCd10n/0.085
+        Salt_us   = Salt_us * Fac_Mo
+  ! +...  Salt_us   :  Extension of  Guyomarc'h & Merindol 1998 with
+  ! +...              de Montmollin (1978). Gallee et al. 2001
+      endif
+
+      if (usth_param .eq. "lis") then !Liston et al. 2007
+        if(ro__SV(ikl,isn)>300.) then
+          Salt_us   = 0.005*exp(0.013*ro__SV(ikl,isn))
+        else
+          Salt_us   = 0.01*exp(0.003*ro__SV(ikl,isn))
+        endif
+      endif
+
+      SnowOK   =  1 -min(1,iabs(isn-isnoSV(ikl))) !Switch new vs old snow
+
+      usthSV(ikl) =     SnowOK *   (Salt_us) &
+            + (1.-SnowOK)*    usthSV(ikl)
+
+    END DO
+
+
+
+  !  Feeback between blowing snow turbulent Scale  u* (commented here
+  !  since ustar is an input variable (not in/out) of inlandsis)
+  !  -----------------------------------------------------------------
+
+
+        ! VVa_OK      =  max(0.000001,       VVaSBL(ikl))
+        ! sss__N      =  vonkar      *       VVa_OK
+        ! sss__F      = (sqrCm0(ikl) - psim_z + psim_0)
+        ! usuth0      =  sss__N /sss__F                ! u* if NO Blow. Snow
+
+        ! sss__G      =  0.27417     * gravit
+
+  ! !  ______________               _____
+  ! !  Newton-Raphson (! Iteration, BEGIN)
+  ! !  ~~~~~~~~~~~~~~               ~~~~~
+        ! DO iit=1,nit
+        ! sss__K      =  gravit      * r_Turb * A_Turb *za__SV(ikl)
+   ! .                                     *rCDmSV(ikl)*rCDmSV(ikl)
+   ! .                           /(1.+0.608*QaT_SV(ikl)-qsnoSV(ikl))
+   !      us_127      =  exp(    SblPom *log(us__SV(ikl)))
+   !      us_227      =  us_127         *    us__SV(ikl)
+   !      us_327      =  us_227         *    us__SV(ikl)
+   !      us_427      =  us_327         *    us__SV(ikl)
+   !      us_527      =  us_427         *    us__SV(ikl)
+
+   !      us__SV(ikl) =  us__SV(ikl)
+   ! .    - (  us_527     *sss__F     /sss__N
+   ! .      -  us_427
+   ! .      -  us_227     *qsnoSV(ikl)*sss__K
+   ! .      + (us__SV(ikl)*us__SV(ikl)-usthSV(ikl)*usthSV(ikl))/sss__G)
+   ! .     /(  us_427*5.27*sss__F     /sss__N
+   ! .      -  us_327*4.27
+   ! .      -  us_127*2.27*qsnoSV(ikl)*sss__K
+   ! .      +  us__SV(ikl)*2.0                                 /sss__G)
+
+   !      us__SV(ikl)= min(us__SV(ikl),usuth0)
+   !      us__SV(ikl)= max(us__SV(ikl),epsi  )
+   !      rCDmSV(ikl)=     us__SV(ikl)/VVa_OK
+  ! ! #AE     sss__F     =     vonkar     /rCDmSV(ikl)
+   !      ENDDO
+
+  ! !  ______________               ___
+  ! !  Newton-Raphson (! Iteration, END  )
+  ! !  ~~~~~~~~~~~~~~               ~~~
+
+   !      us_127      =  exp(    SblPom *log(us__SV(ikl)))
+   !      us_227      =  us_127         *    us__SV(ikl)
+
+  ! !  Momentum            Turbulent Scale  u*: 0-Limit in case of no Blow. Snow
+  ! !  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   !      dusuth      =  us__SV(ikl) - usthSV(ikl)       ! u* - uth*
+   !      signus      =  max(sign(unun,dusuth),zero)     ! 1 <=> u* - uth* > 0
+   !      us__SV(ikl) =                                  !
+   ! .                   us__SV(ikl)  *signus  +         ! u* (_BS)
+   ! .                   usuth0                          ! u* (nBS)
+   ! .                            *(1.-signus)           !
+
+
+
+
+  !  Blowing Snow        Turbulent Scale ss*
+  !  ---------------------------------------
+
+    hSalSV(ikl) = 8.436e-2  * us__SV(ikl)**SblPom
+
+    if (qsalt_param .eq. "pom") then
+      qSalSV(ikl) = (us__SV(ikl)**2 - usthSV(ikl)**2) *signus &
+            / (hSalSV(ikl) * gravit * us__SV(ikl) * 3.25)
+    endif
+
+    if (qsalt_param .eq. "bin") then
+      qSalSV(ikl) = (us__SV(ikl) * us__SV(ikl) &
+            -usthSV(ikl) * usthSV(ikl))*signus &
+            * 0.535 / (hSalSV(ikl) * gravit)
+    endif
+
+    qSalSV(ikl) = qSalSV(ikl)/rht_SV(ikl) ! conversion kg/m3 to kg/kg
+
+    ssstar      = rCDmSV(ikl) * (qsnoSV(ikl) - qSalSV(ikl)) &
+          * r_Turb !Bintanja 2000, BLM
+  !r_Turb compensates for an overestim. of the blown snow part. fall velocity
+
+    uss_SV(ikl) = min(zero    , us__SV(ikl) *ssstar)
+    uss_SV(ikl) = max(-0.0001 , uss_SV(ikl))
+
+
+
+
+    ENDIF   ! BloMod
+
+  ! + ------------------------------------------------------
+  ! +--Buffer Layer
+  ! +  -----------------------------------------------------
+
+      DO ikl=1,knonv
+  !  BufsSV(ikl) [mm w.e.] i.e, i.e., [kg/m2]
+        d_Bufs      =  max(dsn_SV(ikl) *dt__SV,0.)  !
+        dsn_SV(ikl) =      0.                       !
+        Bufs_N      =      BufsSV(ikl) +d_Bufs      !
+
+
+  ! +--Snow Density
+  ! +  ^^^^^^^^^^^^
+        Polair      =      zero
+  ! #NP       Polair      =  max(zero,                    !
+  ! #NP.                         sign(unun,TaPole         !
+  ! #NP.                                  -TaT_SV(ikl)))  !
+        Polair      =  max(zero, & !
+              sign(unun,TaPole & !
+              -TaT_SV(ikl)))  !
+        Buf_ro      =  max( rosMin, & ! Fallen Snow Density
+              roSn_1+roSn_2*     (TaT_SV(ikl)-TfSnow) & ! [kg/m3]
+              +roSn_3*sqrt( VV__SV(ikl)))           ! Pahaut    (CEN), Etienne: use wind speed at first model level instead of 10m wind
+  ! #NP       BufPro      =  max( rosMin,                 ! Fallen Snow Density
+  ! #NP.         104. *sqrt( max( VV10SV(ikl)-6.0,0.0)))  ! Kotlyakov (1961)
+
+       ! C.Agosta option for snow density, same as for BS i.e.
+       ! is_ok_density_kotlyakov=.false.
+  ! #BS       density_kotlyakov = .false.  !C.Amory BS 2018
+  ! + ...     Fallen Snow Density, Adapted for Antarctica
+        if (is_ok_density_kotlyakov) then
+            tt_tmp = TaT_SV(ikl)-TfSnow
+            ! !vv_tmp = VV10SV(ikl)
+            vv_tmp=VV__SV(ikl) ! Etienne: use wind speed at first model level instead of 10m wind
+  ! + ...         [ A compromise between
+  ! + ...           Kotlyakov (1961) and Lenaerts (2012, JGR, Part1) ]
+            if (tt_tmp.ge.-10) then
+              BufPro   =  max( rosMin, &
+                    104. *sqrt( max( vv_tmp-6.0,0.0))) ! Kotlyakov (1961)
+            else
+              vv_virt = (tt_c*vv_tmp+vv_c*(tt_tmp+10)) &
+                    /(tt_c+tt_tmp+10)
+              BufPro  = 104. *sqrt( max( vv_virt-6.0,0.0))
+            endif
+        else
+  ! + ...         [ density derived from observations of the first 50cm of
+  ! + ...           snow - cf. Rajashree Datta - and multiplied by 0.8 ]
+  ! + ...           C. Agosta, 2016-09
+  !c #SD           BufPro = 149.2 + 6.84*VV10SV(ikl) + 0.48*Tsrfsv(ikl)
+  !c #SD           BufPro = 125 + 14*VV10SV(ikl) + 0.6*Tsrfsv(ikl) !MAJ CK and CAm
+             ! BufPro = 200 + 21 * VV10SV(ikl)!CK 29/07/19
+             BufPro = 200 + 21 * VV__SV(ikl)!Etienne: use wind speed at first model level instead of 10m wind
+        endif
+
+        Bros_N      = (1. - Polair) *   Buf_ro & ! Temperate Snow
+              + Polair  *   BufPro      ! Polar     Snow
+
+        Bros_N = max( 20.,max(rosMin,  Bros_N))
+        Bros_N = min(400.,min(rosMax-1,Bros_N)) ! for dz_min in SISVAT_zSn
+
+
+  !    Density of deposited blown snow
+  !    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+     if (BloMod) then
+     Bros_N      = frsno
+     ro_new      = ro__SV(ikl,max(1,isnoSV(ikl)))
+     ro_new      = max(Bros_N,min(roBdSV,ro_new))
+     Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl))) &
+           -roBdSV)/(500.-roBdSV))
+     Fac         = max(0.,min(1.,Fac))
+     dsnbSV(ikl) = Fac*dsnbSV(ikl)
+     Bros_N      = Bros_N     * (1.0-dsnbSV(ikl)) &
+           + ro_new     *      dsnbSV(ikl)
+     endif
+
+
+  !    Time averaged Density of deposited blown Snow
+  !    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        BrosSV(ikl) =(Bros_N     *      d_Bufs & !
+              +BrosSV(ikl)*      BufsSV(ikl)) & !
+              /         max(epsi,Bufs_N)     !
+
+
+  ! +-- S.Falling Snow Properties (computed as in SISVAT_zAg)
+  ! +     ^^^^^^^^^^^^^^^^^^^^^^^
+        Buf_G1      =  max(-G1_dSV, & ! Temperate Snow
+              min(Dendr1*VV__SV(ikl)-Dendr2, & !     Dendricity
+              Dendr3                   ))    !
+        Buf_G2      =  min( Spher4, & ! Temperate Snow
+              max(Spher1*VV__SV(ikl)+Spher2, & !     Sphericity
+              Spher3                   ))    !
+  ! EV: now control buf_sph_pol and bug_siz_pol in physiq.def
+        Buf_G1      = (1. - Polair) *   Buf_G1 & ! Temperate Snow
+              + Polair  *   buf_sph_pol ! Polar Snow
+        Buf_G2      = (1. - Polair) *   Buf_G2 & ! Temperate Snow
+              + Polair  *   buf_siz_pol ! Polar Snow
+            G1      =                   Buf_G1      ! NO  Blown Snow
+            G2      =                   Buf_G2      ! NO  Blown Snow
+
+
+
+        IF (BloMod) THEN
+
+  ! S.1. Meme  Type  de Neige  / same Grain Type
+  !      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+       SameOK  =  max(zero, &
+             sign(unun,    Buf_G1             *G1_dSV &
+             - eps_21                    ))
+       G1same  = ((1.0-dsnbSV(ikl))*Buf_G1+dsnbSV(ikl) *G1_dSV)
+       G2same  = ((1.0-dsnbSV(ikl))*Buf_G2+dsnbSV(ikl) *ADSdSV)
+        ! Blowing Snow Properties:                         G1_dSV, ADSdSV
+
+  ! S.2. Types differents / differents Types
+  !      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+       typ__1  =  max(zero,sign(unun,epsi-Buf_G1))   ! =1.=> Dendritic
+       zroNEW  =     typ__1  *(1.0-dsnbSV(ikl)) & ! fract.Dendr.Lay.
+             + (1.-typ__1) *     dsnbSV(ikl)       !
+       G1_NEW  =     typ__1  *Buf_G1 & ! G1 of Dendr.Lay.
+             + (1.-typ__1) *G1_dSV                 !
+       G2_NEW  =     typ__1  *Buf_G2 & ! G2 of Dendr.Lay.
+             + (1.-typ__1) *ADSdSV                 !
+       zroOLD  = (1.-typ__1) *(1.0-dsnbSV(ikl)) & ! fract.Spher.Lay.
+             +     typ__1  *     dsnbSV(ikl)       !
+       G1_OLD  = (1.-typ__1) *Buf_G1 & ! G1 of Spher.Lay.
+             +     typ__1  *G1_dSV                 !
+       G2_OLD  = (1.-typ__1) *Buf_G2 & ! G2 of Spher.Lay.
+             +     typ__1  *ADSdSV                 !
+       SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV & ! Size  Dendr.Lay.
+             +(1.+G1_NEW         /G1_dSV) & !
+             *(G2_NEW  *DScdSV/G1_dSV & !
+             +(1.-G2_NEW         /G1_dSV)*DFcdSV)  !
+       SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
+       SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
+       SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
+       Siz_av  =     (zroNEW*SizNEW+zroOLD*SizOLD)   ! Averaged Size
+       Sph_av  = min( zroNEW*SphNEW+zroOLD*SphOLD & !
+             ,  unun)                         ! Averaged Sphericity
+       Den_av  = min((Siz_av -(    Sph_av *DScdSV & !
+             +(1.-Sph_av)*DFcdSV)) & !
+             / (DDcdSV -(    Sph_av *DScdSV & !
+             +(1.-Sph_av)*DFcdSV)) & !
+             ,  unun)                       !
+       DendOK  = max(zero, & !
+             sign(unun,     Sph_av *DScdSV & ! Small   Grains
+             +(1.-Sph_av)*DFcdSV & ! Faceted Grains
+             -    Siz_av        )) !
+  ! +...      REMARQUE: le  type moyen (dendritique ou non) depend
+  ! +         ^^^^^^^^  de la  comparaison avec le diametre optique
+  ! +                   d'une neige recente de   dendricite nulle
+  ! +...      REMARK:   the mean type  (dendritic   or not) depends
+  ! +         ^^^^^^    on the comparaison with the optical diameter
+  ! +                   of a recent snow    having zero dendricity
+
+       G1diff  =(   -DendOK *Den_av &
+             +(1.-DendOK)*Sph_av) *G1_dSV
+       G2diff  =     DendOK *Sph_av  *G1_dSV &
+             +(1.-DendOK)*Siz_av
+       G1      =     SameOK *G1same &
+             +(1.-SameOK)*G1diff
+       G2      =     SameOK *G2same &
+             +(1.-SameOK)*G2diff
+       ENDIF
+
+
+
+  ! S.1. Meme  Type  de Neige  / same Grain Type
+  !      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        SameOK  =  max(zero, &
+              sign(unun,    Buf_G1 *BG1sSV(ikl) &
+              - eps_21                    ))
+        G1same  = (d_Bufs*Buf_G1+BufsSV(ikl)*BG1sSV(ikl)) &
+              /max(epsi,Bufs_N)
+        G2same  = (d_Bufs*Buf_G2+BufsSV(ikl)*BG2sSV(ikl)) &
+              /max(epsi,Bufs_N)
+
+  ! S.2. Types differents / differents Types
+  !      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+        typ__1  =  max(zero,sign(unun,epsi-Buf_G1))   ! =1.=> Dendritic
+        zroNEW  =(    typ__1  *d_Bufs & ! fract.Dendr.Lay.
+              + (1.-typ__1) *BufsSV(ikl)) & !
+              /max(epsi,Bufs_N)                !
+        G1_NEW  =     typ__1  *Buf_G1 & ! G1 of Dendr.Lay.
+              + (1.-typ__1) *BG1sSV(ikl)            !
+        G2_NEW  =     typ__1  *Buf_G2 & ! G2 of Dendr.Lay.
+              + (1.-typ__1) *BG2sSV(ikl)            !
+        zroOLD  =((1.-typ__1) *d_Bufs & ! fract.Spher.Lay.
+              +     typ__1  *BufsSV(ikl)) & !
+              /max(epsi,Bufs_N)                !
+        G1_OLD  = (1.-typ__1) *Buf_G1 & ! G1 of Spher.Lay.
+              +     typ__1  *BG1sSV(ikl)            !
+        G2_OLD  = (1.-typ__1) *Buf_G2 & ! G2 of Spher.Lay.
+              +     typ__1  *BG2sSV(ikl)            !
+        SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV & ! Size  Dendr.Lay.
+              +(1.+G1_NEW         /G1_dSV) & !
+              *(G2_NEW  *DScdSV/G1_dSV & !
+              +(1.-G2_NEW         /G1_dSV)*DFcdSV) !
+        SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
+        SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
+        SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
+        Siz_av  =   ( zroNEW  *SizNEW+zroOLD*SizOLD)  ! Averaged Size
+        Sph_av = min( zroNEW  *SphNEW+zroOLD*SphOLD & !
+              ,   unun                       )  ! Averaged Sphericity
+        Den_av = min((Siz_av  - (    Sph_av *DScdSV & !
+              +(1.-Sph_av)*DFcdSV)) & !
+              / (DDcdSV  - (    Sph_av *DScdSV & !
+              +(1.-Sph_av)*DFcdSV)) & !
+              ,   unun                         )!
+        DendOK  = max(zero, & !
+              sign(unun,     Sph_av *DScdSV & ! Small   Grains
+              +(1.-Sph_av)*DFcdSV & ! Faceted Grains
+              -    Siz_av        )) !
+  ! +...      REMARQUE: le  type moyen (dendritique ou non) depend
+  ! +         ^^^^^^^^  de la  comparaison avec le diametre optique
+  ! +                   d'une neige recente de   dendricite nulle
+  ! +...      REMARK:   the mean type  (dendritic   or not) depends
+  ! +         ^^^^^^    on the comparaison with the optical diameter
+  ! +                   of a recent snow    having zero dendricity
+
+        G1diff  =(   -DendOK *Den_av &
+              +(1.-DendOK)*Sph_av) *G1_dSV
+        G2diff  =     DendOK *Sph_av  *G1_dSV &
+              +(1.-DendOK)*Siz_av
+        G1      =     SameOK *G1same &
+              +(1.-SameOK)*G1diff
+        G2      =     SameOK *G2same &
+              +(1.-SameOK)*G2diff
+
+        BG1sSV(ikl) =                       G1 & !
+              *       Bufs_N/max(epsi,Bufs_N) !
+        BG2sSV(ikl) =                       G2 & !
+              *       Bufs_N/max(epsi,Bufs_N) !
+
+
+  ! +--Update of Buffer Layer Content & Decision about creating a new snow layer
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        BufsSV(ikl) =       Bufs_N                  !     [mm w.e.]
+        NLaysv(ikl) = min(unun, & !
+              max(zero, & ! Allows to create
+              sign(unun,BufsSV(ikl) & ! a new snow Layer
+              -SMndSV     )) & ! if Buffer > SMndSV
+              *max(zero, & ! Except if * Erosion
+              sign(unun,0.50 & ! dominates
+              -dsnbSV(ikl))) & !
+              +max(zero, & ! Allows to create
+              sign(unun,BufsSV(ikl) & ! a new snow Layer
+              -SMndSV*3.00)))  ! is Buffer > SMndSV*3
+        Bdzssv(ikl) = 1.e-3*BufsSV(ikl)*ro_Wat & ! [mm w.e.] -> [m w.e.]
+              /max(epsi,BrosSV(ikl))!& [m w.e.] -> [m]
+
+
+      END DO
+
+
+
+  ! Snow Pack Discretization(option XF in MAR)
+  ! ==========================================
+
+
+  if (discret_xf.AND.klonv.eq.1) then
+
+   if(isnoSV(1).ge.1.or.NLaysv(1).ge.1) then
+  ! +          **********
+     call SISVAT_zSn
+  ! +          **********
+   endif
+  else
+  ! +          **********
+    call SISVAT_zSn
+  ! +          **********
+  endif
+
+  ! +          **********
+  ! #ve   call SISVAT_wEq('_zSn  ',0)
+  ! +          **********
+
+  ! Add a new Snow Layer
+  ! ====================
+
+      DO ikl=1,knonv
+
+        isnoSV(ikl)     = isnoSV(ikl)         +NLaysv(ikl)
+        isn             = isnoSV(ikl)
+        dzsnSV(ikl,isn) = dzsnSV(ikl,isn) * (1-NLaysv(ikl)) &
+              + Bdzssv(ikl)     *    NLaysv(ikl)
+        TsisSV(ikl,isn) = TsisSV(ikl,isn) * (1-NLaysv(ikl)) &
+              + min(TaT_SV(ikl),Tf_Sno) *NLaysv(ikl)
+        ro__SV(ikl,isn) = ro__SV(ikl,isn) * (1-NLaysv(ikl)) &
+              + Brossv(ikl)     *    NLaysv(ikl)
+        eta_SV(ikl,isn) = eta_SV(ikl,isn) * (1-NLaysv(ikl))   ! + 0.
+        agsnSV(ikl,isn) = agsnSV(ikl,isn) * (1-NLaysv(ikl))   ! + 0.
+        G1snSV(ikl,isn) = G1snSV(ikl,isn) * (1-NLaysv(ikl)) &
+              + BG1ssv(ikl)     *    NLaysv(ikl)
+        G2snSV(ikl,isn) = G2snSV(ikl,isn) * (1-NLaysv(ikl)) &
+              + BG2ssv(ikl)     *    NLaysv(ikl)
+        istoSV(ikl,isn) = istoSV(ikl,isn) * (1-NLaysv(ikl)) &
+              + max(zer0,sign(un_1,TaT_SV(ikl) &
+              -Tf_Sno-eps_21)) *    istdSV(2) &
+              *    NLaysv(ikl)
+        BufsSV(ikl)     = BufsSV(ikl)     * (1-NLaysv(ikl))
+        NLaysv(ikl)     = 0
+
+
+      END DO
+
+
+  ! Snow Pack Thickness
+  ! -------------------
+
+    DO ikl=1,knonv
+        z_snsv(ikl)     = 0.0
+    END DO
+    DO   isn=1,nsno
+      DO ikl=1,knonv
+        z_snsv(ikl)     = z_snsv(ikl) + dzsnSV(ikl,isn)
+        zzsnsv(ikl,isn) = z_snsv(ikl)
+      END DO
+    END DO
+
+
+
+  END IF  ! SnoMod
+
+
+
+  ! Soil Albedo: Soil Humidity Correction
+  ! ==========================================
+
+      ! REFERENCE: McCumber and Pielke (1981), Pielke (1984)
+      ! ^^^^^^^^^
+      DO ikl=1,knonv
+        albssv(ikl) = &
+              alb0SV(ikl) *(1.0-min(half,eta_SV(       ikl,0) &
+              /etadSV(isotSV(ikl))))
+      ! REMARK:    Albedo of Water Surfaces (isotSV=0):
+      ! ^^^^^^     alb0SV := 2  X  effective value, while
+      !            eta_SV :=          etadSV
+      END DO
+
+
+  ! Snow Pack Optical Properties
+  ! ============================
+
+  IF (SnoMod)                                                 THEN
+
+         ! ******
+    call SnOptP(jjtime)
+         ! ******
+
+  ELSE
+    DO ikl=1,knonv
+      sEX_sv(ikl,1) = 1.0
+      sEX_sv(ikl,0) = 0.0
+      albisv(ikl)   = albssv(ikl)
+    END DO
+  END IF
+
+
+
+  ! Soil optical properties
+  ! =============================
+  !Etienne: as in inlandis we do not call vgopt, we need to define
+  !the albedo alb_SV and to calculate the
+  !absorbed Solar Radiation by Surfac (Normaliz)[-] SoSosv
+
+
+  DO ikl=1,klonv
+
+        e_pRad = 2.5   *  coszSV(ikl)       ! exponential argument,
+                                            ! ! V/nIR radiation partitioning,
+                                            ! ! DR97, 2, eqn (2.53) & (2.54)
+        e1pRad = 1.-exp(-e_pRad)            ! exponential, V/nIR Rad. Part.
+        exdRad= 1.
+
+  ! Visible Part of the Solar Radiation Spectrum (V,   0.4--0.7mi.m)
+        A_Rad0 =      0.25 + 0.697 * e1pRad ! Absorbed    Vis. Radiation
+        absg_V = (1.-albisv(ikl))*(A_Rad0*exdRad)  !
+
+  ! Near-IR Part of the Solar Radiation Spectrum (nIR, 0.7--2.8mi.m)
+
+        A_Rad0 =      0.80 + 0.185 * e1pRad ! Absorbed    nIR. Radiation
+        absgnI = (1.-albisv(ikl))*(A_Rad0*exdRad)  !
+
+        SoSosv(ikl) = (absg_V+absgnI)*0.5d0
+
+        alb_SV(ikl) = albisv(ikl)
+
+  END DO
+
+         ! **********
+  ! #ve   call SISVAT_wEq('SnOptP',0)
+         ! **********
+
+
+  ! Surface Emissivity (Etienne: simplified calculation for landice)
+  ! =============================================================
+  !
+   DO ikl=1,knonv
+        LSnMsk     =     min( 1,isnoSV(ikl))
+        Eso_sv(ikl)=  EmiSol*(1-LSnMsk)+EmiSno*LSnMsk  ! Sol+Sno Emissivity
+        emi_SV(ikl)= EmiSol*(1-LSnMsk) + EmiSno*LSnMsk
+    END DO
+
+
+
+
+  !  Upward IR (INPUT, from previous time step)
+  ! ===================================================================
+
+    DO ikl=1,knonv
+  ! #e1     Enrsvd(ikl) =    - IRs_SV(ikl)
+       IRupsv(ikl) =      IRs_SV(ikl)
+    END DO
+
+
+  ! Turbulence
+  ! ==========
+
+  ! Latent Heat of Vaporization/Sublimation
+  ! ---------------------------------------
+
+    DO ikl=1,knonv
+      SnoWat      =                     min(isnoSV(ikl),0)
+      Lx_H2O(ikl) = &
+            (1.-SnoWat) * LhvH2O &
+            +     SnoWat  *(LhsH2O * (1.-eta_SV(ikl,isnoSV(ikl))) &
+            +LhvH2O *     eta_SV(ikl,isnoSV(ikl)) )
+    END DO
+
+
+
+
+  ! Aerodynamic Resistance (calculated from drags given by LMDZ)
+  ! Commented because already calculated in surf_inlandsis_mod
+  ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    ! DO ikl=1,knonv
+    !    ram_sv(ikl) = 1./(cdM_SV(ikl)*max(VV__SV(ikl),eps6))
+    !    rah_sv(ikl) = 1./(cdH_SV(ikl)*max(VV__SV(ikl),eps6))
+    !  END DO
+
+
+
+  ! Soil   Energy Balance
+  ! =====================
+
+
+  if (iflag_temp_inlandsis .eq. 0) then
+
+   call SISVAT_TSo
+
+  else
+    DO ikl=1,knonv
+    Tsf_SV(ikl)=Tsrfsv(ikl)
+    END DO
+
+   call SISVAT_TS2
+
+  end if
+
+
+         ! **********
+  ! #ve   call SISVAT_wEq('_TSo  ',0)
+         ! **********
+
+
+
+  ! Soil Water     Potential
+  ! ------------------------
+
+  DO   isl=-nsol,0
+    DO ikl=1,knonv
+      ist             =     isotSV(ikl)        ! Soil Type
+      psi_sv(ikl,isl) =     psidSV(ist) & ! DR97, Eqn.(3.34)
+            *(etadSV(ist) /max(eps6,eta_SV(ikl,isl))) & !
+            **bCHdSV(ist)                              !
+
+
+  ! Soil Hydraulic Conductivity
+  ! ---------------------------
+
+      Khydsv(ikl,isl) =    s2__SV(ist) & ! DR97, Eqn.(3.35)
+            *(eta_SV(ikl,isl)**(2.*bCHdSV(ist)+3.))    !
+    END DO
+  END DO
+
+
+  ! Melting / Refreezing in the Snow Pack
+  ! =====================================
+
+  IF (SnoMod)                                                 THEN
+
+         ! **********
+    call SISVAT_qSn
+         ! **********
+
+         ! **********
+  ! #ve   call SISVAT_wEq('_qSn  ',0)
+         ! **********
+
+
+  ! Snow Pack Thickness
+  ! -------------------
+
+      DO ikl=1,knonv
+        z_snsv(ikl)     = 0.0
+      END DO
+    DO   isn=1,nsno
+      DO ikl=1,knonv
+        z_snsv(ikl)     = z_snsv(ikl) + dzsnSV(ikl,isn)
+        zzsnsv(ikl,isn) = z_snsv(ikl)
+      END DO
+    END DO
+
+
+  ! Energy in Excess is added to the first Soil Layer
+  ! -------------------------------------------------
+    DO ikl=1,knonv
+        z_snsv(ikl)   = max(zer0, &
+              sign(un_1,eps6-z_snsv(ikl)))
+        TsisSV(ikl,0) = TsisSV(ikl,0)    + EExcsv(ikl) &
+              /(rocsSV(isotSV(ikl)) &
+              +rcwdSV*eta_SV(ikl,0))
+        EExcsv(ikl)   = 0.
+    END DO
+
+
+  END IF
+
+
+  ! Soil   Water  Balance
+  ! =====================
+
+         ! **********
+    call SISVAT_qSo
+  ! #m0.                 (Wats_0,Wats_1,Wats_d)
+         ! **********
+
+
+  ! Surface Fluxes
+  ! =====================
+
+    DO ikl=1,knonv
+     IRdwsv(ikl)=IRd_SV(ikl)*Eso_sv(ikl) ! Downward IR
+      ! IRdwsv(ikl)=tau_sv(ikl) *IRd_SV(ikl)*Eso_sv(ikl) ! Downward IR
+  !    .          +(1.0-tau_sv(ikl))*IRd_SV(ikl)*Evg_sv(ikl) !  ! Etienne, remove vegetation component
+      IRupsv(ikl) =      IRupsv(ikl)                   ! Upward   IR
+      IRu_SV(ikl) =     -IRupsv(ikl) & ! Upward   IR
+            +IRd_SV(ikl) & ! (effective)
+            -IRdwsv(ikl)                   ! (positive)
+
+      TBr_sv(ikl) =sqrt(sqrt(IRu_SV(ikl)/StefBo))      ! Brightness
+                                                       ! ! Temperature
+      uts_SV(ikl) =     (HSv_sv(ikl) +HSs_sv(ikl)) & ! u*T*
+            /(rhT_SV(ikl) *cp)          !
+      uqs_SV(ikl) =     (HLv_sv(ikl) +HLs_sv(ikl)) & ! u*q*
+            /(rhT_SV(ikl) *LhvH2O)          !
+      LMO_SV(ikl) = TaT_SV(ikl)*(us__SV(ikl)**3) &
+            /gravit/uts_SV(ikl)/vonKrm      ! MO length
+
+
+  ! Surface Temperature
+  ! ^^^^^^^^^^^^^^^^^^^^
+
+      IF (iflag_tsurf_inlandsis .EQ. 0) THEN
+
+        Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
+
+      ELSE IF (iflag_tsurf_inlandsis .GT. 0) THEN
+  ! Etienne: extrapolation from the two uppermost levels:
+
+     if (isnoSV(ikl) >=2) then
+       zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
+       zm2=-(dzsnSV(ikl,isnoSV(ikl)) + dzsnSV(ikl,isnoSV(ikl)-1)/2.)
+     else if (isnoSV(ikl) .EQ. 1) then
+       zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
+       zm2=-(dzsnSV(ikl,isnoSV(ikl))+dz_dSV(0)/2.)
+     else
+       zm1=-dz_dSV(0)/2.
+       zm2=-(dz_dSV(0)+dz_dSV(-1)/2.)
+
+     end if
+
+       coefslope=(TsisSV(ikl,isnoSV(ikl))-TsisSV(ikl,isnoSV(ikl)-1)) &
+             /(zm1-zm2)
+       Tsrfsv(ikl)=TsisSV(ikl,isnoSV(ikl))+coefslope*(0. - zm1)
+
+
+     ELSE !(default)
+
+       Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
+
+     END IF
+
+
+     END DO
+
+  ! Snow Pack Properties (sphericity, dendricity, size)
+  ! ===================================================
+
+  IF (SnoMod)                                                 THEN
+
+  if (discret_xf .AND. klonv.eq.1) then
+  if(isnoSV(1).ge.1) then
+  ! +          **********
+  call SISVAT_GSn
+  ! +          **********
+  endif
+  else
+  ! +          **********
+    call SISVAT_GSn
+  ! +          **********
+  endif
+
+
+  END IF
+
+
+  ! Roughness Length for next time step
+  !====================================
+
+  ! Note that in INLANDSIS, we treat only ice covered surfaces so calculation
+  ! of z0 is much simpler (no subgrid fraction of ocean or land)
+  ! old calculations are commented below
+
+
+  ! +--Roughness Length for Momentum
+  ! +  -----------------------------
+
+  ! ETIENNE WARNING: changes have been made wrt original SISVAT
+
+  ! +--Land+Sea-Ice / Ice-free Sea Mask
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    DO ikl=1,knonv
+      IcIndx(ikl) = 0
+    ENDDO
+    DO isn=1,nsno
+    DO ikl=1,knonv
+
+      IcIndx(ikl) = max(IcIndx(ikl), &
+            isn*max(0, &
+            sign(1, &
+            int(ro__SV(ikl,isn)-900.))))
+    ENDDO
+    ENDDO
+
+    DO ikl=1,knonv
+      LISmsk    =     1. ! in inlandsis, land only
+      IceMsk    =     max(0,sign(1   ,IcIndx(ikl)-1)  )
+      SnoMsk    = max(min(isnoSV(ikl)-iiceSV(ikl),1),0)
+
+
+  ! +--Z0 Smooth Regime over Snow (Andreas 1995, CRREL Report 95-16, p. 8)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+      Z0m_nu =       5.e-5 ! z0s~(10-d)*exp(-vonkar/sqrt(1.1e-03))
+
+  ! +--Z0 Saltat.Regime over Snow (Gallee  et al., 2001, BLM 99 (19) p.11)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+      u2star =       us__SV(ikl) *us__SV(ikl)
+      Z0mBSn =       u2star      *0.536e-3   -  61.8e-6
+      Z0mBSn =   max(Z0mBS0      ,Z0mBSn)
+
+  ! +--Z0 Smooth + Saltat. Regime
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+      Z0enSV(ikl) =  Z0m_nu &
+            +  Z0mBSn
+
+
+  ! Calculation of snow roughness length
+  !=====================================
+      IF (iflag_z0m_snow .EQ. 0) THEN
+
+      Z0m_Sn=prescribed_z0m_snow
+
+      ELSE IF (iflag_z0m_snow .EQ. 1) THEN
+
+      Z0m_Sn=Z0enSV(ikl)
+
+      ELSE IF (iflag_z0m_snow .EQ. 2) THEN
+
+  ! +--Rough   Snow Surface Roughness Length (Variable Sastrugi Height)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      A_Fact      =  1.0000        ! Andreas et al., 2004, p.4
+                                   ! ! ams.confex.com/ams/pdfpapers/68601.pdf
+
+  ! Parameterization of z0 dependance on Temperature (C. Amory, 2017)
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  ! Z0=f(T) deduced from observations, Adelie Land, dec2012-dec2013
+
+
+      coefa = 0.1658 !0.1862 !Ant
+      coefb = -50.3869 !-55.7718 !Ant
+      ta1 = 253.15 !255. Ant
+      ta2 = 273.15
+      ta3 = 273.15+3
+      z01 = exp(coefa*ta1 + coefb) !~0.2 ! ~0.25 mm
+      z02 = exp(coefa*ta2 + coefb) !~6  !~7 mm
+      z03 = z01
+      coefc = log(z03/z02)/(ta3-ta2)
+      coefd = log(z03)-coefc*ta3
+
+      if (TaT_SV(ikl) .lt. ta1) then
+        Z0_obs = z01
+      else if (TaT_SV(ikl).ge.ta1 .and. TaT_SV(ikl).lt.ta2) then
+        Z0_obs = exp(coefa*TaT_SV(ikl) + coefb)
+      else if (TaT_SV(ikl).ge.ta2 .and. TaT_SV(ikl).lt.ta3) then
+        ! ! if st > 0, melting induce smooth surface
+        Z0_obs = exp(coefc*TaT_SV(ikl) + coefd)
+      else
+        Z0_obs = z03
+      endif
+
+      Z0m_Sn=Z0_obs
+
+
+      ELSE
+
+      Z0m_Sn=0.500e-3  ! default=0.500e-3m (tuning of MAR)
+
+      ENDIF
+
+
+
+       ! param = Z0_obs/1. ! param(s) | 1.(m/s)=TUNING
+  ! #SZ     Z0Sa_N =                   (us__SV(ikl) -0.2)*param   ! 0.0001=TUNING
+  ! #SZ.           * max(zero,sign(unun,TfSnow-eps9
+  ! #SZ.                               -TsisSV(ikl , isnoSV(ikl))))
+  !!#SZ     Z0SaSi = max(zero,sign(unun,Z0Sa_N                  ))! 1 if erosion
+  ! #SZ     Z0SaSi = max(zero,sign(unun,zero  -eps9 -uss_SV(ikl)))!
+  ! #SZ     Z0Sa_N = max(zero,          Z0Sa_N)
+  ! #SZ     Z0SaSV(ikl) =
+  ! #SZ.             max(Z0SaSV(ikl)   ,Z0SaSV(ikl)
+  ! #SZ.               + Z0SaSi*(Z0Sa_N-Z0SaSV(ikl))*exp(-dt__SV/43200.))
+  ! #SZ.               -            min(dz0_SV(ikl) ,     Z0SaSV(ikl))
+
+  ! #SZ     A_Fact      =               Z0SaSV(ikl) *  5.0/0.15   ! A=5 if h~10cm
+  ! +...    CAUTION: The influence of the sastrugi direction is not yet included
+
+  ! #SZ     Z0m_Sn =                    Z0SaSV(ikl)               !
+  ! #SZ.                              - Z0m_nu                    !
+
+  ! +--Z0 Saltat.Regime over Snow (Shao & Lin, 1999, BLM 91 (46)  p.222)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+  ! #ZN     sqrrZ0 =       usthSV(ikl)/max( us__SV(ikl),0.001)
+  ! #ZN     sqrrZ0 =                   min( sqrrZ0     ,0.999)
+  ! #ZN     Z0mBSn =       0.55 *0.55 *exp(-sqrrZ0     *sqrrZ0)
+  ! #ZN.                  *us__SV(ikl)*     us__SV(ikl)*grvinv*0.5
+
+  ! +--Z0 Smooth + Saltat. Regime (Shao & Lin, 1999, BLM 91 (46)  p.222)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+  ! #ZN     Z0enSV(ikl) = (Z0m_nu     **    sqrrZ0 )
+  ! #ZN.                * (Z0mBSn     **(1.-sqrrZ0))
+  ! #ZN     Z0enSV(ikl) =  max(Z0enSV(ikl), Z0m_nu)
+
+
+  ! +--Z0 Smooth Regime over Snow (Andreas etAl., 2004
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
+  ! #ZA     Z0m_nu = 0.135*akmol  / max(us__SV(ikl) , epsi)
+
+  ! +--Z0 Saltat.Regime over Snow (Andreas etAl., 2004
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
+  ! #ZA     Z0mBSn = 0.035*u2star      *grvinv
+
+  ! +--Z0 Smooth + Saltat. Regime (Andreas etAl., 2004
+  !    (      used by Erosion)     ams.confex.com/ams/pdfpapers/68601.pdf)
+  !    ^^^^^^^^^^^^^^^^^^^^^^^^^^
+  ! #ZA     Z0enSV(ikl) =  Z0m_nu
+  ! #ZA.                +  Z0mBSn
+
+  ! +--Z0 Rough  Regime over Snow (Andreas etAl., 2004
+  ! +  (.NOT. used by Erosion)     ams.confex.com/ams/pdfpapers/68601.pdf)
+  !    ^^^^^^^^^^^^^^^^^^^^^^^^^^
+  !!#ZA     u2star =      (us__SV(ikl) -0.1800)     / 0.1
+  !!#ZA     Z0m_Sn =A_Fact*Z0mBSn *exp(-u2star*u2star)
+  ! #ZA     Z0m_90 =(10.-0.025*VVs_SV(ikl)/5.)
+  ! #ZA.            *exp(-0.4/sqrt(.00275+.00001*max(0.,VVs_SV(ikl)-5.)))
+  ! #ZA     Z0m_Sn =           DDs_SV(ikl)* Z0m_90 / 45.
+  ! #ZA.         - DDs_SV(ikl)*DDs_SV(ikl)* Z0m_90 /(90.*90.)
+
+
+
+
+  ! +--Z0  (Erosion)    over Snow (instantaneous)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+      Z0e_SV(ikl) =  Z0enSV(ikl)
+
+  ! +--Momentum  Roughness Length (Etienne: changes wrt original SISVAT)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      Z0mnSV(ikl) =  Z0m_nu *(1-SnoMsk) & ! Ice z0
+            + (Z0m_Sn)*SnoMsk                         ! Snow Sastrugi Form and Snow Erosion
+
+
+  ! +--GIS  Roughness Length
+  ! +  ^^^^^^^^^^^^^^^^^^^^^
+  ! #GL     Z0mnSV(ikl) =
+  ! #GL.      (1-LSmask(ikl)) *     Z0mnSV(ikl)
+  ! #GL.    +    LSmask(ikl)  * max(Z0mnSV(ikl),max(Z0_GIM,
+  ! #GL.                                            Z0_GIM+
+  ! #GL.      (0.0032-Z0_GIM)*(ro__SV(ikl,isnoSV(ikl))-600.)   !
+  ! #GL.                     /(920.00                 -600.))) !
+
+  ! +--Mom. Roughness Length, Instantaneous
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      Z0m_SV(ikl) =  Z0mnSV(ikl)                         ! Z0mnSV  instant.
+
+
+  ! +--Roughness Length for Scalars
+  ! +  ----------------------------
+
+      Z0hnSV(ikl) =     Z0mnSV(ikl)/  7.4
+
+      IF (is_ok_z0h_rn) THEN
+
+      rstar       =     Z0mnSV(ikl) * us__SV(ikl) / akmol
+      rstar       = max(epsi,min(rstar,R_1000))
+      alors       =          log(rstar)
+      rstar0      = 1.250e0 * max(zero,sign(unun,0.135e0 - rstar)) &
+            +(1.      - max(zero,sign(unun,0.135e0 - rstar))) &
+            *(0.149e0 * max(zero,sign(unun,2.500e0 - rstar)) &
+            + 0.317e0 &
+            *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
+      rstar1      = 0.      * max(zero,sign(unun,0.135e0 - rstar)) &
+            +(1.      - max(zero,sign(unun,0.135e0 - rstar))) &
+            *(-0.55e0 * max(zero,sign(unun,2.500e0 - rstar)) &
+            - 0.565 &
+            *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
+      rstar2      = 0.      * max(zero,sign(unun,0.135e0 - rstar)) &
+            +(1.      - max(zero,sign(unun,0.135e0 - rstar))) &
+            *(0.      * max(zero,sign(unun,2.500e0 - rstar)) &
+            - 0.183 &
+            *(unun    - max(zero,sign(unun,2.500e0 - rstar))))
+
+
+
+  !XF    #RN (is_ok_z0h_rn) does not work well over bare ice
+  !XF    MAR is then too warm and not enough melt
+
+     if(ro__SV(ikl,isnoSV(ikl))>50 &
+           .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)then
+
+         Z0hnSV(ikl) = max(zero &
+               , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)) &
+               * exp(rstar0+rstar1*alors+rstar2*alors*alors) &
+               * 0.001e0 + Z0hnSV(ikl) * ( 1. - max(zero &
+               , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)))
+
+      endif
+
+
+      ENDIF
+
+      Z0h_SV(ikl) =     Z0hnSV(ikl)
+
+
+  ! #MT     Z0m_SV(ikl) = max(2.0e-6     ,Z0m_SV(ikl)) ! Min Z0_m (Garrat Scheme)
+       ! Z0m_SV(ikl) = min(Z0m_SV(ikl),za__SV(ikl)*0.3333)
+
+
+   END DO
+
+
+   return
+end subroutine inlandsis
+
+
+
+
+
+
+
+
+
+
+
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_bsn.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_bsn.F	(revision 5084)
+++ 	(revision )
@@ -1,108 +1,0 @@
- 
- 
-      subroutine SISVAT_BSn
- 
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_BSn                               04-apr-2020  MAR |
-C |   SubRoutine SISVAT_BSn treats Snow Erosion                            |
-C |   (not deposition anymore since 2-jun 2018)                            |
-C |                                                                        |
-C |   SISVAT_bsn computes the snow erosion mass according to both the      |
-C |   theoretical maximum erosion amount computed in inlandsis and the     |
-C |   availability of snow (currently in the uppermost snow layer only)    |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--General Variables
-C +  =================
-
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VARxSV
-      use VARySV
- 
- 
-       IMPLICIT NONE
-
-C +--Local Variables
-C +  ===============
- 
- 
-      integer  ikl   ,isn
-      real     h_mmWE                        ! Eroded Snow Layer Min Thickness
-      real     dbsaux(knonv)                 ! Drift Amount   (Dummy Variable)
-      real     dzweqo,dzweqn,bsno_x          ! Conversion variables for erosion
-      real     dz_new,rho_new
-      real     snofOK                        ! Threshd Snow Fall
-      real     Fac                           ! Correction factor for erosion
-      real     densif                        ! Densification rate if erosion
- 
-C +--DATA
-C +  ====
- 
-      data     h_mmWE  / 0.01e00  /          ! Eroded Snow Layer Min Thickness
- 
-C +--EROSION
-C +  =======
- 
-      !DO isn = nsno,2,-1
-      DO ikl = 1,knonv
- 
-        isn         = isnoSV(ikl)
-        dzweqo      = dzsnSV(ikl,isn) *ro__SV(ikl,isn)      ! [kg/m2, mm w.e.]
- 
-        bsno_x      = min(0.,dbs_SV(ikl))
-c       Fac         = min(1.,max(1-(ro__SV(ikl,isn)/700.),0.)**2)
-c       Fac         = min(1.,max(1-(qsnoSV(ikl)*1000/30.),0.))
-c       bsno_x      = bsno_x*Fac
- 
-        dzweqn      = dzweqo + bsno_x
-        dzweqn      = max(dzweqn,h_mmWE)
-        dzweqn      = min(dzweqn,dzweqo)
-cXF
-        dbs_SV(ikl) = dbs_SV(ikl)    +(dzweqo -dzweqn)
-        dbs_Er(ikl) = dbs_Er(ikl)    +(dzweqo -dzweqn)
-        dzsnSV(ikl,isn) =              dzweqn
-     .                       /max(epsi,ro__SV(ikl,isn))
- 
-        ! Densification of the uppermost snow layer if erosion:
-        if((dzweqo-dzweqn)>0                    .and.
-     .     dzsnSV(ikl,isn)>0                    .and.
-     .     ro__SV(ikl,max(1,isnoSV(ikl)))<roBdSV) then
- 
-        !characteristic time scale for drifting snow compaction set to 24h
-        !linear densification rate [kg/m3/s] over 24h
-        densif         = (450. - frsno) / (3600*24)
- 
-        !Attenuation of compaction rate from 450 to 500 kg/m3
-        Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl)))
-     .                        -roBdSV)/(500.-roBdSV))
-        Fac         = max(0.,min(1.,Fac))
- 
-        if (ro__SV(ikl,max(1,isnoSV(ikl)))>roBdSV) then
-          densif=densif*Fac
-        endif
- 
-        rho_new        = min(roBdSV,ro__SV(ikl,isn)+densif*dt__SV)
-        dz_new         = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/rho_new
-        ro__SV(ikl,isn)=rho_new
-        dzsnSV(ikl,isn)=dz_new
-        endif
- 
-        if(dzsnSV(ikl,isn)>0 .and.dzsnSV(ikl,isn)<0.0001)then
-        dbs_SV(ikl) = dbs_SV(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
-        dbs_Er(ikl) = dbs_Er(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
-        dzsnSV(ikl,isn) = 0
-        ro__SV(ikl,isn) = 0
-        isnoSV(ikl)     = max(0,isnoSV(ikl) - 1)
-        endif
- 
-      END DO
-      !END DO
- 
-      return
-      END
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_bsn.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_bsn.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_bsn.f90	(revision 5246)
@@ -0,0 +1,108 @@
+
+
+subroutine SISVAT_BSn
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_BSn                               04-apr-2020  MAR |
+  ! |   SubRoutine SISVAT_BSn treats Snow Erosion                            |
+  ! |   (not deposition anymore since 2-jun 2018)                            |
+  ! |                                                                        |
+  ! |   SISVAT_bsn computes the snow erosion mass according to both the      |
+  ! |   theoretical maximum erosion amount computed in inlandsis and the     |
+  ! |   availability of snow (currently in the uppermost snow layer only)    |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--General Variables
+  ! +  =================
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VARxSV
+  use VARySV
+
+
+   IMPLICIT NONE
+
+  ! +--Local Variables
+  ! +  ===============
+
+
+  integer :: ikl   ,isn
+  real :: h_mmWE                        ! Eroded Snow Layer Min Thickness
+  real :: dbsaux(knonv)                 ! Drift Amount   (Dummy Variable)
+  real :: dzweqo,dzweqn,bsno_x          ! Conversion variables for erosion
+  real :: dz_new,rho_new
+  real :: snofOK                        ! Threshd Snow Fall
+  real :: Fac                           ! Correction factor for erosion
+  real :: densif                        ! Densification rate if erosion
+
+  ! +--DATA
+  ! +  ====
+
+  data     h_mmWE  / 0.01e00  /          ! Eroded Snow Layer Min Thickness
+
+  ! +--EROSION
+  ! +  =======
+
+  ! !DO isn = nsno,2,-1
+  DO ikl = 1,knonv
+
+    isn         = isnoSV(ikl)
+    dzweqo      = dzsnSV(ikl,isn) *ro__SV(ikl,isn)      ! [kg/m2, mm w.e.]
+
+    bsno_x      = min(0.,dbs_SV(ikl))
+    ! Fac         = min(1.,max(1-(ro__SV(ikl,isn)/700.),0.)**2)
+    ! Fac         = min(1.,max(1-(qsnoSV(ikl)*1000/30.),0.))
+    ! bsno_x      = bsno_x*Fac
+
+    dzweqn      = dzweqo + bsno_x
+    dzweqn      = max(dzweqn,h_mmWE)
+    dzweqn      = min(dzweqn,dzweqo)
+  !XF
+    dbs_SV(ikl) = dbs_SV(ikl)    +(dzweqo -dzweqn)
+    dbs_Er(ikl) = dbs_Er(ikl)    +(dzweqo -dzweqn)
+    dzsnSV(ikl,isn) =              dzweqn &
+          /max(epsi,ro__SV(ikl,isn))
+
+    ! ! Densification of the uppermost snow layer if erosion:
+    if((dzweqo-dzweqn)>0                    .and. &
+          dzsnSV(ikl,isn)>0                    .and. &
+          ro__SV(ikl,max(1,isnoSV(ikl)))<roBdSV) then
+
+    ! !characteristic time scale for drifting snow compaction set to 24h
+    ! !linear densification rate [kg/m3/s] over 24h
+    densif         = (450. - frsno) / (3600*24)
+
+    ! !Attenuation of compaction rate from 450 to 500 kg/m3
+    Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl))) &
+          -roBdSV)/(500.-roBdSV))
+    Fac         = max(0.,min(1.,Fac))
+
+    if (ro__SV(ikl,max(1,isnoSV(ikl)))>roBdSV) then
+      densif=densif*Fac
+    endif
+
+    rho_new        = min(roBdSV,ro__SV(ikl,isn)+densif*dt__SV)
+    dz_new         = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/rho_new
+    ro__SV(ikl,isn)=rho_new
+    dzsnSV(ikl,isn)=dz_new
+    endif
+
+    if(dzsnSV(ikl,isn)>0 .and.dzsnSV(ikl,isn)<0.0001)then
+    dbs_SV(ikl) = dbs_SV(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
+    dbs_Er(ikl) = dbs_Er(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
+    dzsnSV(ikl,isn) = 0
+    ro__SV(ikl,isn) = 0
+    isnoSV(ikl)     = max(0,isnoSV(ikl) - 1)
+    endif
+
+  END DO
+  ! !END DO
+
+  return
+END SUBROUTINE SISVAT_BSn
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_gsn.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_gsn.F	(revision 5084)
+++ 	(revision )
@@ -1,925 +1,0 @@
-  
-      subroutine SISVAT_GSn
- 
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_GSn                                20-09-2003  MAR |
-C |   SubRoutine SISVAT_GSn simulates SNOW Metamorphism                    |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  knonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-C |                     X       Number of Mosaic Cell per grid box         |
-C |                                                                        |
-C |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
-C |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
-C |   ^^^^^^   istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
-C |                                                                        |
-C |   INPUT:   TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
-C |   ^^^^^             & Snow     Temperatures (layers  1,2,...,nsno) [K] |
-C |            ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
-C |            eta_SV   : Soil/Snow Water   Content                [m3/m3] |
-C |            slopSV   : Surface Slope                                [-] |
-C |            dzsnSV   : Snow Layer        Thickness                  [m] |
-C |            dt__SV2   : Time  Step                                   [s] |
-C |                                                                        |
-C |   INPUT /  G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
-C |   OUTPUT:  G2snSV   : Sphericity (>0) or Size            of Snow Layer |
-C |   ^^^^^^                                                               |
-C |                                                                        |
-C |   Formalisme adopte pour la Representation des Grains:                 |
-C |   Formalism         for the Representation of  Grains:                 |
-C |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                 |
-C |                                                                        |
-C |             1       - -1                 Neige Fraiche                 |
-C |            / \      |                    -------------                 |
-C |           /   \     |  Dendricite        decrite  par Dendricite       |
-C |          /     \    |  Dendricity                  et Sphericite       |
-C |         /       \   |                                                  |
-C |        2---------3  -  0                 described by Dendricity       |
-C |                                                   and Sphericity       |
-C |        |---------|                                                     |
-C |        0         1                                                     |
-C |        Sphericite                                                      |
-C |        Sphericity                                                      |
-C |                                                                        |
-C |        4---------5  -                                                  |
-C |        |         |  |                                                  |
-C |        |         |  |  Diametre (1/10eme de mm) (ou Taille)            |
-C |        |         |  |  Diameter (1/10th  of mm) (or Size  )            |
-C |        |         |  |                                                  |
-C |        |         |  |                    Neige non dendritique         |
-C |        6---------7  -                    ---------------------         |
-C |                                          decrite  par Sphericite       |
-C |                                                    et     Taille       |
-C |                                          described by Sphericity       |
-C |                                                   and       Size       |
-C |                                                                        |
-C |   Les Variables du Modele:                                             |
-C |   Model         Variables:                                             |
-C |   ^^^^^^^^^^^^^^^^^^^^^^^^                                             |
-C |     Cas Dendritique               Cas non Dendritique                  |
-C |                                                                        |
-C |     G1snSV        : Dendricite    G1snSV        : Sphericite           |
-C |     G2snSV        : Sphericite    G2snSV        : Taille (1/10e mm)    |
-C |                                                   Size                 |
-C |                                                                        |
-C |   Cas Dendritique/ Dendritic Case                                      |
-C |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                                      |
-C |   Dendricite(Dendricity) G1snSV                                        |
-C |            varie     de -G1_dSV (-99 par defaut / etoile)          a 0 |
-C |            division par -G1_dSV pour obtenir des valeurs entre 1  et 0 |
-C |            varies  from -G1_dSV (default -99    / fresh snow)     to 0 |
-C |            division  by -G1_dSV to obtain values       between 1 and 0 |
-C |                                                                        |
-C |   Sphericite(Sphericity) G2snSV                                        |
-C |            varie     de  0         (cas completement anguleux)         |
-C |                       a  G1_dSV (99 par defaut, cas spherique)         |
-C |            division par  G1_dSV pour obtenir des valeurs entre 0  et 1 |
-C |            varies  from  0      (full faceted)               to G1_dSV |
-C |                                                                        |
-C |   Cas non Dendritique / non Dendritic Case                             |
-C |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                             |
-C |   Sphericite(Sphericity) G1snSV                                        |
-C |            varie     de  0         (cas completement anguleux)         |
-C |                       a  G1_dSV (99 par defaut, cas spherique)         |
-C |            division par  G1_dSV pour obtenir des valeurs entre 0  et 1 |
-C |            varies  from  0      (full faceted)               to G1_dSV |
-C |                                                                        |
-C |   Taille    (Size)       G2snSV                                        |
-C |            superieure a  ADSdSV (.4 mm) et ne fait que croitre         |
-C |            greater than  ADSdSV (.4 mm) always increases               |
-C |                                                                        |
-C |   Exemples: Points caracteristiques des Figures ci-dessus              |
-C |   ^^^^^^^^^                                                            |
-C |                                                                        |
-C |               G1snSV    G2snSV     dendricite  sphericite  taille      |
-C |                                    dendricity  sphericity  size        |
-C |   ------------------------------------------------------------------   |
-C |                                                            [1/10 mm]   |
-C |     1        -G1_dSV    sph3SN          1           0.5                |
-C |     2           0         0             0           0                  |
-C |     3           0       G1_dSV          0           1                  |
-C |     4           0       ADSdSV                      0       4.         |
-C |     5         G1_dSV    ADSdSV-vsphe1               1       3.         |
-C |     6           0         --                        0       --         |
-C |     7         G1_dSV      --                        1       --         |
-C |                                                                        |
-C |   par defaut: G1_dSV=99.                                               |
-C |                         sph3SN=50.                                     |
-C |                         ADSdSV= 4.                                     |
-C |                                vsphe1=1.                               |
-C |                                                                        |
-C |   Methode:                                                             |
-C |   ^^^^^^^^                                                             |
-C |   1. Evolution Types de Grains selon Lois de Brun et al. (1992):       |
-C |      Grain metamorphism according to         Brun et al. (1992):       |
-C |      Plusieurs Cas sont a distiguer  /  the different Cases are:       |
-C |       1.1 Metamorphose Neige humide  /  wet Snow                       |
-C |       1.2 Metamorphose Neige seche   /  dry Snow                       |
-C |         1.2.1 Gradient faible        /  low      Temperature Gradient  |
-C |         1.2.2 Gradient moyen         /  moderate Temperature Gradient  |
-C |         1.2.3 Gradient fort          /  high     Temperature Gradient  |
-C |      Dans chaque Cas on separe Neige Dendritique et non Dendritique    |
-C |                           le Passage Dendritique -> non Dendritique    |
-C |                           se fait lorsque  G1snSV devient > 0          |
-C |      the Case of Dentritic or non Dendritic Snow is treated separately |
-C |      the Limit   Dentritic -> non Dendritic is reached when G1snSV > 0 |
-C |                                                                        |
-C |   2. Tassement: Loi de Viscosite adaptee selon le Type de Grains       |
-C |      Snow Settling:    Viscosity depends on the   Grain Type           |
-C |                                                                        |
-C |   3. Update Variables historiques (cas non dendritique seulement)      |
-C |      nhSNow defaut                                                     |
-C |                0    Cas normal                                         |
-C |      istdSV(1) 1    Grains anguleux / faceted cristal                  |
-C |      istdSV(2) 2    Grains ayant ete en presence d eau liquide         |
-C |                     mais n'ayant pas eu de caractere anguleux    /     |
-C |                     liquid water and no faceted cristals before        |
-C |      istdSV(3) 3    Grains ayant ete en presence d eau liquide         |
-C |                     ayant eu auparavant un caractere anguleux    /     |
-C |                     liquid water and    faceted cristals before        |
-C |                                                                        |
-C |   REFER. : Brun et al.      1989, J. Glaciol 35 pp. 333--342           |
-C |   ^^^^^^^^ Brun et al.      1992, J. Glaciol 38 pp.  13-- 22           |
-C |            (CROCUS Model, adapted to MAR at CEN by H.Gallee)           |
-C |                                                                        |
-C |   REFER. : Marbouty, D.     1980, J. Glaciol 26 pp. xxx--xxx           |
-C |   ^^^^^^^^ (CROCUS Model, adapted to MAR at CEN by H.Gallee)           |
-C |            (for angular shapes)                                        |
-C |                                                                        |
-C |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
-C |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
-C |   FILE                 |      CONTENT                                  |
-C |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
-C | # SISVAT_GSn.vp        | #vp: OUTPUT/Verification: Snow   Properties   |
-C |                        |      unit 47, SubRoutines SISVAT_zSn, _GSn    |
-C | # stdout               | #wp: OUTPUT/Verification: Snow   Properties   |
-C |                        |      unit  6, SubRoutine  SISVAT_GSn          |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
-
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VAR0SV
-      use VARxSV
-      use VARtSV
-
-  
-      IMPLICIT NONE
-  
-     
- 
-C +--INPUT/OUTPUT
-C +  ------------
- 
- 
-C +--OUTPUT
-C +  ------
- 
-      integer   dt__SV2
- 
- 
-C +--Local  Variables
-C +  ================
- 
-      logical   vector                        !
-      integer   ikl                           !
-      integer   isn   ,isnp                   !
-      integer   istoOK                        !
-      real      G1_bak,G2_bak                 ! Old Values of G1, G2
-      real      ro_dry(knonv,      nsno)      ! Dry Density            [g/cm3]
-      real      etaSno(knonv,      nsno)      ! Liquid Water Content   [g/cm2]
-      real      SnMass(knonv)                 ! Snow   Mass            [kg/m2]
-      real      dTsndz                        ! Temperature Gradient
-      real      sWater                        !        Water Content       [%]
-      real      exp1Wa                        !
-      real      dDENDR                        ! Dendricity Increment
-      real      DENDRn                        ! Normalized Dendricity
-      real      SPHERn                        ! Normalized Sphericity
-      real      Wet_OK                        ! Wet Metamorphism Switch
-      real      OK__DE                        !
-      real      OK__wd                        ! New G*, from wet Dendritic
-      real      G1__wd                        ! New G1, from wet Dendritic
-      real      G2__wd                        ! New G2, from wet Dendritic
-      real      OKlowT                        !
-      real      facVap                        !
-      real      OK_ldd                        !
-      real      G1_ldd                        !
-      real      G2_ldd                        !
-      real      DiamGx                        !
-      real      DiamOK                        !
-      real      No_Big                        !
-      real      dSPHER                        !
-      real      SPHER0                        !
-      real      SPHbig                        !
-      real      G1_lds                        !
-      real      OK_mdT                        !
-      real      OKmidT                        !
-      real      OKhigT                        !
-      real      OK_mdd                        !
-      real      G1_mdd                        !
-      real      G2_mdd                        !
-      real      G1_mds                        !
-      real      OK_hdd                        !
-      real      G1_hdd                        !
-      real      G2_hdd                        !
-      real      OK_hds                        !
-      real      G1_hds                        !
-      real      T1__OK,T2__OK                 !
-      real      T3_xOK,T3__OK,T3_nOK          !
-      real      ro1_OK,ro2_OK                 !
-      real      dT1_OK,dT2_OK,dT3xOK,dT3_OK   !
-      real      dT4xOK,dT4_OK,dT4nOK,AngSno   !
-      real      G2_hds,SphrOK,HISupd          !
-      real      H1a_OK,H1b_OK,H1__OK          !
-      real      H23aOK,H23bOK,H23_OK          !
-      real      H2__OK,H3__OK                 !
-      real      H45_OK,H4__OK,H5__OK          !
-      real      ViscSn,OK_Liq,OK_Ang,OKxLiq   !
-      real      dSnMas,dzsnew,rosnew,rosmax,smb_old,smb_new
-      real      zn_old,zn_new
- 
-      real      epsi5                         ! Alpha ev67 single precision	
-      real      vdiam1                        ! Small Grains Min.Diam.[.0001m]
-      real      vdiam2                        ! Spher.Variat.Max Diam.    [mm]
-      real      vdiam3                        ! Min.Diam.|Limit Spher.    [mm]
-      real      vdiam4                        ! Min.Diam.|Viscosity Change
-      real      vsphe1                        ! Max Sphericity
-      real      vsphe2                        ! Low T Metamorphism  Coeff.
-      real      vsphe3                        ! Max.Sphericity (history=1)
-      real      vsphe4                        ! Min.Sphericity=>history=1
-      real      vtang1,vtang2,vtang3,vtang4   ! Temperature Contribution
-      real      vtang5,vtang6,vtang7,vtang8   !
-      real      vtang9,vtanga,vtangb,vtangc   !
-      real      vrang1,vrang2                 ! Density     Contribution
-      real      vgang1,vgang2,vgang3,vgang4   ! Grad(T)     Contribution
-      real      vgang5,vgang6,vgang7,vgang8   !
-      real      vgang9,vganga,vgangb,vgangc   !
-      real      vgran6                        ! Max.Sphericity for Settling
-      real      vtelv1                        ! Threshold | history = 2, 3
-      real       vvap1                        ! Vapor Pressure Coefficient
-      real       vvap2                        ! Vapor Pressure Exponent
-      real      vgrat1                        ! Boundary weak/mid   grad(T)
-      real      vgrat2                        ! Boundary mid/strong grad(T)
-      real         vfi                        ! PHI,         strong grad(T)
-      real      vvisc1,vvisc2,vvisc3,vvisc4   ! Viscosity Coefficients
-      real      vvisc5,vvisc6,vvisc7          ! id., wet Snow
-      real      rovisc                        ! Wet Snow Density  Influence
-      real        vdz3                        ! Maximum Layer Densification
-      real      OK__ws                        ! New G2
-      real      G1__ws                        ! New G1, from wet Spheric
-      real      G2__ws                        ! New G2, from wet Spheric
-      real      husi_0,husi_1,husi_2,husi_3   ! Constants for New G2
-      real      vtail1,vtail2                 ! Constants for New G2
-      real      frac_j                        ! Time Step            [Day]
- 
-      real       vdent1                       ! Wet Snow Metamorphism
-      integer   nvdent1                       ! (Coefficients for
-      integer   nvdent2                       !           Dendricity)
- 
-C +--Snow Properties: IO
-C +  ~~~~~~~~~~~~~~~~~~~
-! #vp real      G_curr(18),Gcases(18)
-! #vp common   /GSnLOC/    Gcases
-! #wp real                 D__MAX
-! #wp common   /GSnMAX/    D__MAX
- 
- 
-C +--DATA
-C +  ====
- 
-      data       vector/.true./               ! Vectorization  Switch
-      data       vdent1/ 0.5e8/               ! Wet Snow Metamorphism
-cXF                      tuned for Greenland (2.e8=old value)
-      data      nvdent1/ 3   /                ! (Coefficients for
-      data      nvdent2/16   /                !           Dendricity)
- 
-      data       husi_0 /20.      /           !   10  * 2
-      data       husi_1 / 0.23873 /           ! (3/4) /pi
-      data       husi_2 / 4.18880 /           ! (4/3) *pi
-      data       husi_3 / 0.33333 /           !  1/3
-      data       vtail1 / 1.28e-08/           !  Wet Metamorphism
-      data       vtail2 / 4.22e-10/           ! (NON Dendritic / Spheric)
- 
-      data       epsi5  / 1.0e-5  /           !
- 
-      data       vdiam1 / 4.0     /           ! Small Grains Min.Diameter
- 
-      data       vdiam2 / 0.5     /           ! Spher.Variat.Max Diam.[mm]
-      data       vdiam3 / 3.0     /           ! Min.Diam.|Limit Spher.[mm]
-      data       vdiam4 / 2.0     /           ! Min.Diam.|Viscosity Change
- 
-      data       vsphe1 / 1.0     /           ! Max Sphericity
-      data       vsphe2 / 1.0e9   /           ! Low T Metamorphism  Coeff.
-      data       vsphe3 / 0.5     /           ! Max.Sphericity (history=1)
-      data       vsphe4 / 0.1     /           ! Min.Sphericity=>history=1
- 
-      data       vgran6 / 51.     /           ! Max.Sphericity for Settling
-      data       vtelv1 / 5.e-1   /           ! Threshold | history = 2, 3
- 
-      data        vvap1 /-6.e3    /           ! Vapor Pressure Coefficient
-      data        vvap2 / 0.4     /           ! Vapor Pressure Exponent
- 
-      data       vgrat1 /0.05     /           ! Boundary weak/mid   grad(T)
-      data       vgrat2 /0.15     /           ! Boundary mid/strong grad(T)
-      data          vfi /0.09     /           ! PHI,         strong grad(T)
- 
-      data       vvisc1 / 0.70    /           ! Viscosity Coefficients
-      data       vvisc2 / 1.11e5  /           !
-      data       vvisc3 /23.00    /           !
-      data       vvisc4 / 0.10    /           !
-      data       vvisc5 / 1.00    /           ! id., wet Snow
-      data       vvisc6 / 2.00    /           !
-      data       vvisc7 /10.00    /           !
-      data       rovisc / 0.25    /           ! Wet Snow Density  Influence
-      data         vdz3 / 0.30    /           ! Maximum Layer Densification
- 
- 
-C +--DATA (Coefficient Fonction fort Gradient Marbouty)
-C +  --------------------------------------------------
- 
-      data       vtang1 /40.0/                ! Temperature Contribution
-      data       vtang2 / 6.0/                !
-      data       vtang3 /22.0/                !
-      data       vtang4 / 0.7/                !
-      data       vtang5 / 0.3/                !
-      data       vtang6 / 6.0/                !
-      data       vtang7 / 1.0/                !
-      data       vtang8 / 0.8/                !
-      data       vtang9 /16.0/                !
-      data       vtanga / 0.2/                !
-      data       vtangb / 0.2/                !
-      data       vtangc /18.0/                !
- 
-      data       vrang1 / 0.40/               ! Density     Contribution
-      data       vrang2 / 0.15/               !
- 
-      data       vgang1 / 0.70/               ! Grad(T)     Contribution
-      data       vgang2 / 0.25/               !
-      data       vgang3 / 0.40/               !
-      data       vgang4 / 0.50/               !
-      data       vgang5 / 0.10/               !
-      data       vgang6 / 0.15/               !
-      data       vgang7 / 0.10/               !
-      data       vgang8 / 0.55/               !
-      data       vgang9 / 0.65/               !
-      data       vganga / 0.20/               !
-      data       vgangb / 0.85/               !
-      data       vgangc / 0.15/               !
- 
-! #wp data       D__MAX / 4.00/               !
- 
- 
-C +-- 1. Metamorphoses dans les Strates
-C +      Metamorphism
-C +      ==============================
- 
-      dt__SV2= dt__SV
-      frac_j = dt__SV2 / 86400.                        ! Time Step [Day]
- 
-      zn4_SV = 0
- 
- 
-C +-- 1.1 Initialisation: teneur en eau liquide et gradient de temperature
-C +   ------------------  liquid water content and temperature gradient
- 
-       DO ikl=1,knonv
-        DO   isn=1,isnoSV(ikl)
- 
-          ro_dry(ikl,isn) = 1.e-3 *ro__SV(ikl,isn)    ! Dry Density
-     .                    *(1.    -eta_SV(ikl,isn))   !         [g/cm3]
-          etaSno(ikl,isn) = 1.e-1 *dzsnSV(ikl,isn)    ! Liquid Water
-     .                    *        ro__SV(ikl,isn)    ! Content [g/cm2]
-     .                    *        eta_SV(ikl,isn)    !
-        END DO
-      END DO
- 
-c!$OMP PARALLEL DO default(firstprivate)
-c!$OMP.shared (/xSISVAT_I/,/xSISVAT_R/,/SoR0SV/,/SoI0SV/,/Sn_dSV/)
-       DO ikl=1,knonv
-        DO   isn=1,isnoSV(ikl)
-          isnp   = min(isn+1,isnoSV(ikl))
- 
-          dTsndz = abs( (TsisSV(ikl,isnp)-TsisSV(ikl,isn-1)) *2.e-2
-     .            /max(((dzsnSV(ikl,isnp)+dzsnSV(ikl,isn)  )
-     .                 *(           isnp -           isn)
-     .                 +(dzsnSV(ikl,isn )+dzsnSV(ikl,isn-1))),epsi))
-C +...    Factor 1.d-2 for Conversion K/m --> K/cm
- 
- 
-C +-- 1.2 Metamorphose humide
-C +       Wet Snow Metamorphism
-C +       ---------------------
- 
-          Wet_OK = max(zero,sign(unun,eta_SV(ikl,isn)-epsi))
- 
- 
-C +--     Vitesse de diminution de la dendricite
-C +       Rate of the dendricity decrease
-C +       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          sWater=1.d-1*ro__SV(ikl,isn)*eta_SV(ikl,isn)
-     .       /max(epsi,ro_dry(ikl,isn))
-C +...    sWater:Water Content [%]
-C +              1.d-1= 1.d2(1->%) * 1.d-3(ro__SV*eta_SV:kg/m3->g/cm3)
- 
-          exp1Wa=   sWater**nvdent1
-          dDENDR=max(exp1Wa/nvdent2,vdent1*exp(vvap1/TfSnow))
- 
-C +-- 1.2.1 Cas dendritique/dendritic Case
-C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          OK__wd=max(zero,                            !
-     .               sign(unun,-G1snSV(ikl,isn)       !
-     .                         -epsi           ))     !
- 
-          DENDRn=-G1snSV(ikl,isn)/G1_dSV  ! Normalized Dendricity (+)
-          SPHERn= G2snSV(ikl,isn)/G1_dSV  ! Normalized Sphericity
-          DENDRn= DENDRn -dDENDR *frac_j  ! New        Dendricity (+)
-          SPHERn= SPHERn +dDENDR *frac_j  ! New        Sphericity
- 
-          OK__DE=max(zero,                            ! IF 1.,
-     .               sign(unun, DENDRn                ! NO change
-     .                         -epsi           ))     ! Dendr. -> Spheric
- 
-          G1__wd=OK__DE *    (      -DENDRn*G1_dSV)   ! Dendritic
-     .      +(1.-OK__DE)* min(G1_dSV,SPHERn*G1_dSV)   ! Dendr. -> Spheric
-          G2__wd=OK__DE * min(G1_dSV,SPHERn*G1_dSV)   ! Spheric
-     .      +(1.-OK__DE)*(ADSdSV-min(SPHERn,vsphe1))  ! Spher. -> Size
- 
-C +-- 1.2.2 Cas non dendritique non completement spherique
-C +         Evolution de la Sphericite seulement.
-C +         Non dendritic and not completely spheric Case
-C +         Evolution of    Sphericity only (not size)
-C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          OK__ws=max(zero,                            !
-     .               sign(unun, G1_dSV                !
-     .                         -epsi5                 !
-     .                         -G1snSV(ikl,isn)))     !
- 
-          SPHERn= G1snSV(ikl,isn)/G1_dSV
-          SPHERn= SPHERn +dDENDR *frac_j
-          G1__ws=         min(G1_dSV,SPHERn*G1_dSV)
- 
-C +-- 1.2.3 Cas non dendritique et spherique / non dendritic and spheric
-C +         Evolution de la Taille seulement / Evolution of Size only
-C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          G2__ws =  husi_0
-     .           *( husi_1
-     .            *(husi_2 *( G2snSV(ikl,isn)/husi_0)**3
-     .                      +(vtail1 +vtail2 *exp1Wa    )*dt__SV2))
-     .           ** husi_3
- 
- 
-C +-- 1.3 Metamorposes seches / Dry Metamorphism
-C +       --------------------------------------
- 
- 
-C +-- 1.3.1 Calcul Metamorphose faible/low Gradient (0.00-0.05 deg/cm)
-C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          OKlowT=max(zero,                            !
-     .               sign(unun, vgrat1                !
-     .                         -dTsndz         ))     !
- 
-          facVap=exp(vvap1/TsisSV(ikl,isn))
- 
-C +-- 1.3.1.1 Cas dendritique / dendritic Case
- 
-          OK_ldd=max(zero,                            !
-     .               sign(unun,-G1snSV(ikl,isn)       !
-     .                         -epsi           ))     !
- 
-          DENDRn=-G1snSV(ikl,isn)     /G1_dSV
-          SPHERn= G2snSV(ikl,isn)     /G1_dSV
-          DENDRn= DENDRn-vdent1*facVap*frac_j
-          SPHERn= SPHERn+vsphe2*facVap*frac_j
- 
-          OK__DE=max(zero,                            ! IF 1.,
-     .               sign(unun, DENDRn                ! NO change
-     .                         -epsi           ))     ! Dendr. -> Spheric
- 
-          G1_ldd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
-     .       +(1.-OK__DE)* min(G1_dSV,SPHERn*G1_dSV)  ! Dendr. -> Spheric
-          G2_ldd= OK__DE * min(G1_dSV,SPHERn*G1_dSV)  ! Spheric
-     .       +(1.-OK__DE)*(ADSdSV-min(SPHERn,vsphe1)) ! Spher. -> Size
- 
-C +-- 1.3.1.2 Cas non dendritique / non dendritic Case
- 
-          SPHERn=G1snSV(ikl,isn)/G1_dSV
-          DiamGx=G2snSV(ikl,isn)*0.1
- 
-          istoOK=min( abs(istoSV(ikl,isn)-
-     .                    istdSV(1)      ),1)         ! zero if istoSV = 1
-          DiamOK=max(zero,  sign(unun,vdiam2-DiamGx))
-          No_Big=    istoOK+DiamOK
-          No_Big=min(No_Big,unun)
- 
-          dSPHER=           vsphe2*facVap*frac_j      !
-          SPHER0=    SPHERn+dSPHER                    ! small grains
-          SPHbig=    SPHERn+dSPHER                    ! big   grains
-     .        *exp(min(zero,vdiam3-G2snSV(ikl,isn)))  ! (history = 2 or 3)
-          SPHbig=       min(vsphe3,SPHbig)            ! limited sphericity
-          SPHERn= No_Big *  SPHER0
-     .      + (1.-No_Big)*  SPHbig
- 
-          G1_lds=       min(G1_dSV,SPHERn*G1_dSV)
- 
-C +-- 1.3.2 Calcul Metamorphose Gradient Moyen/Moderate (0.05-0.15)
-C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          OK_mdT=max(zero,                            !
-     .               sign(unun, vgrat2                !
-     .                         -dTsndz))              !
-          OKmidT=               OK_mdT  *(1.-OKlowT)  !
-          OKhigT=          (1. -OK_mdT) *(1.-OKlowT)  !
- 
-          facVap=vdent1*exp(vvap1/TsisSV(ikl,isn))
-     .                 *   (1.e2 *dTsndz)**vvap2
- 
-C +-- 1.3.2.1 cas dendritique / dendritic case.
- 
-          OK_mdd=max(zero,                            !
-     .               sign(unun,-G1snSV(ikl,isn)       !
-     .                         -epsi           ))     !
- 
-          DENDRn=-G1snSV(ikl,isn)/G1_dSV
-          SPHERn= G2snSV(ikl,isn)/G1_dSV
-          DENDRn= DENDRn - facVap*frac_j
-          SPHERn= SPHERn - facVap*frac_j
- 
-          OK__DE=max(zero,                            ! IF 1.,
-     .               sign(unun, DENDRn                ! NO change
-     .                         -epsi           ))     ! Dendr. -> Spheric
- 
-          G1_mdd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
-     .       +(1.-OK__DE)* max(zero  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
-          G2_mdd= OK__DE * max(zero  ,SPHERn*G1_dSV)  ! Spheric
-     .       +(1.-OK__DE)*(ADSdSV-max(SPHERn,zero  )) ! Spher. -> Size
- 
-C +-- 1.3.2.2 Cas non dendritique / non dendritic Case
- 
-          SPHERn=G1snSV(ikl,isn)/G1_dSV
-          SPHERn=         SPHERn-facVap*frac_j
-          G1_mds=max(zero,SPHERn*G1_dSV)
- 
-C +-- 1.3.3 Calcul Metamorphose fort / high Gradient
-C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          facVap=vdent1*exp(vvap1/TsisSV(ikl,isn))
-     .                 *   (1.e2 *dTsndz)**vvap2
- 
-C +-- 1.3.3.1 Cas dendritique / dendritic Case
- 
-          OK_hdd=max(zero,                            !
-     .               sign(unun,-G1snSV(ikl,isn)       !
-     .                         -epsi           ))     !
- 
-          DENDRn=-G1snSV(ikl,isn)/G1_dSV              !
-          SPHERn= G2snSV(ikl,isn)/G1_dSV              !
-          DENDRn= DENDRn - facVap*frac_j              !
-          SPHERn= SPHERn - facVap*frac_j              ! Non dendritic
-C +                                                   ! and angular
-          OK__DE=max(zero,                            ! IF 1.,
-     .               sign(unun, DENDRn                ! NO change
-     .                         -epsi  ))              ! Dendr. -> Spheric
- 
-          G1_hdd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
-     .       +(1.-OK__DE)* max(zero  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
-          G2_hdd= OK__DE * max(zero  ,SPHERn*G1_dSV)  ! Spheric
-     .       +(1.-OK__DE)*(ADSdSV-max(SPHERn,zero  )) ! Spher. -> Size
- 
-C +-- 1.3.3.2 Cas non dendritique non completement anguleux.
-C +           non dendritic and spericity gt. 0
- 
-          OK_hds=max(zero,                            !
-     .               sign(unun, G1snSV(ikl,isn)       !
-     .                         -epsi           ))     !
- 
-          SPHERn= G1snSV(ikl,isn)/G1_dSV
-          SPHERn= SPHERn - facVap*frac_j
-          G1_hds= max(zero,SPHERn*G1_dSV)
- 
-C +-- 1.3.3.3 Cas non dendritique et anguleux
-C +           dendritic and spericity = 0.
- 
-          T1__OK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang1))
-          T2__OK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang2))
-          T3_xOK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang3))
-          T3__OK =                    T3_xOK  * (1. - T2__OK)
-          T3_nOK =              (1. - T3_xOK) * (1. - T2__OK)
-          ro1_OK = max(zero,sign(unun,vrang1-ro_dry(ikl,isn)))
-          ro2_OK = max(zero,sign(unun,ro_dry(ikl,isn)-vrang2))
-          dT1_OK = max(zero,sign(unun,vgang1-dTsndz         ))
-          dT2_OK = max(zero,sign(unun,vgang2-dTsndz         ))
-          dT3xOK = max(zero,sign(unun,vgang3-dTsndz         ))
-          dT3_OK =                    dT3xOK  * (1. - dT2_OK)
-          dT4xOK = max(zero,sign(unun,vgang4-dTsndz         ))
-          dT4_OK =                    dT4xOK  * (1. - dT3_OK)
-     .                                        * (1. - dT2_OK)
-          dT4nOK =              (1. - dT4xOK) * (1. - dT3_OK)
-     .                                        * (1. - dT2_OK)
- 
-C +-- Influence de la Temperature /Temperature Influence
-C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          AngSno =
-     .      T1__OK                                                       ! 11
-     .    *(T2__OK*(vtang4+vtang5*(TfSnow       -TsisSV(ikl,isn))        ! 12
-     .                    /vtang6)                                       !
-     .     +T3__OK*(vtang7-vtang8*(TfSnow-vtang2-TsisSV(ikl,isn))        ! 13
-     .                    /vtang9)                                       !
-     .     +T3_nOK*(vtanga-vtangb*(TfSnow-vtang3-TsisSV(ikl,isn))        ! 14
-     .                    /vtangc))                                      !
- 
-C +-- Influence de la Masse Volumique /Density Influence
-C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-     .    * ro1_OK
-     .        *(   ro2_OK*(1. - (ro_dry(ikl,isn)-vrang2)                 !
-     .                                  /(vrang1-vrang2))                !
-     .         +1.-ro2_OK                                )               !
- 
-C +-- Influence du Gradient de Temperature /Temperature Gradient Influence
-C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-     .        *(   dT1_OK*(dT2_OK*vgang5*(dTsndz-vgang6)                 ! 15
-     .                                  /(vgang2-vgang6)                 !
-     .                    +dT3_OK*vgang7                                 ! 16
-     .                    +dT4_OK*vgang9                                 ! 17
-     .                    +dT4nOK*vgangb                )                ! 18
-     .         +1.-dT1_OK                                )               !
-     .    + ro1_OK
-     .        *    dT1_OK*(dT3_OK*vgang8*(dTsndz-vgang2)
-     .                                  /(vgang3-vgang2)
-     .                    +dT4_OK*vganga*(dTsndz-vgang3)
-     .                                  /(vgang4-vgang3)
-     .                    +dT4nOK*vgangc*(dTsndz-vgang4)
-     .                                  /(vgang1-vgang4))
- 
-          G2_hds = G2snSV(ikl,isn) + 1.d2 *AngSno*vfi     *frac_j
- 
- 
-C +--New Properties
-C +  --------------
- 
-          G1_bak          = G1snSV(ikl,isn)
-          G2_bak          = G2snSV(ikl,isn)
- 
-          G1snSV(ikl,isn) = Wet_OK * (    OK__wd             *G1__wd    !  1
-     .                               +(1.-OK__wd)*    OK__ws *G1__ws    !  2
-     .                               +(1.-OK__wd)*(1.-OK__ws)*G1_bak)   !  3
-     .               +(1. - Wet_OK)                                     !
-     .                *(    OKlowT  *(    OK_ldd             *G1_ldd    !  4
-     .                               +(1.-OK_ldd)            *G1_lds)   !  5
-     .                    + OKmidT  *(    OK_mdd             *G1_mdd    !  6
-     .                               +(1.-OK_mdd)            *G1_mds)   !  7
-     .                    + OKhigT  *(    OK_hdd             *G1_hdd    !  8
-     .                               +(1.-OK_hdd)*    OK_hds *G1_hds    !  9
-     .                               +(1.-OK_hdd)*(1.-OK_hds)*G1_bak))  ! 10
- 
-cXF
-      if(G1snSV(ikl,isn)<0.1)
-     .    G2_hds = G2snSV(ikl,isn) + 1.d1 *AngSno*vfi     *frac_j
-cXF
- 
- 
-          G2snSV(ikl,isn) = Wet_OK * (    OK__wd             *G2__wd    !  1
-     .                               +(1.-OK__wd)*    OK__ws *G2_bak    !  2
-     .                               +(1.-OK__wd)*(1.-OK__ws)*G2__ws)   !  3
-     .               +(1. - Wet_OK)                                     !
-     .                *(    OKlowT  *(    OK_ldd             *G2_ldd    !  4
-     .                               +(1.-OK_ldd)            *G2_bak)   !  5
-     .                    + OKmidT  *(    OK_mdd             *G2_mdd    !  6
-     .                               +(1.-OK_mdd)            *G2_bak)   !  7
-     .                    + OKhigT  *(    OK_hdd             *G2_hdd    !  8
-     .                               +(1.-OK_hdd)*    OK_hds *G2_bak    !  9
-     .                               +(1.-OK_hdd)*(1.-OK_hds)*G2_hds))  ! 10
- 
-C +--Snow Properties: IO Set Up
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~
-! #vp     G_curr( 1) =     Wet_OK             *    OK__wd
-! #vp     G_curr( 2) =     Wet_OK             *(1.-OK__wd)*    OK__ws
-! #vp     G_curr( 3) =     Wet_OK             *(1.-OK__wd)*(1.-OK__ws)
-! #vp     G_curr( 4) = (1.-Wet_OK)*    OKlowT *    OK_ldd
-! #vp     G_curr( 5) = (1.-Wet_OK)*    OKlowT *(1.-OK_ldd)
-! #vp     G_curr( 6) = (1.-Wet_OK)*    OKmidT *    OK_mdd
-! #vp     G_curr( 7) = (1.-Wet_OK)*    OKmidT *(1.-OK_mdd)
-! #vp     G_curr( 8) = (1.-Wet_OK)*    OKhigT *    OK_hdd
-! #vp     G_curr( 9) = (1.-Wet_OK)*    OKhigT *(1.-OK_hdd)*    OK_hds
-! #vp     G_curr(10) = (1.-Wet_OK)*    OKhigT *(1.-OK_hdd)*(1.-OK_hds)
-! #vp     G_curr(11) =     T1__OK                         * G_curr(10)
-! #vp     G_curr(12) =     T2__OK                         * G_curr(10)
-! #vp     G_curr(13) =     T3__OK                         * G_curr(10)
-! #vp     G_curr(14) =     T3_nOK                         * G_curr(10)
-! #vp     G_curr(15) =     ro1_OK*     dT1_OK *    dT2_OK * G_curr(10)
-! #vp     G_curr(16) =     ro1_OK*     dT1_OK *    dT3_OK * G_curr(10)
-! #vp     G_curr(17) =     ro1_OK*     dT1_OK *    dT4_OK * G_curr(10)
-! #vp     G_curr(18) =     ro1_OK*     dT1_OK *    dT4nOK * G_curr(10)
- 
-! #vp     Gcases( 1) = max(Gcases( 1),G_curr( 1))
-! #vp     Gcases( 2) = max(Gcases( 2),G_curr( 2))
-! #vp     Gcases( 3) = max(Gcases( 3),G_curr( 3))
-! #vp     Gcases( 4) = max(Gcases( 4),G_curr( 4))
-! #vp     Gcases( 5) = max(Gcases( 5),G_curr( 5))
-! #vp     Gcases( 6) = max(Gcases( 6),G_curr( 6))
-! #vp     Gcases( 7) = max(Gcases( 7),G_curr( 7))
-! #vp     Gcases( 8) = max(Gcases( 8),G_curr( 8))
-! #vp     Gcases( 9) = max(Gcases( 9),G_curr( 9))
-! #vp     Gcases(10) = max(Gcases(10),G_curr(10))
-! #vp     Gcases(11) = max(Gcases(11),G_curr(11))
-! #vp     Gcases(12) = max(Gcases(12),G_curr(12))
-! #vp     Gcases(13) = max(Gcases(13),G_curr(13))
-! #vp     Gcases(14) = max(Gcases(14),G_curr(14))
-! #vp     Gcases(15) = max(Gcases(15),G_curr(15))
-! #vp     Gcases(16) = max(Gcases(16),G_curr(16))
-! #vp     Gcases(17) = max(Gcases(17),G_curr(17))
-! #vp     Gcases(18) = max(Gcases(18),G_curr(18))
- 
-C +--Snow Properties: IO
-C +  ~~~~~~~~~~~~~~~~~~~
-! #vp     IF          (isn    .le.     isnoSV(ikl))
-! #vp.    write(47,471)isn            ,isnoSV(ikl)                    ,
-! #vp.                 TsisSV(ikl,isn),ro__SV(ikl,isn),eta_SV(ikl,isn),
-! #vp.                 G1_bak         ,G2_bak         ,istoSV(ikl,isn),
-! #vp.                 dTsndz,
-! #vp.                (       k ,k=1,18),
-! #vp.                (G_curr(k),k=1,18),
-! #vp.                (Gcases(k),k=1,18),
-! #vp.                 Wet_OK,OK__wd,G1__wd,G2__wd,
-! #vp.                     1.-OK__wd,OK__ws,G1__ws,1.-OK__ws,G2__ws,
-! #vp.              1.-Wet_OK,OKlowT,OK_ldd,G1_ldd,          G2_ldd,
-! #vp.                            1.-OK_ldd,G1_lds,
-! #vp.                        OKmidT,OK_mdd,G1_mdd,          G1_mdd,
-! #vp.                            1.-OK_mdd,G1_mds,
-! #vp.                        OKhigT,OK_hdd,G1_hdd,          G2_hdd,
-! #vp.                            1.-OK_hdd,OK_hds,          G1_hds,
-! #vp.                                             1.-OK_hds,G2_hds,
-! #vp.                 G1snSV(ikl,isn),
-! #vp.                 G2snSV(ikl,isn)
-
-        END DO
-      END DO
-c!$OMP END PARALLEL DO
- 
-C +-- 2. Mise a Jour Variables Historiques (Cas non dendritique)
-C +      Update of the historical Variables
-C +      =======================================================
- 
-      IF (vector)                                                   THEN
-cXF
-         DO  ikl=1,knonv
-          DO isn=1,isnoSV(ikl)
-          SphrOK = max(zero,sign(unun,       G1snSV(ikl,isn)))
-          H1a_OK = max(zero,sign(unun,vsphe4-G1snSV(ikl,isn)))
-          H1b_OK =     1   - min(1   ,       istoSV(ikl,isn))
-          H1__OK =                    H1a_OK*H1b_OK
-          H23aOK = max(zero,sign(unun,vsphe4-G1_dSV
-     .                                      +G1snSV(ikl,isn)))
-          H23bOK = max(zero,sign(unun,etaSno(ikl,isn)
-     .                      /max(epsi,dzsnSV(ikl,isn))
-     .                                      -vtelv1         ))
-          H23_OK =                    H23aOK*H23bOK
-          H2__OK =     1   - min(1   ,       istoSV(ikl,isn))
-          H3__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(1)))
-          H45_OK = max(zero,sign(unun,TfSnow-TsisSV(ikl,isn)+epsi))
-          H4__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(2)))
-          H5__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(3)))
- 
-          HISupd          =
-     .    SphrOK*(H1__OK                             *istdSV(1)
-     .       +(1.-H1__OK)*    H23_OK         *(H2__OK*istdSV(2)
-     .                                        +H3__OK*istdSV(3))
-     .       +(1.-H1__OK)*(1.-H23_OK) *H45_OK*(H4__OK*istdSV(4)
-     .                                        +H5__OK*istdSV(5)))
-          istoSV(ikl,isn) =   HISupd  +
-     .           (1.-min(unun,HISupd))               *istoSV(ikl,isn)
-        END DO
-        END DO
-      ELSE
- 
- 
-C +-- 2. Mise a Jour Variables Historiques (Cas non dendritique)
-C +      Update of the historical Variables
-C +      =======================================================
- 
-        DO ikl=1,knonv
-        DO isn=iiceSV(ikl),isnoSV(ikl)
-          IF  (G1snSV(ikl,isn).ge.0.)                               THEN
-            IF(G1snSV(ikl,isn).lt.vsphe4.and.istoSV(ikl,isn).eq.0)  THEN
-                   istoSV(ikl,isn)=istdSV(1)
-            ELSEIF(G1_dSV-G1snSV(ikl,isn)         .lt.vsphe4.and.
-     .             etaSno(ikl,isn)/dzsnSV(ikl,isn).gt.vtelv1)       THEN
-              IF  (istoSV(ikl,isn).eq.0)
-     .             istoSV(ikl,isn)=   istdSV(2)
-              IF  (istoSV(ikl,isn).eq.istdSV(1))
-     .             istoSV(ikl,isn)=   istdSV(3)
-            ELSEIF(TsisSV(ikl,isn).lt.TfSnow)                       THEN
-              IF  (istoSV(ikl,isn).eq.istdSV(2))
-     .             istoSV(ikl,isn)=   istdSV(4)
-              IF  (istoSV(ikl,isn).eq.istdSV(3))
-     .             istoSV(ikl,isn)=   istdSV(5)
-            END IF
-          END IF
-        END DO
-        END DO
-      END IF
- 
- 
-C +-- 3. Tassement mecanique /mechanical Settlement
-C +      ==========================================
- 
-        DO ikl=1,knonv
-          SnMass(ikl) = 0.
-        END DO
-cXF
-      DO ikl=1,knonv
- 
-        smb_old = 0.
-         zn_old = 0
-        DO isn  = 1, isnoSV(ikl)
-        smb_old = smb_old + dzsnSV(ikl,isn) *ro__SV(ikl,isn)
-         zn_old = zn_old  + dzsnSV(ikl,isn)
-        ENDDO
- 
-        DO   isn=isnoSV(ikl),1,-1
-          dSnMas     = 100.*dzsnSV(ikl,isn)*ro_dry(ikl,isn)
-          SnMass(ikl)=      SnMass(ikl)+0.5*dSnMas
-          ViscSn     =      vvisc1         *vvisc2
-     .               *exp(vvisc3           *ro_dry(ikl,isn)
-     .                   +vvisc4*abs(TfSnow-TsisSV(ikl,isn)))
-     .                                     *ro_dry(ikl,isn)/rovisc
- 
-C +-- Changement de Viscosite si Teneur en Eau liquide
-C +   Change of the Viscosity if liquid Water Content
-C +   ------------------------------------------------
- 
-          OK_Liq     =    max(zero,sign(unun,etaSno(ikl,isn)-epsi))
-          OK_Ang     =    max(zero,sign(unun,vgran6-G1snSV(ikl,isn)))
-     .                *(1-min(1   , abs(istoSV(ikl,isn)-istdSV(1))))
-! #wp     IF (G1snSV(ikl,isn).gt.0..AND.G1snSV(ikl,isn).lt.vsphe4
-! #wp.                             .AND.istoSV(ikl,isn).eq.     0)
-! #wp.    THEN
-! #wp       write(6,*) ikl,isn,' G1,G2,hist,OK_Ang  ',
-! #wp.          G1snSV(ikl,isn), G2snSV(ikl,isn),istoSV(ikl,isn),OK_Ang
-! #wp       stop "Grains anguleux mal d?finis"
-! #wp     END IF
-          OKxLiq     =    max(zero,sign(unun,vtelv1-etaSno(ikl,isn)
-     .                                    /max(epsi,dzsnSV(ikl,isn))))
-     .               *    max(0   ,sign(1   ,istoSV(ikl,isn)
-     .                                      -istdSV(1)      ))
-          ViscSn     =
-     .    ViscSn*(    OK_Liq/(vvisc5+vvisc6*etaSno(ikl,isn)
-     .                            /max(epsi,dzsnSV(ikl,isn)))
-     .           +(1.-OK_Liq)                               )
-     .          *(    OK_Ang*exp(min(ADSdSV,G2snSV(ikl,isn)-vdiam4))
-     .           +(1.-OK_Ang)                                       )
-     .          *(    OKxLiq*        vvisc7
-     .           +(1.-OKxLiq)              )
- 
- 
-C +-- Calcul nouvelle Epaisseur / new Thickness
-C +   -----------------------------------------
- 
-          dzsnew         =
-     .    dzsnSV(ikl,isn)
-     .     *max(vdz3,
-     .         (unun-dt__SV2*max(SnMass(ikl)*cos(slopSV(ikl)),unun)
-     .                     /max(ViscSn                      ,epsi)))
-          rosnew         = ro__SV(ikl,isn) *dzsnSV(ikl,isn)
-     .                            /max(1e-10,dzsnew)
-          rosmax         = 1.   /( (1. -eta_SV(ikl,isn)) /ro_Ice
-     .                           +      eta_SV(ikl,isn)  /ro_Wat)
-          rosnew         = min(rosnew ,rosmax)
-          dzsnew         = dzsnSV(ikl,isn) *ro__SV(ikl,isn)
-     .                            /max(1e-10,rosnew)
-          ro__SV(ikl,isn)= rosnew
-          dzsnSV(ikl,isn)= dzsnew
-          ro_dry(ikl,isn)= ro__SV(ikl,isn)*(1.-eta_SV(ikl,isn))*1.e-3
-C +...    ro_dry: Dry Density (g/cm3)
-C +
-          SnMass(ikl)    = SnMass(ikl)+dSnMas*0.5
-        END DO
- 
-        smb_new = 0.
-        DO isn  = 1, isnoSV(ikl)
-        smb_new = smb_new + dzsnSV(ikl,isn) *ro__SV(ikl,isn)
-        ENDDO
- 
-        isn=1
-        if (dzsnSV(ikl,isn)>0.and.ro__SV(ikl,isn)>0) then
-        dzsnSV(ikl,isn) = dzsnSV(ikl,isn) +0.9999*(smb_old-smb_new)
-     .                  / ro__SV(ikl,isn)
-        endif
- 
-         zn_new = 0
-        DO isn  = 1, isnoSV(ikl)
-         zn_new = zn_new  + dzsnSV(ikl,isn)
-        ENDDO
-        zn4_SV(ikl) = zn4_SV(ikl) + (zn_new - zn_old)
- 
-      END DO
- 
-
- 
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_gsn.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_gsn.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_gsn.f90	(revision 5246)
@@ -0,0 +1,925 @@
+
+subroutine SISVAT_GSn
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_GSn                                20-09-2003  MAR |
+  ! |   SubRoutine SISVAT_GSn simulates SNOW Metamorphism                    |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  ! |                     X       Number of Mosaic Cell per grid box         |
+  ! |                                                                        |
+  ! |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
+  ! |   ^^^^^^   istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+  ! |                                                                        |
+  ! |   INPUT:   TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+  ! |   ^^^^^             & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+  ! |            ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+  ! |            eta_SV   : Soil/Snow Water   Content                [m3/m3] |
+  ! |            slopSV   : Surface Slope                                [-] |
+  ! |            dzsnSV   : Snow Layer        Thickness                  [m] |
+  ! |            dt__SV2   : Time  Step                                   [s] |
+  ! |                                                                        |
+  ! |   INPUT /  G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+  ! |   OUTPUT:  G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+  ! |   ^^^^^^                                                               |
+  ! |                                                                        |
+  ! |   Formalisme adopte pour la Representation des Grains:                 |
+  ! |   Formalism         for the Representation of  Grains:                 |
+  ! |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                 |
+  ! |                                                                        |
+  ! |             1       - -1                 Neige Fraiche                 |
+  ! |            / \      |                    -------------                 |
+  ! |           /   \     |  Dendricite        decrite  par Dendricite       |
+  ! |          /     \    |  Dendricity                  et Sphericite       |
+  ! |         /       \   |                                                  |
+  ! |        2---------3  -  0                 described by Dendricity       |
+  ! |                                                   and Sphericity       |
+  ! |        |---------|                                                     |
+  ! |        0         1                                                     |
+  ! |        Sphericite                                                      |
+  ! |        Sphericity                                                      |
+  ! |                                                                        |
+  ! |        4---------5  -                                                  |
+  ! |        |         |  |                                                  |
+  ! |        |         |  |  Diametre (1/10eme de mm) (ou Taille)            |
+  ! |        |         |  |  Diameter (1/10th  of mm) (or Size  )            |
+  ! |        |         |  |                                                  |
+  ! |        |         |  |                    Neige non dendritique         |
+  ! |        6---------7  -                    ---------------------         |
+  ! |                                          decrite  par Sphericite       |
+  ! |                                                    et     Taille       |
+  ! |                                          described by Sphericity       |
+  ! |                                                   and       Size       |
+  ! |                                                                        |
+  ! |   Les Variables du Modele:                                             |
+  ! |   Model         Variables:                                             |
+  ! |   ^^^^^^^^^^^^^^^^^^^^^^^^                                             |
+  ! |     Cas Dendritique               Cas non Dendritique                  |
+  ! |                                                                        |
+  ! |     G1snSV        : Dendricite    G1snSV        : Sphericite           |
+  ! |     G2snSV        : Sphericite    G2snSV        : Taille (1/10e mm)    |
+  ! |                                                   Size                 |
+  ! |                                                                        |
+  ! |   Cas Dendritique/ Dendritic Case                                      |
+  ! |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                                      |
+  ! |   Dendricite(Dendricity) G1snSV                                        |
+  ! |            varie     de -G1_dSV (-99 par defaut / etoile)          a 0 |
+  ! |            division par -G1_dSV pour obtenir des valeurs entre 1  et 0 |
+  ! |            varies  from -G1_dSV (default -99    / fresh snow)     to 0 |
+  ! |            division  by -G1_dSV to obtain values       between 1 and 0 |
+  ! |                                                                        |
+  ! |   Sphericite(Sphericity) G2snSV                                        |
+  ! |            varie     de  0         (cas completement anguleux)         |
+  ! |                       a  G1_dSV (99 par defaut, cas spherique)         |
+  ! |            division par  G1_dSV pour obtenir des valeurs entre 0  et 1 |
+  ! |            varies  from  0      (full faceted)               to G1_dSV |
+  ! |                                                                        |
+  ! |   Cas non Dendritique / non Dendritic Case                             |
+  ! |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                             |
+  ! |   Sphericite(Sphericity) G1snSV                                        |
+  ! |            varie     de  0         (cas completement anguleux)         |
+  ! |                       a  G1_dSV (99 par defaut, cas spherique)         |
+  ! |            division par  G1_dSV pour obtenir des valeurs entre 0  et 1 |
+  ! |            varies  from  0      (full faceted)               to G1_dSV |
+  ! |                                                                        |
+  ! |   Taille    (Size)       G2snSV                                        |
+  ! |            superieure a  ADSdSV (.4 mm) et ne fait que croitre         |
+  ! |            greater than  ADSdSV (.4 mm) always increases               |
+  ! |                                                                        |
+  ! |   Exemples: Points caracteristiques des Figures ci-dessus              |
+  ! |   ^^^^^^^^^                                                            |
+  ! |                                                                        |
+  ! |               G1snSV    G2snSV     dendricite  sphericite  taille      |
+  ! |                                    dendricity  sphericity  size        |
+  ! |   ------------------------------------------------------------------   |
+  ! |                                                            [1/10 mm]   |
+  ! |     1        -G1_dSV    sph3SN          1           0.5                |
+  ! |     2           0         0             0           0                  |
+  ! |     3           0       G1_dSV          0           1                  |
+  ! |     4           0       ADSdSV                      0       4.         |
+  ! |     5         G1_dSV    ADSdSV-vsphe1               1       3.         |
+  ! |     6           0         --                        0       --         |
+  ! |     7         G1_dSV      --                        1       --         |
+  ! |                                                                        |
+  ! |   par defaut: G1_dSV=99.                                               |
+  ! |                         sph3SN=50.                                     |
+  ! |                         ADSdSV= 4.                                     |
+  ! |                                vsphe1=1.                               |
+  ! |                                                                        |
+  ! |   Methode:                                                             |
+  ! |   ^^^^^^^^                                                             |
+  ! |   1. Evolution Types de Grains selon Lois de Brun et al. (1992):       |
+  ! |      Grain metamorphism according to         Brun et al. (1992):       |
+  ! |      Plusieurs Cas sont a distiguer  /  the different Cases are:       |
+  ! |       1.1 Metamorphose Neige humide  /  wet Snow                       |
+  ! |       1.2 Metamorphose Neige seche   /  dry Snow                       |
+  ! |         1.2.1 Gradient faible        /  low      Temperature Gradient  |
+  ! |         1.2.2 Gradient moyen         /  moderate Temperature Gradient  |
+  ! |         1.2.3 Gradient fort          /  high     Temperature Gradient  |
+  ! |      Dans chaque Cas on separe Neige Dendritique et non Dendritique    |
+  ! |                           le Passage Dendritique -> non Dendritique    |
+  ! |                           se fait lorsque  G1snSV devient > 0          |
+  ! |      the Case of Dentritic or non Dendritic Snow is treated separately |
+  ! |      the Limit   Dentritic -> non Dendritic is reached when G1snSV > 0 |
+  ! |                                                                        |
+  ! |   2. Tassement: Loi de Viscosite adaptee selon le Type de Grains       |
+  ! |      Snow Settling:    Viscosity depends on the   Grain Type           |
+  ! |                                                                        |
+  ! |   3. Update Variables historiques (cas non dendritique seulement)      |
+  ! |      nhSNow defaut                                                     |
+  ! |                0    Cas normal                                         |
+  ! |      istdSV(1) 1    Grains anguleux / faceted cristal                  |
+  ! |      istdSV(2) 2    Grains ayant ete en presence d eau liquide         |
+  ! |                     mais n'ayant pas eu de caractere anguleux    /     |
+  ! |                     liquid water and no faceted cristals before        |
+  ! |      istdSV(3) 3    Grains ayant ete en presence d eau liquide         |
+  ! |                     ayant eu auparavant un caractere anguleux    /     |
+  ! |                     liquid water and    faceted cristals before        |
+  ! |                                                                        |
+  ! |   REFER. : Brun et al.      1989, J. Glaciol 35 pp. 333--342           |
+  ! |   ^^^^^^^^ Brun et al.      1992, J. Glaciol 38 pp.  13-- 22           |
+  ! |            (CROCUS Model, adapted to MAR at CEN by H.Gallee)           |
+  ! |                                                                        |
+  ! |   REFER. : Marbouty, D.     1980, J. Glaciol 26 pp. xxx--xxx           |
+  ! |   ^^^^^^^^ (CROCUS Model, adapted to MAR at CEN by H.Gallee)           |
+  ! |            (for angular shapes)                                        |
+  ! |                                                                        |
+  ! |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+  ! |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+  ! |   FILE                 |      CONTENT                                  |
+  ! |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+  ! | # SISVAT_GSn.vp        | #vp: OUTPUT/Verification: Snow   Properties   |
+  ! |                        |      unit 47, SubRoutines SISVAT_zSn, _GSn    |
+  ! | # stdout               | #wp: OUTPUT/Verification: Snow   Properties   |
+  ! |                        |      unit  6, SubRoutine  SISVAT_GSn          |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VAR0SV
+  use VARxSV
+  use VARtSV
+
+
+  IMPLICIT NONE
+
+
+
+  ! +--INPUT/OUTPUT
+  ! +  ------------
+
+
+  ! +--OUTPUT
+  ! +  ------
+
+  integer :: dt__SV2
+
+
+  ! +--Local  Variables
+  ! +  ================
+
+  logical :: vector                        !
+  integer :: ikl                           !
+  integer :: isn   ,isnp                   !
+  integer :: istoOK                        !
+  real :: G1_bak,G2_bak                 ! Old Values of G1, G2
+  real :: ro_dry(knonv,      nsno)      ! Dry Density            [g/cm3]
+  real :: etaSno(knonv,      nsno)      ! Liquid Water Content   [g/cm2]
+  real :: SnMass(knonv)                 ! Snow   Mass            [kg/m2]
+  real :: dTsndz                        ! Temperature Gradient
+  real :: sWater                        !        Water Content       [%]
+  real :: exp1Wa                        !
+  real :: dDENDR                        ! Dendricity Increment
+  real :: DENDRn                        ! Normalized Dendricity
+  real :: SPHERn                        ! Normalized Sphericity
+  real :: Wet_OK                        ! Wet Metamorphism Switch
+  real :: OK__DE                        !
+  real :: OK__wd                        ! New G*, from wet Dendritic
+  real :: G1__wd                        ! New G1, from wet Dendritic
+  real :: G2__wd                        ! New G2, from wet Dendritic
+  real :: OKlowT                        !
+  real :: facVap                        !
+  real :: OK_ldd                        !
+  real :: G1_ldd                        !
+  real :: G2_ldd                        !
+  real :: DiamGx                        !
+  real :: DiamOK                        !
+  real :: No_Big                        !
+  real :: dSPHER                        !
+  real :: SPHER0                        !
+  real :: SPHbig                        !
+  real :: G1_lds                        !
+  real :: OK_mdT                        !
+  real :: OKmidT                        !
+  real :: OKhigT                        !
+  real :: OK_mdd                        !
+  real :: G1_mdd                        !
+  real :: G2_mdd                        !
+  real :: G1_mds                        !
+  real :: OK_hdd                        !
+  real :: G1_hdd                        !
+  real :: G2_hdd                        !
+  real :: OK_hds                        !
+  real :: G1_hds                        !
+  real :: T1__OK,T2__OK                 !
+  real :: T3_xOK,T3__OK,T3_nOK          !
+  real :: ro1_OK,ro2_OK                 !
+  real :: dT1_OK,dT2_OK,dT3xOK,dT3_OK   !
+  real :: dT4xOK,dT4_OK,dT4nOK,AngSno   !
+  real :: G2_hds,SphrOK,HISupd          !
+  real :: H1a_OK,H1b_OK,H1__OK          !
+  real :: H23aOK,H23bOK,H23_OK          !
+  real :: H2__OK,H3__OK                 !
+  real :: H45_OK,H4__OK,H5__OK          !
+  real :: ViscSn,OK_Liq,OK_Ang,OKxLiq   !
+  real :: dSnMas,dzsnew,rosnew,rosmax,smb_old,smb_new
+  real :: zn_old,zn_new
+
+  real :: epsi5                         ! Alpha ev67 single precision	
+  real :: vdiam1                        ! Small Grains Min.Diam.[.0001m]
+  real :: vdiam2                        ! Spher.Variat.Max Diam.    [mm]
+  real :: vdiam3                        ! Min.Diam.|Limit Spher.    [mm]
+  real :: vdiam4                        ! Min.Diam.|Viscosity Change
+  real :: vsphe1                        ! Max Sphericity
+  real :: vsphe2                        ! Low T Metamorphism  Coeff.
+  real :: vsphe3                        ! Max.Sphericity (history=1)
+  real :: vsphe4                        ! Min.Sphericity=>history=1
+  real :: vtang1,vtang2,vtang3,vtang4   ! Temperature Contribution
+  real :: vtang5,vtang6,vtang7,vtang8   !
+  real :: vtang9,vtanga,vtangb,vtangc   !
+  real :: vrang1,vrang2                 ! Density     Contribution
+  real :: vgang1,vgang2,vgang3,vgang4   ! Grad(T)     Contribution
+  real :: vgang5,vgang6,vgang7,vgang8   !
+  real :: vgang9,vganga,vgangb,vgangc   !
+  real :: vgran6                        ! Max.Sphericity for Settling
+  real :: vtelv1                        ! Threshold | history = 2, 3
+  real :: vvap1                        ! Vapor Pressure Coefficient
+  real :: vvap2                        ! Vapor Pressure Exponent
+  real :: vgrat1                        ! Boundary weak/mid   grad(T)
+  real :: vgrat2                        ! Boundary mid/strong grad(T)
+  real :: vfi                        ! PHI,         strong grad(T)
+  real :: vvisc1,vvisc2,vvisc3,vvisc4   ! Viscosity Coefficients
+  real :: vvisc5,vvisc6,vvisc7          ! id., wet Snow
+  real :: rovisc                        ! Wet Snow Density  Influence
+  real :: vdz3                        ! Maximum Layer Densification
+  real :: OK__ws                        ! New G2
+  real :: G1__ws                        ! New G1, from wet Spheric
+  real :: G2__ws                        ! New G2, from wet Spheric
+  real :: husi_0,husi_1,husi_2,husi_3   ! Constants for New G2
+  real :: vtail1,vtail2                 ! Constants for New G2
+  real :: frac_j                        ! Time Step            [Day]
+
+  real :: vdent1                       ! Wet Snow Metamorphism
+  integer :: nvdent1                       ! (Coefficients for
+  integer :: nvdent2                       !           Dendricity)
+
+  ! +--Snow Properties: IO
+  ! +  ~~~~~~~~~~~~~~~~~~~
+  ! #vp real      G_curr(18),Gcases(18)
+  ! #vp common   /GSnLOC/    Gcases
+  ! #wp real                 D__MAX
+  ! #wp common   /GSnMAX/    D__MAX
+
+
+  ! +--DATA
+  ! +  ====
+
+  data       vector/.true./               ! Vectorization  Switch
+  data       vdent1/ 0.5e8/               ! Wet Snow Metamorphism
+  !XF                      tuned for Greenland (2.e8=old value)
+  data      nvdent1/ 3   /                ! (Coefficients for
+  data      nvdent2/16   /                !           Dendricity)
+
+  data       husi_0 /20.      /           !   10  * 2
+  data       husi_1 / 0.23873 /           ! (3/4) /pi
+  data       husi_2 / 4.18880 /           ! (4/3) *pi
+  data       husi_3 / 0.33333 /           !  1/3
+  data       vtail1 / 1.28e-08/           !  Wet Metamorphism
+  data       vtail2 / 4.22e-10/           ! (NON Dendritic / Spheric)
+
+  data       epsi5  / 1.0e-5  /           !
+
+  data       vdiam1 / 4.0     /           ! Small Grains Min.Diameter
+
+  data       vdiam2 / 0.5     /           ! Spher.Variat.Max Diam.[mm]
+  data       vdiam3 / 3.0     /           ! Min.Diam.|Limit Spher.[mm]
+  data       vdiam4 / 2.0     /           ! Min.Diam.|Viscosity Change
+
+  data       vsphe1 / 1.0     /           ! Max Sphericity
+  data       vsphe2 / 1.0e9   /           ! Low T Metamorphism  Coeff.
+  data       vsphe3 / 0.5     /           ! Max.Sphericity (history=1)
+  data       vsphe4 / 0.1     /           ! Min.Sphericity=>history=1
+
+  data       vgran6 / 51.     /           ! Max.Sphericity for Settling
+  data       vtelv1 / 5.e-1   /           ! Threshold | history = 2, 3
+
+  data        vvap1 /-6.e3    /           ! Vapor Pressure Coefficient
+  data        vvap2 / 0.4     /           ! Vapor Pressure Exponent
+
+  data       vgrat1 /0.05     /           ! Boundary weak/mid   grad(T)
+  data       vgrat2 /0.15     /           ! Boundary mid/strong grad(T)
+  data          vfi /0.09     /           ! PHI,         strong grad(T)
+
+  data       vvisc1 / 0.70    /           ! Viscosity Coefficients
+  data       vvisc2 / 1.11e5  /           !
+  data       vvisc3 /23.00    /           !
+  data       vvisc4 / 0.10    /           !
+  data       vvisc5 / 1.00    /           ! id., wet Snow
+  data       vvisc6 / 2.00    /           !
+  data       vvisc7 /10.00    /           !
+  data       rovisc / 0.25    /           ! Wet Snow Density  Influence
+  data         vdz3 / 0.30    /           ! Maximum Layer Densification
+
+
+  ! +--DATA (Coefficient Fonction fort Gradient Marbouty)
+  ! +  --------------------------------------------------
+
+  data       vtang1 /40.0/                ! Temperature Contribution
+  data       vtang2 / 6.0/                !
+  data       vtang3 /22.0/                !
+  data       vtang4 / 0.7/                !
+  data       vtang5 / 0.3/                !
+  data       vtang6 / 6.0/                !
+  data       vtang7 / 1.0/                !
+  data       vtang8 / 0.8/                !
+  data       vtang9 /16.0/                !
+  data       vtanga / 0.2/                !
+  data       vtangb / 0.2/                !
+  data       vtangc /18.0/                !
+
+  data       vrang1 / 0.40/               ! Density     Contribution
+  data       vrang2 / 0.15/               !
+
+  data       vgang1 / 0.70/               ! Grad(T)     Contribution
+  data       vgang2 / 0.25/               !
+  data       vgang3 / 0.40/               !
+  data       vgang4 / 0.50/               !
+  data       vgang5 / 0.10/               !
+  data       vgang6 / 0.15/               !
+  data       vgang7 / 0.10/               !
+  data       vgang8 / 0.55/               !
+  data       vgang9 / 0.65/               !
+  data       vganga / 0.20/               !
+  data       vgangb / 0.85/               !
+  data       vgangc / 0.15/               !
+
+  ! #wp data       D__MAX / 4.00/               !
+
+
+  ! +-- 1. Metamorphoses dans les Strates
+  ! +      Metamorphism
+  ! +      ==============================
+
+  dt__SV2= dt__SV
+  frac_j = dt__SV2 / 86400.                        ! Time Step [Day]
+
+  zn4_SV = 0
+
+
+  ! +-- 1.1 Initialisation: teneur en eau liquide et gradient de temperature
+  ! +   ------------------  liquid water content and temperature gradient
+
+   DO ikl=1,knonv
+    DO   isn=1,isnoSV(ikl)
+
+      ro_dry(ikl,isn) = 1.e-3 *ro__SV(ikl,isn) & ! Dry Density
+            *(1.    -eta_SV(ikl,isn))   !         [g/cm3]
+      etaSno(ikl,isn) = 1.e-1 *dzsnSV(ikl,isn) & ! Liquid Water
+            *        ro__SV(ikl,isn) & ! Content [g/cm2]
+            *        eta_SV(ikl,isn)    !
+    END DO
+  END DO
+
+  !!$OMP PARALLEL DO default(firstprivate)
+  !!$OMP.shared (/xSISVAT_I/,/xSISVAT_R/,/SoR0SV/,/SoI0SV/,/Sn_dSV/)
+   DO ikl=1,knonv
+    DO   isn=1,isnoSV(ikl)
+      isnp   = min(isn+1,isnoSV(ikl))
+
+      dTsndz = abs( (TsisSV(ikl,isnp)-TsisSV(ikl,isn-1)) *2.e-2 &
+            /max(((dzsnSV(ikl,isnp)+dzsnSV(ikl,isn)  ) &
+            *(           isnp -           isn) &
+            +(dzsnSV(ikl,isn )+dzsnSV(ikl,isn-1))),epsi))
+  ! +...    Factor 1.d-2 for Conversion K/m --> K/cm
+
+
+  ! +-- 1.2 Metamorphose humide
+  ! +       Wet Snow Metamorphism
+  ! +       ---------------------
+
+      Wet_OK = max(zero,sign(unun,eta_SV(ikl,isn)-epsi))
+
+
+  ! +--     Vitesse de diminution de la dendricite
+  ! +       Rate of the dendricity decrease
+  ! +       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      sWater=1.d-1*ro__SV(ikl,isn)*eta_SV(ikl,isn) &
+            /max(epsi,ro_dry(ikl,isn))
+  ! +...    sWater:Water Content [%]
+  ! +              1.d-1= 1.d2(1->%) * 1.d-3(ro__SV*eta_SV:kg/m3->g/cm3)
+
+      exp1Wa=   sWater**nvdent1
+      dDENDR=max(exp1Wa/nvdent2,vdent1*exp(vvap1/TfSnow))
+
+  ! +-- 1.2.1 Cas dendritique/dendritic Case
+  ! +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      OK__wd=max(zero, & !
+            sign(unun,-G1snSV(ikl,isn) & !
+            -epsi           ))     !
+
+      DENDRn=-G1snSV(ikl,isn)/G1_dSV  ! Normalized Dendricity (+)
+      SPHERn= G2snSV(ikl,isn)/G1_dSV  ! Normalized Sphericity
+      DENDRn= DENDRn -dDENDR *frac_j  ! New        Dendricity (+)
+      SPHERn= SPHERn +dDENDR *frac_j  ! New        Sphericity
+
+      OK__DE=max(zero, & ! IF 1.,
+            sign(unun, DENDRn & ! NO change
+            -epsi           ))     ! Dendr. -> Spheric
+
+      G1__wd=OK__DE *    (      -DENDRn*G1_dSV) & ! Dendritic
+            +(1.-OK__DE)* min(G1_dSV,SPHERn*G1_dSV)   ! Dendr. -> Spheric
+      G2__wd=OK__DE * min(G1_dSV,SPHERn*G1_dSV) & ! Spheric
+            +(1.-OK__DE)*(ADSdSV-min(SPHERn,vsphe1))  ! Spher. -> Size
+
+  ! +-- 1.2.2 Cas non dendritique non completement spherique
+  ! +         Evolution de la Sphericite seulement.
+  ! +         Non dendritic and not completely spheric Case
+  ! +         Evolution of    Sphericity only (not size)
+  ! +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      OK__ws=max(zero, & !
+            sign(unun, G1_dSV & !
+            -epsi5 & !
+            -G1snSV(ikl,isn)))     !
+
+      SPHERn= G1snSV(ikl,isn)/G1_dSV
+      SPHERn= SPHERn +dDENDR *frac_j
+      G1__ws=         min(G1_dSV,SPHERn*G1_dSV)
+
+  ! +-- 1.2.3 Cas non dendritique et spherique / non dendritic and spheric
+  ! +         Evolution de la Taille seulement / Evolution of Size only
+  ! +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      G2__ws =  husi_0 &
+            *( husi_1 &
+            *(husi_2 *( G2snSV(ikl,isn)/husi_0)**3 &
+            +(vtail1 +vtail2 *exp1Wa    )*dt__SV2)) &
+            ** husi_3
+
+
+  ! +-- 1.3 Metamorposes seches / Dry Metamorphism
+  ! +       --------------------------------------
+
+
+  ! +-- 1.3.1 Calcul Metamorphose faible/low Gradient (0.00-0.05 deg/cm)
+  ! +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      OKlowT=max(zero, & !
+            sign(unun, vgrat1 & !
+            -dTsndz         ))     !
+
+      facVap=exp(vvap1/TsisSV(ikl,isn))
+
+  ! +-- 1.3.1.1 Cas dendritique / dendritic Case
+
+      OK_ldd=max(zero, & !
+            sign(unun,-G1snSV(ikl,isn) & !
+            -epsi           ))     !
+
+      DENDRn=-G1snSV(ikl,isn)     /G1_dSV
+      SPHERn= G2snSV(ikl,isn)     /G1_dSV
+      DENDRn= DENDRn-vdent1*facVap*frac_j
+      SPHERn= SPHERn+vsphe2*facVap*frac_j
+
+      OK__DE=max(zero, & ! IF 1.,
+            sign(unun, DENDRn & ! NO change
+            -epsi           ))     ! Dendr. -> Spheric
+
+      G1_ldd= OK__DE *    (      -DENDRn*G1_dSV) & ! Dendritic
+            +(1.-OK__DE)* min(G1_dSV,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+      G2_ldd= OK__DE * min(G1_dSV,SPHERn*G1_dSV) & ! Spheric
+            +(1.-OK__DE)*(ADSdSV-min(SPHERn,vsphe1)) ! Spher. -> Size
+
+  ! +-- 1.3.1.2 Cas non dendritique / non dendritic Case
+
+      SPHERn=G1snSV(ikl,isn)/G1_dSV
+      DiamGx=G2snSV(ikl,isn)*0.1
+
+      istoOK=min( abs(istoSV(ikl,isn)- &
+            istdSV(1)      ),1)         ! zero if istoSV = 1
+      DiamOK=max(zero,  sign(unun,vdiam2-DiamGx))
+      No_Big=    istoOK+DiamOK
+      No_Big=min(No_Big,unun)
+
+      dSPHER=           vsphe2*facVap*frac_j      !
+      SPHER0=    SPHERn+dSPHER                    ! small grains
+      SPHbig=    SPHERn+dSPHER & ! big   grains
+            *exp(min(zero,vdiam3-G2snSV(ikl,isn)))  ! (history = 2 or 3)
+      SPHbig=       min(vsphe3,SPHbig)            ! limited sphericity
+      SPHERn= No_Big *  SPHER0 &
+            + (1.-No_Big)*  SPHbig
+
+      G1_lds=       min(G1_dSV,SPHERn*G1_dSV)
+
+  ! +-- 1.3.2 Calcul Metamorphose Gradient Moyen/Moderate (0.05-0.15)
+  ! +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      OK_mdT=max(zero, & !
+            sign(unun, vgrat2 & !
+            -dTsndz))              !
+      OKmidT=               OK_mdT  *(1.-OKlowT)  !
+      OKhigT=          (1. -OK_mdT) *(1.-OKlowT)  !
+
+      facVap=vdent1*exp(vvap1/TsisSV(ikl,isn)) &
+            *   (1.e2 *dTsndz)**vvap2
+
+  ! +-- 1.3.2.1 cas dendritique / dendritic case.
+
+      OK_mdd=max(zero, & !
+            sign(unun,-G1snSV(ikl,isn) & !
+            -epsi           ))     !
+
+      DENDRn=-G1snSV(ikl,isn)/G1_dSV
+      SPHERn= G2snSV(ikl,isn)/G1_dSV
+      DENDRn= DENDRn - facVap*frac_j
+      SPHERn= SPHERn - facVap*frac_j
+
+      OK__DE=max(zero, & ! IF 1.,
+            sign(unun, DENDRn & ! NO change
+            -epsi           ))     ! Dendr. -> Spheric
+
+      G1_mdd= OK__DE *    (      -DENDRn*G1_dSV) & ! Dendritic
+            +(1.-OK__DE)* max(zero  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+      G2_mdd= OK__DE * max(zero  ,SPHERn*G1_dSV) & ! Spheric
+            +(1.-OK__DE)*(ADSdSV-max(SPHERn,zero  )) ! Spher. -> Size
+
+  ! +-- 1.3.2.2 Cas non dendritique / non dendritic Case
+
+      SPHERn=G1snSV(ikl,isn)/G1_dSV
+      SPHERn=         SPHERn-facVap*frac_j
+      G1_mds=max(zero,SPHERn*G1_dSV)
+
+  ! +-- 1.3.3 Calcul Metamorphose fort / high Gradient
+  ! +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      facVap=vdent1*exp(vvap1/TsisSV(ikl,isn)) &
+            *   (1.e2 *dTsndz)**vvap2
+
+  ! +-- 1.3.3.1 Cas dendritique / dendritic Case
+
+      OK_hdd=max(zero, & !
+            sign(unun,-G1snSV(ikl,isn) & !
+            -epsi           ))     !
+
+      DENDRn=-G1snSV(ikl,isn)/G1_dSV              !
+      SPHERn= G2snSV(ikl,isn)/G1_dSV              !
+      DENDRn= DENDRn - facVap*frac_j              !
+      SPHERn= SPHERn - facVap*frac_j              ! Non dendritic
+  ! +                                                   ! and angular
+      OK__DE=max(zero, & ! IF 1.,
+            sign(unun, DENDRn & ! NO change
+            -epsi  ))              ! Dendr. -> Spheric
+
+      G1_hdd= OK__DE *    (      -DENDRn*G1_dSV) & ! Dendritic
+            +(1.-OK__DE)* max(zero  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+      G2_hdd= OK__DE * max(zero  ,SPHERn*G1_dSV) & ! Spheric
+            +(1.-OK__DE)*(ADSdSV-max(SPHERn,zero  )) ! Spher. -> Size
+
+  ! +-- 1.3.3.2 Cas non dendritique non completement anguleux.
+  ! +           non dendritic and spericity gt. 0
+
+      OK_hds=max(zero, & !
+            sign(unun, G1snSV(ikl,isn) & !
+            -epsi           ))     !
+
+      SPHERn= G1snSV(ikl,isn)/G1_dSV
+      SPHERn= SPHERn - facVap*frac_j
+      G1_hds= max(zero,SPHERn*G1_dSV)
+
+  ! +-- 1.3.3.3 Cas non dendritique et anguleux
+  ! +           dendritic and spericity = 0.
+
+      T1__OK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang1))
+      T2__OK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang2))
+      T3_xOK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang3))
+      T3__OK =                    T3_xOK  * (1. - T2__OK)
+      T3_nOK =              (1. - T3_xOK) * (1. - T2__OK)
+      ro1_OK = max(zero,sign(unun,vrang1-ro_dry(ikl,isn)))
+      ro2_OK = max(zero,sign(unun,ro_dry(ikl,isn)-vrang2))
+      dT1_OK = max(zero,sign(unun,vgang1-dTsndz         ))
+      dT2_OK = max(zero,sign(unun,vgang2-dTsndz         ))
+      dT3xOK = max(zero,sign(unun,vgang3-dTsndz         ))
+      dT3_OK =                    dT3xOK  * (1. - dT2_OK)
+      dT4xOK = max(zero,sign(unun,vgang4-dTsndz         ))
+      dT4_OK =                    dT4xOK  * (1. - dT3_OK) &
+            * (1. - dT2_OK)
+      dT4nOK =              (1. - dT4xOK) * (1. - dT3_OK) &
+            * (1. - dT2_OK)
+
+  ! +-- Influence de la Temperature /Temperature Influence
+  ! +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      AngSno = &
+            T1__OK & ! 11
+            *(T2__OK*(vtang4+vtang5*(TfSnow       -TsisSV(ikl,isn)) & ! 12
+            /vtang6) & !
+            +T3__OK*(vtang7-vtang8*(TfSnow-vtang2-TsisSV(ikl,isn)) & ! 13
+            /vtang9) & !
+            +T3_nOK*(vtanga-vtangb*(TfSnow-vtang3-TsisSV(ikl,isn)) & ! 14
+            /vtangc)) & !
+
+  ! +-- Influence de la Masse Volumique /Density Influence
+  ! +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            * ro1_OK &
+            *(   ro2_OK*(1. - (ro_dry(ikl,isn)-vrang2) & !
+            /(vrang1-vrang2)) & !
+            +1.-ro2_OK                                ) & !
+
+  ! +-- Influence du Gradient de Temperature /Temperature Gradient Influence
+  ! +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            *(   dT1_OK*(dT2_OK*vgang5*(dTsndz-vgang6) & ! 15
+            /(vgang2-vgang6) & !
+            +dT3_OK*vgang7 & ! 16
+            +dT4_OK*vgang9 & ! 17
+            +dT4nOK*vgangb                ) & ! 18
+            +1.-dT1_OK                                ) & !
+            + ro1_OK &
+            *    dT1_OK*(dT3_OK*vgang8*(dTsndz-vgang2) &
+            /(vgang3-vgang2) &
+            +dT4_OK*vganga*(dTsndz-vgang3) &
+            /(vgang4-vgang3) &
+            +dT4nOK*vgangc*(dTsndz-vgang4) &
+            /(vgang1-vgang4))
+
+      G2_hds = G2snSV(ikl,isn) + 1.d2 *AngSno*vfi     *frac_j
+
+
+  ! +--New Properties
+  ! +  --------------
+
+      G1_bak          = G1snSV(ikl,isn)
+      G2_bak          = G2snSV(ikl,isn)
+
+      G1snSV(ikl,isn) = Wet_OK * (    OK__wd             *G1__wd & !  1
+            +(1.-OK__wd)*    OK__ws *G1__ws & !  2
+            +(1.-OK__wd)*(1.-OK__ws)*G1_bak) & !  3
+            +(1. - Wet_OK) & !
+            *(    OKlowT  *(    OK_ldd             *G1_ldd & !  4
+            +(1.-OK_ldd)            *G1_lds) & !  5
+            + OKmidT  *(    OK_mdd             *G1_mdd & !  6
+            +(1.-OK_mdd)            *G1_mds) & !  7
+            + OKhigT  *(    OK_hdd             *G1_hdd & !  8
+            +(1.-OK_hdd)*    OK_hds *G1_hds & !  9
+            +(1.-OK_hdd)*(1.-OK_hds)*G1_bak))  ! 10
+
+  !XF
+  if(G1snSV(ikl,isn)<0.1) &
+        G2_hds = G2snSV(ikl,isn) + 1.d1 *AngSno*vfi     *frac_j
+  !XF
+
+
+      G2snSV(ikl,isn) = Wet_OK * (    OK__wd             *G2__wd & !  1
+            +(1.-OK__wd)*    OK__ws *G2_bak & !  2
+            +(1.-OK__wd)*(1.-OK__ws)*G2__ws) & !  3
+            +(1. - Wet_OK) & !
+            *(    OKlowT  *(    OK_ldd             *G2_ldd & !  4
+            +(1.-OK_ldd)            *G2_bak) & !  5
+            + OKmidT  *(    OK_mdd             *G2_mdd & !  6
+            +(1.-OK_mdd)            *G2_bak) & !  7
+            + OKhigT  *(    OK_hdd             *G2_hdd & !  8
+            +(1.-OK_hdd)*    OK_hds *G2_bak & !  9
+            +(1.-OK_hdd)*(1.-OK_hds)*G2_hds))  ! 10
+
+  ! +--Snow Properties: IO Set Up
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~
+  ! #vp     G_curr( 1) =     Wet_OK             *    OK__wd
+  ! #vp     G_curr( 2) =     Wet_OK             *(1.-OK__wd)*    OK__ws
+  ! #vp     G_curr( 3) =     Wet_OK             *(1.-OK__wd)*(1.-OK__ws)
+  ! #vp     G_curr( 4) = (1.-Wet_OK)*    OKlowT *    OK_ldd
+  ! #vp     G_curr( 5) = (1.-Wet_OK)*    OKlowT *(1.-OK_ldd)
+  ! #vp     G_curr( 6) = (1.-Wet_OK)*    OKmidT *    OK_mdd
+  ! #vp     G_curr( 7) = (1.-Wet_OK)*    OKmidT *(1.-OK_mdd)
+  ! #vp     G_curr( 8) = (1.-Wet_OK)*    OKhigT *    OK_hdd
+  ! #vp     G_curr( 9) = (1.-Wet_OK)*    OKhigT *(1.-OK_hdd)*    OK_hds
+  ! #vp     G_curr(10) = (1.-Wet_OK)*    OKhigT *(1.-OK_hdd)*(1.-OK_hds)
+  ! #vp     G_curr(11) =     T1__OK                         * G_curr(10)
+  ! #vp     G_curr(12) =     T2__OK                         * G_curr(10)
+  ! #vp     G_curr(13) =     T3__OK                         * G_curr(10)
+  ! #vp     G_curr(14) =     T3_nOK                         * G_curr(10)
+  ! #vp     G_curr(15) =     ro1_OK*     dT1_OK *    dT2_OK * G_curr(10)
+  ! #vp     G_curr(16) =     ro1_OK*     dT1_OK *    dT3_OK * G_curr(10)
+  ! #vp     G_curr(17) =     ro1_OK*     dT1_OK *    dT4_OK * G_curr(10)
+  ! #vp     G_curr(18) =     ro1_OK*     dT1_OK *    dT4nOK * G_curr(10)
+
+  ! #vp     Gcases( 1) = max(Gcases( 1),G_curr( 1))
+  ! #vp     Gcases( 2) = max(Gcases( 2),G_curr( 2))
+  ! #vp     Gcases( 3) = max(Gcases( 3),G_curr( 3))
+  ! #vp     Gcases( 4) = max(Gcases( 4),G_curr( 4))
+  ! #vp     Gcases( 5) = max(Gcases( 5),G_curr( 5))
+  ! #vp     Gcases( 6) = max(Gcases( 6),G_curr( 6))
+  ! #vp     Gcases( 7) = max(Gcases( 7),G_curr( 7))
+  ! #vp     Gcases( 8) = max(Gcases( 8),G_curr( 8))
+  ! #vp     Gcases( 9) = max(Gcases( 9),G_curr( 9))
+  ! #vp     Gcases(10) = max(Gcases(10),G_curr(10))
+  ! #vp     Gcases(11) = max(Gcases(11),G_curr(11))
+  ! #vp     Gcases(12) = max(Gcases(12),G_curr(12))
+  ! #vp     Gcases(13) = max(Gcases(13),G_curr(13))
+  ! #vp     Gcases(14) = max(Gcases(14),G_curr(14))
+  ! #vp     Gcases(15) = max(Gcases(15),G_curr(15))
+  ! #vp     Gcases(16) = max(Gcases(16),G_curr(16))
+  ! #vp     Gcases(17) = max(Gcases(17),G_curr(17))
+  ! #vp     Gcases(18) = max(Gcases(18),G_curr(18))
+
+  ! +--Snow Properties: IO
+  ! +  ~~~~~~~~~~~~~~~~~~~
+  ! #vp     IF          (isn    .le.     isnoSV(ikl))
+  ! #vp.    write(47,471)isn            ,isnoSV(ikl)                    ,
+  ! #vp.                 TsisSV(ikl,isn),ro__SV(ikl,isn),eta_SV(ikl,isn),
+  ! #vp.                 G1_bak         ,G2_bak         ,istoSV(ikl,isn),
+  ! #vp.                 dTsndz,
+  ! #vp.                (       k ,k=1,18),
+  ! #vp.                (G_curr(k),k=1,18),
+  ! #vp.                (Gcases(k),k=1,18),
+  ! #vp.                 Wet_OK,OK__wd,G1__wd,G2__wd,
+  ! #vp.                     1.-OK__wd,OK__ws,G1__ws,1.-OK__ws,G2__ws,
+  ! #vp.              1.-Wet_OK,OKlowT,OK_ldd,G1_ldd,          G2_ldd,
+  ! #vp.                            1.-OK_ldd,G1_lds,
+  ! #vp.                        OKmidT,OK_mdd,G1_mdd,          G1_mdd,
+  ! #vp.                            1.-OK_mdd,G1_mds,
+  ! #vp.                        OKhigT,OK_hdd,G1_hdd,          G2_hdd,
+  ! #vp.                            1.-OK_hdd,OK_hds,          G1_hds,
+  ! #vp.                                             1.-OK_hds,G2_hds,
+  ! #vp.                 G1snSV(ikl,isn),
+  ! #vp.                 G2snSV(ikl,isn)
+
+    END DO
+  END DO
+  !!$OMP END PARALLEL DO
+
+  ! +-- 2. Mise a Jour Variables Historiques (Cas non dendritique)
+  ! +      Update of the historical Variables
+  ! +      =======================================================
+
+  IF (vector)                                                   THEN
+  !XF
+     DO  ikl=1,knonv
+      DO isn=1,isnoSV(ikl)
+      SphrOK = max(zero,sign(unun,       G1snSV(ikl,isn)))
+      H1a_OK = max(zero,sign(unun,vsphe4-G1snSV(ikl,isn)))
+      H1b_OK =     1   - min(1   ,       istoSV(ikl,isn))
+      H1__OK =                    H1a_OK*H1b_OK
+      H23aOK = max(zero,sign(unun,vsphe4-G1_dSV &
+            +G1snSV(ikl,isn)))
+      H23bOK = max(zero,sign(unun,etaSno(ikl,isn) &
+            /max(epsi,dzsnSV(ikl,isn)) &
+            -vtelv1         ))
+      H23_OK =                    H23aOK*H23bOK
+      H2__OK =     1   - min(1   ,       istoSV(ikl,isn))
+      H3__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(1)))
+      H45_OK = max(zero,sign(unun,TfSnow-TsisSV(ikl,isn)+epsi))
+      H4__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(2)))
+      H5__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(3)))
+
+      HISupd          = &
+            SphrOK*(H1__OK                             *istdSV(1) &
+            +(1.-H1__OK)*    H23_OK         *(H2__OK*istdSV(2) &
+            +H3__OK*istdSV(3)) &
+            +(1.-H1__OK)*(1.-H23_OK) *H45_OK*(H4__OK*istdSV(4) &
+            +H5__OK*istdSV(5)))
+      istoSV(ikl,isn) =   HISupd  + &
+            (1.-min(unun,HISupd))               *istoSV(ikl,isn)
+    END DO
+    END DO
+  ELSE
+
+
+  ! +-- 2. Mise a Jour Variables Historiques (Cas non dendritique)
+  ! +      Update of the historical Variables
+  ! +      =======================================================
+
+    DO ikl=1,knonv
+    DO isn=iiceSV(ikl),isnoSV(ikl)
+      IF  (G1snSV(ikl,isn).ge.0.)                               THEN
+        IF(G1snSV(ikl,isn).lt.vsphe4.and.istoSV(ikl,isn).eq.0)  THEN
+               istoSV(ikl,isn)=istdSV(1)
+        ELSEIF(G1_dSV-G1snSV(ikl,isn)         .lt.vsphe4.and. &
+              etaSno(ikl,isn)/dzsnSV(ikl,isn).gt.vtelv1)       THEN
+          IF  (istoSV(ikl,isn).eq.0) &
+                istoSV(ikl,isn)=   istdSV(2)
+          IF  (istoSV(ikl,isn).eq.istdSV(1)) &
+                istoSV(ikl,isn)=   istdSV(3)
+        ELSEIF(TsisSV(ikl,isn).lt.TfSnow)                       THEN
+          IF  (istoSV(ikl,isn).eq.istdSV(2)) &
+                istoSV(ikl,isn)=   istdSV(4)
+          IF  (istoSV(ikl,isn).eq.istdSV(3)) &
+                istoSV(ikl,isn)=   istdSV(5)
+        END IF
+      END IF
+    END DO
+    END DO
+  END IF
+
+
+  ! +-- 3. Tassement mecanique /mechanical Settlement
+  ! +      ==========================================
+
+    DO ikl=1,knonv
+      SnMass(ikl) = 0.
+    END DO
+  !XF
+  DO ikl=1,knonv
+
+    smb_old = 0.
+     zn_old = 0
+    DO isn  = 1, isnoSV(ikl)
+    smb_old = smb_old + dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+     zn_old = zn_old  + dzsnSV(ikl,isn)
+    ENDDO
+
+    DO   isn=isnoSV(ikl),1,-1
+      dSnMas     = 100.*dzsnSV(ikl,isn)*ro_dry(ikl,isn)
+      SnMass(ikl)=      SnMass(ikl)+0.5*dSnMas
+      ViscSn     =      vvisc1         *vvisc2 &
+            *exp(vvisc3           *ro_dry(ikl,isn) &
+            +vvisc4*abs(TfSnow-TsisSV(ikl,isn))) &
+            *ro_dry(ikl,isn)/rovisc
+
+  ! +-- Changement de Viscosite si Teneur en Eau liquide
+  ! +   Change of the Viscosity if liquid Water Content
+  ! +   ------------------------------------------------
+
+      OK_Liq     =    max(zero,sign(unun,etaSno(ikl,isn)-epsi))
+      OK_Ang     =    max(zero,sign(unun,vgran6-G1snSV(ikl,isn))) &
+            *(1-min(1   , abs(istoSV(ikl,isn)-istdSV(1))))
+  ! #wp     IF (G1snSV(ikl,isn).gt.0..AND.G1snSV(ikl,isn).lt.vsphe4
+  ! #wp.                             .AND.istoSV(ikl,isn).eq.     0)
+  ! #wp.    THEN
+  ! #wp       write(6,*) ikl,isn,' G1,G2,hist,OK_Ang  ',
+  ! #wp.          G1snSV(ikl,isn), G2snSV(ikl,isn),istoSV(ikl,isn),OK_Ang
+  ! #wp       stop "Grains anguleux mal d?finis"
+  ! #wp     END IF
+      OKxLiq     =    max(zero,sign(unun,vtelv1-etaSno(ikl,isn) &
+            /max(epsi,dzsnSV(ikl,isn)))) &
+            *    max(0   ,sign(1   ,istoSV(ikl,isn) &
+            -istdSV(1)      ))
+      ViscSn     = &
+            ViscSn*(    OK_Liq/(vvisc5+vvisc6*etaSno(ikl,isn) &
+            /max(epsi,dzsnSV(ikl,isn))) &
+            +(1.-OK_Liq)                               ) &
+            *(    OK_Ang*exp(min(ADSdSV,G2snSV(ikl,isn)-vdiam4)) &
+            +(1.-OK_Ang)                                       ) &
+            *(    OKxLiq*        vvisc7 &
+            +(1.-OKxLiq)              )
+
+
+  ! +-- Calcul nouvelle Epaisseur / new Thickness
+  ! +   -----------------------------------------
+
+      dzsnew         = &
+            dzsnSV(ikl,isn) &
+            *max(vdz3, &
+            (unun-dt__SV2*max(SnMass(ikl)*cos(slopSV(ikl)),unun) &
+            /max(ViscSn                      ,epsi)))
+      rosnew         = ro__SV(ikl,isn) *dzsnSV(ikl,isn) &
+            /max(1e-10,dzsnew)
+      rosmax         = 1.   /( (1. -eta_SV(ikl,isn)) /ro_Ice &
+            +      eta_SV(ikl,isn)  /ro_Wat)
+      rosnew         = min(rosnew ,rosmax)
+      dzsnew         = dzsnSV(ikl,isn) *ro__SV(ikl,isn) &
+            /max(1e-10,rosnew)
+      ro__SV(ikl,isn)= rosnew
+      dzsnSV(ikl,isn)= dzsnew
+      ro_dry(ikl,isn)= ro__SV(ikl,isn)*(1.-eta_SV(ikl,isn))*1.e-3
+  ! +...    ro_dry: Dry Density (g/cm3)
+  ! +
+      SnMass(ikl)    = SnMass(ikl)+dSnMas*0.5
+    END DO
+
+    smb_new = 0.
+    DO isn  = 1, isnoSV(ikl)
+    smb_new = smb_new + dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+    ENDDO
+
+    isn=1
+    if (dzsnSV(ikl,isn)>0.and.ro__SV(ikl,isn)>0) then
+    dzsnSV(ikl,isn) = dzsnSV(ikl,isn) +0.9999*(smb_old-smb_new) &
+          / ro__SV(ikl,isn)
+    endif
+
+     zn_new = 0
+    DO isn  = 1, isnoSV(ikl)
+     zn_new = zn_new  + dzsnSV(ikl,isn)
+    ENDDO
+    zn4_SV(ikl) = zn4_SV(ikl) + (zn_new - zn_old)
+
+  END DO
+
+
+
+  return
+end subroutine sisvat_gsn
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qsn.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qsn.F	(revision 5084)
+++ 	(revision )
@@ -1,717 +1,0 @@
- 
- 
-      subroutine SISVAT_qSn
-     .                     (
-! #e1.                      EqSn_0,EqSn_1,EqSn_d
-! #m1.                     ,SIsubl,SImelt,SIrnof
-     .                     )
- 
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_qSn                           Fri 29-Jul-2011  MAR |
-C |   SubRoutine SISVAT_qSn updates  the Snow Water Content                |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  knonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-C |                     X       Number of Mosaic Cell per grid box         |
-C |                                                                        |
-C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
-C |   ^^^^^                                                                |
-C |                                                                        |
-C |   INPUT:   TaT_SV   : SBL Top    Temperature                       [K] |
-C |   ^^^^^    dt__SV   : Time Step                                    [s] |
-C |                                                                        |
-C |   INPUT /  drr_SV   : Rain Intensity                         [kg/m2/s] |
-C |   OUTPUT:  dzsnSV   : Snow Layer Thickness                         [m] |
-C |   ^^^^^^   eta_SV   : Snow Water Content                       [m3/m3] |
-C |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
-C |            TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
-C |                     & Snow     Temperatures (layers  1,2,...,nsno) [K] |
-C |                                                                        |
-C |   OUTPUT:  SWS_SV   : Surficial Water Status                           |
-C |   ^^^^^^                                                               |
-C |            EExcsv   : Snow Energy in Excess, initial Forcing    [J/m2] |
-C |            EqSn_d   : Snow Energy in Excess, remaining          [J/m2] |
-C |            EqSn_0   : Snow Energy, before Phase Change          [J/m2] |
-C |            EqSn_1   : Snow Energy, after  Phase Change          [J/m2] |
-C |            SIsubl   : Snow sublimed/deposed Mass             [mm w.e.] |
-C |            SImelt   : Snow Melted           Mass             [mm w.e.] |
-C |            SIrnof   : Surficial Water + Run OFF Change       [mm w.e.] |
-C |                                                                        |
-C |   Internal Variables:                                                  |
-C |   ^^^^^^^^^^^^^^^^^^                                                   |
-C |                                                                        |
-C | # OPTIONS: #E0: IO for Verification: Energy       Budget               |
-C | # ^^^^^^^                                                              |
-C | #          #su: IO for Verification: Slush        Diagnostic           |
-C |                                                                        |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
-
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VAR0SV
-      use VARxSV
-      use VARySV
-      use surface_data, only: is_ok_slush,opt_runoff_ac
-
-
-      IMPLICIT NONE
-
- 
-! Energy          Budget
-! ~~~~~~~~~~~~~~~~~~~~~~
-! #e1 real     EqSn_d(knonv)                 ! Energy in Excess, initial
-! #e1 real     EqSn_0(knonv)                 ! Snow Energy, befor Phase Change
-! #vm real     EqSn01(knonv)                 ! Snow Energy, after Phase Change
-! #vm real     EqSn02(knonv)                 ! Snow Energy, after Phase Change
-                                             !              .AND. Last Melting
-! #e1 real     EqSn_1(knonv)                 ! Snow Energy, after Phase Change
-                                             !              .AND. Mass Redistr.
-! Snow/Ice (Mass) Budget
-! ~~~~~~~~~~~~~~~~~~~~~~
-! #m1 real     SIsubl(knonv)                 ! Snow Deposed Mass
-! #m1 real     SImelt(knonv)                 ! Snow Melted  Mass
-! #m1 real     SIrnof(knonv)                 ! Local Surficial Water + Run OFF
- 
- 
-C +--Internal Variables
-C +  ==================
- 
-      integer  ikl   ,isn                    !
-      integer  nh                            ! Non erodible Snow: up.lay.Index
-      integer  LayrOK                        ! 1 (0)  if In(Above) Snow Pack
-      integer  k_face                        ! 1 (0)  if Crystal(no) faceted
-      integer  LastOK                        ! 1 ==>  1! Snow Layer
-      integer  NOLayr                        ! 1     Layer  Update
-      integer  noSnow(knonv)                 ! Nb of Layers Updater
-      integer  kSlush                        ! Slush Switch
-      real     dTSnow                        ! Temperature                  [C]
-      real     EExdum(knonv)                 ! Energy in Excess when no Snow
-      real     OKmelt                        ! 1 (0)  if        (no) Melting
-      real     EnMelt                        ! Energy in excess, for Melting
-      real     SnHLat                        ! Energy consumed   in  Melting
-      real     AdEnrg,B_Enrg                 ! Additional Energy from  Vapor
-      real     dzVap0,dzVap1                 ! Vaporized Thickness          [m]
-      real     dzMelt(knonv)                 ! Melted    Thickness          [m]
-      real     rosDry                        ! Snow volumic Mass if no Water in
-      real     PorVol                        ! Pore volume
-      real     PClose                        ! Pore Hole Close OFF Switch
-      real     SGDiam                        !      Snow Grain Diameter
-      real     SGDmax                        ! Max. Snow Grain Diameter
-      real     rWater                        ! Retained Water           [kg/m2]
-      real     drrNEW                        ! New available Water      [kg/m2]
-      real     rdzNEW                        ! Snow          Mass       [kg/m2]
-      real     rdzsno                        ! Snow          Mass       [kg/m2]
-      real     EnFrez                        ! Energy Release    in  Freezing
-      real     WaFrez                        ! Water  consumed   in  Melting
-      real     RapdOK                        ! 1. ==> Snow melts rapidly
-      real     ThinOK                        ! 1. ==> Snow Layer is thin
-      real     dzepsi                        ! Minim. Snow Layer Thickness (!)
-      real     dz_Min                        ! Minim. Snow Layer Thickness
-      real     z_Melt                        ! Last (thin) Layer Melting
-      real     rusnew                        ! Surficial Water Thickness   [mm]
-      real     zWater                        ! Max Slush Water Thickness   [mm]
-      real     zSlush                        !     Slush Water Thickness   [mm]
-      real     ro_new                        ! New Snow/ice  Density    [kg/m3]
-      real     zc,zt                         ! Non erod.Snow Thickness[mm w.e.]
-      real     rusnSV0(knonv)
-      real     Tsave
- 
-C +--OUTPUT of SISVAT Trace Statistics (see assignation in PHY_SISVAT)
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      integer             isnnew,isinew,isnUpD,isnitr
- 
-! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! #wx integer             iSV_v1,jSV_v1,nSV_v1,kSV_v1,lSV_v1
-! #wx common/SISVAT_EV/   iSV_v1,jSV_v1,nSV_v1,kSV_v1,lSV_v1
- 
-C +--Energy and Mass Budget
-C +  ~~~~~~~~~~~~~~~~~~~~~~
-! #vm real     WqSn_0(knonv)                 ! Snow Water+Forcing  Initial
-! #vm real     WqSn_1(knonv)                 ! Snow Water+Forcing, Final
-! #vm logical         emopen                 ! IO   Switch
-! #vm common/Se_qSn_L/emopen                 !
-! #vm integer         no_err                 !
-! #vm common/Se_qSn_I/no_err                 !
-! #vm real     hourer,timeer                 !
-! #vm common/Se_qSn_R/timeer                 !
- 
-C +--Slush Diagnostic: IO
-C +  ~~~~~~~~~~~~~~~~~~~~
-! #vu logical         su_opn                 ! IO   Switch
-! #vu common/SI_qSn_L/su_opn                 !
- 
- 
-C +--DATA
-C +  ====
- 
-      data      dzepsi/0.0001/                ! Minim. Snow Layer Thickness (!)
-c #?? data      dz_Min/0.005/                 ! Minim. Snow Layer Thickness
-c ... Warning: Too high for Col de Porte: precludes 1st snow (layer) apparition
-      data      dz_Min/2.5e-3/                ! Minim. Snow Layer Thickness
-      data      SGDmax/0.003/                 ! Maxim. Snow Grain Diameter  [m]
-                                              ! (Rowe et al. 1995, JGR p.16268)
- 
-C +--Energy Budget (IN)
-C +  ==================
- 
-! #e1   DO ikl=1,knonv
-! #e1     EqSn_0(ikl) = 0.
-! #e1   END DO
-! #e1 DO   isn=nsno,1,-1
-! #e1   DO ikl=1,knonv
-! #e1     EqSn_0(ikl) = EqSn_0(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
-! #e1.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
-! #e1.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
-! #e1   END DO
-! #e1 END DO
- 
- 
-C +--Water  Budget (IN)
-C +  ==================
- 
-! #vm   DO ikl=1,knonv
-! #vm     WqSn_0(ikl) = drr_SV(ikl) * dt__SV
-! #vm.                 +rusnSV(ikl)
-! #vm   END DO
-! #vm DO   isn=nsno,1,-1
-! #vm   DO ikl=1,knonv
-! #vm     WqSn_0(ikl) = WqSn_0(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
-! #vm   END DO
-! #vm END DO
- 
- 
-C +--Snow Melt Budget
-C +  ================
- 
-! #m1   DO ikl=1,knonv
-! #m1     SImelt(ikl) = 0.
-! #m1     SIrnof(ikl) = rusnSV(ikl) + RnofSV(ikl) * dt__SV
-! #m1   END DO
- 
- 
-C +--Initialization
-C +  ==============
- 
-      DO ikl=1,knonv
-        noSnow(ikl)   = 0                   ! Nb of Layers Updater
-        ispiSV(ikl)   = 0                   ! Pore Hole Close OFF Index
-                                            ! (assumed to be the Top of
-                                            !  the surimposed Ice Layer)
-        zn5_SV(ikl)   = 0.
-        rusnSV0(ikl)  = 0.
-
-      END DO
- 
- 
-C +--Melting/Freezing Energy
-C +  =======================
- 
-C +...REMARK: Snow liquid Water Temperature assumed = TfSnow
-C +   ^^^^^^
-        DO ikl=1,knonv
-          EExdum(ikl) = drr_SV(ikl)     * C__Wat *(TaT_SV(ikl)-TfSnow)
-     .                                  * dt__SV
-          EExcsv(ikl) = EExdum(ikl)     *    min(1,isnoSV(ikl)) ! Snow exists
-          EExdum(ikl) = EExdum(ikl)     -          EExcsv(ikl)  !
-! #e1     EqSn_d(ikl) = EExcsv(ikl)                             !
-        END DO
- 
- 
-C +--Surficial Water Status
-C +  ----------------------
- 
-        DO ikl=1,knonv
-          SWS_SV(ikl) = max(zero,sign(unun,TfSnow
-     .                                    -TsisSV(ikl,isnoSV(ikl))))
-        END DO
- 
-      DO ikl=1,knonv
-
-      DO isn=min(nsno,isnoSV(ikl)+1),1,-1
-! EV          DO isn=nsno,1,-1
-C +--Energy, store Previous Content
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          dTSnow      = TsisSV(ikl,isn) -          TfSnow
-          EExcsv(ikl) = EExcsv(ikl)
-     .                + ro__SV(ikl,isn) * Cn_dSV * dTSnow
-     .                                           * dzsnSV(ikl,isn)
-          TsisSV(ikl,isn) =                        TfSnow
- 
-C +--Water,  store Previous Content
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          drr_SV(ikl) = drr_SV(ikl)
-     .                + ro__SV(ikl,isn)          * eta_SV(ikl,isn)
-     .                                           * dzsnSV(ikl,isn)
-     .                / dt__SV
-          ro__SV(ikl,isn) =
-     .                  ro__SV(ikl,isn) *(1.     - eta_SV(ikl,isn))
-          eta_SV(ikl,isn) =  0.
- 
- 
-C +--Melting  if EExcsv > 0
-C +  ======================
- 
-          EnMelt      =    max(zero,          EExcsv(ikl) )
- 
-C +--Energy Consumption
-C +  ^^^^^^^^^^^^^^^^^^
-          SnHLat      = ro__SV(ikl,isn) * Lf_H2O
-          dzMelt(ikl) = EnMelt      / max(SnHLat,    epsi )
-          noSnow(ikl) = noSnow(ikl)
-     .      + max(zero  ,sign(unun,dzMelt(ikl)                !
-     .                            -dzsnSV(ikl ,isn)))         ! 1 if full Melt
-     .       *min(1     , max(0 ,1+isnoSV(ikl)-isn))          ! 1 in the  Pack
-          dzMelt(ikl) =
-     .              min(dzsnSV(ikl, isn),dzMelt(ikl))
-          dzsnSV(ikl,isn) =
-     .                  dzsnSV(ikl,isn) -dzMelt(ikl)
-          zn5_SV(ikl) = zn5_SV(ikl)     +dzMelt(ikl)
-          EExcsv(ikl) = EExcsv(ikl)     -dzMelt(ikl)*SnHLat
-          wem_SV(ikl) = wem_SV(ikl)     -dzMelt(ikl)*ro__SV(ikl,isn)
- 
-C +--Water  Production
-C +  ^^^^^^^^^^^^^^^^^
-          drr_SV(ikl) = drr_SV(ikl)
-     .                + ro__SV(ikl,isn) * dzMelt(ikl)/dt__SV
-! #m1     SImelt(ikl) = SImelt(ikl)
-! #m1.                + ro__SV(ikl,isn) * dzMelt(ikl)
-          OKmelt      =max(zero,sign(unun,drr_SV(ikl)-epsi))
- 
-C +--Snow History
-C +  ^^^^^^^^^^^^
-          k_face          =       min(    istoSV(ikl,isn),istdSV(1)) ! = 1  if
-     .                           *max(0,2-istoSV(ikl,isn)          ) ! faceted
-          istoSV(ikl,isn) =                                          !
-     .        (1.-OKmelt) *               istoSV(ikl,isn)            !
-     .      +     OKmelt  *((1-k_face) *  istdSV(2)                  !
-     .                     +   k_face  *  istdSV(3)      )           !
- 
- 
-C +--Freezing if EExcsv < 0
-C +  ======================
- 
-          rdzsno      =          ro__SV(ikl,isn) * dzsnSV(ikl ,isn)
-          LayrOK      = min(   1, max(0          , isnoSV(ikl)-isn+1))
-          EnFrez      = min(zero,                  EExcsv(ikl))
-          WaFrez      =   -(     EnFrez          * LayrOK / Lf_H2O)
-          drrNEW      = max(zero,drr_SV(ikl)     - WaFrez / dt__SV)
-          WaFrez      =    (     drr_SV(ikl)     - drrNEW)* dt__SV
-          drr_SV(ikl) =          drrNEW
-          EExcsv(ikl) =          EExcsv(ikl)     + WaFrez * Lf_H2O
-          EnFrez      = min(zero,EExcsv(ikl))    * LayrOK
-          rdzNEW      = WaFrez + rdzsno
-          ro__SV(ikl,isn) =      rdzNEW /max(epsi, dzsnSV(ikl,isn))
-          TsisSV(ikl,isn) =      TfSnow
-     .                + EnFrez /(Cn_dSV *max(epsi, rdzNEW)        )
-          EExcsv(ikl) =          EExcsv(ikl)     - EnFrez
-          wer_SV(ikl) = WaFrez
-     .                + wer_SV(ikl)
- 
- 
-
-C +--Snow Water Content
-C +  ==================
- 
-C +--Percolation Velocity
-C +  ^^^^^^^^^^^^^^^^^^^^
-c #PW     SGDiam    = 1.6d-4
-c #PW.              + 1.1d-13 *(ro__SV(ikl,isn)*ro__SV(ikl,isn)
-c #PW.                         *ro__SV(ikl,isn)*ro__SV(ikl,isn))
- 
-C +--Pore   Volume [-]
-C +  ^^^^^^^^^^^^^^^^^
-          rosDry      =(1.     - eta_SV(ikl,isn))* ro__SV(ikl,isn) !
-          PorVol      = 1.     - rosDry          / ro_Ice          !
-          PorVol      =      max(PorVol          , zero  )         !
- 
-C +--Water  Retention
-C +  ^^^^^^^^^^^^^^^^
-          rWater      = ws0dSV * PorVol * ro_Wat * dzsnSV(ikl,isn)
-          drrNEW      = max(zero,drr_SV(ikl)     - rWater /dt__SV)
-          rWater      =    (     drr_SV(ikl)     - drrNEW)*dt__SV
-          drr_SV(ikl)     =      drrNEW
-          rdzNEW          =      rWater
-     .                         + rosDry          * dzsnSV(ikl,isn)
-          eta_SV(ikl,isn) =      rWater / max(epsi,rdzNEW)
-          ro__SV(ikl,isn) =      rdzNEW / max(epsi,dzsnSV(ikl,isn))
- 
-C +--Pore Hole Close OFF
-C +  ^^^^^^^^^^^^^^^^^^^
-          PClose = max(zero,
-     .                 sign(unun,ro__SV(ikl,isn)
-     .                          -roCdSV         ))
-          ispiSV(ikl) =          ispiSV(ikl)      *(1.-PClose)
-     .                +      max(ispiSV(ikl),isn)    * Pclose
-          PClose = max(0   ,                         ! Water under SuPer.Ice
-     .                 min (1   ,ispiSV(ikl)         ! contributes to
-     .                          -isn            ))   ! Surficial   Water
- 
-cXF
-          if(ro__SV(ikl,isn) >= roCdSV.and.ro__SV(ikl,1)<900)
-     .    PClose = min(0.50,PClose *
-     .    (1.-(ro_ice-ro__SV(ikl,isn))/(ro_ice-roCdSV)))
- 
-          PClose = max(0.,min(1.,PClose))
- 
-          if(isn==1) then
-               PClose = 1
-           ispiSV(ikl)= max(ispiSV(ikl),1)
-          endif
- 
-          if(drr_SV(ikl)    >0  .and.TsisSV(ikl,isn)>273.14) then
-           if((ro__SV(ikl,isn)>900.and.ro__SV(ikl,isn)<920).or.
-     .         ro__SV(ikl,isn)>950) then
-             dzsnSV(ikl,isn) = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/ro_ice
-             ro__SV(ikl,isn) = ro_ice
-             PClose          = 1
-           endif
-          endif
- 
-c         if (isn>1.and.isn<nsno     .and.
-c    .      ro__SV(ikl,isn-1)>900    .and.
-c    .      ro__SV(ikl,isn)  >roCdSV .and.
-c    .      ro__SV(ikl,isn)  <900    .and.
-c    .      TsisSV(ikl,isn)  >273.14 .and.
-c    .      TsisSV(ikl,isn+1)<273.15 .and.
-c    .      drr_SV(ikl)      >0)     then
-c          TsisSV(ikl,isn)=273.14
-c          PClose = 1
-c         endif
- 
-cXF
-          rusnSV(ikl) =          rusnSV(ikl)
-     .                +          drr_SV(ikl) *dt__SV * PClose
-          rusnSV0(ikl)=         rusnSV0(ikl)
-     .                +          drr_SV(ikl) *dt__SV * PClose
-          drr_SV(ikl) =          drr_SV(ikl)      *(1.-PClose)
- 
-        END DO
-
-      END DO
- 
- 
-C +--Remove Zero-Thickness Layers
-C +  ============================
- 
- 1000 CONTINUE
-           isnitr =          0
-      DO   ikl=1,knonv
-           isnUpD =          0
-           isinew =          0
-cXF
-
-
-        DO isn=1,min(nsno-1,isnoSV(ikl))
-           isnnew =(unun-max(zero  ,sign(unun,dzsnSV(ikl,isn)-dzepsi)))
-     .             *     max(0     , min(1   ,isnoSV(ikl) +1 -isn ))
-           isnUpD =      max(isnUpD,          isnnew)
-           isnitr =      max(isnitr,          isnnew)
-           isinew =      isn*isnUpD *max(0, 1-isinew)      ! LowerMost  0-Layer
-     .                                       +isinew       ! Index
-           dzsnSV(ikl,isn) =                  dzsnSV(ikl,isn+isnnew)
-           ro__SV(ikl,isn) =                  ro__SV(ikl,isn+isnnew)
-           TsisSV(ikl,isn) =                  TsisSV(ikl,isn+isnnew)
-           eta_SV(ikl,isn) =                  eta_SV(ikl,isn+isnnew)
-           G1snSV(ikl,isn) =                  G1snSV(ikl,isn+isnnew)
-           G2snSV(ikl,isn) =                  G2snSV(ikl,isn+isnnew)
-           dzsnSV(ikl,isn+isnnew) =(1-isnnew)*dzsnSV(ikl,isn+isnnew)
-           ro__SV(ikl,isn+isnnew) =(1-isnnew)*ro__SV(ikl,isn+isnnew)
-           eta_SV(ikl,isn+isnnew) =(1-isnnew)*eta_SV(ikl,isn+isnnew)
-           G1snSV(ikl,isn+isnnew) =(1-isnnew)*G1snSV(ikl,isn+isnnew)
-           G2snSV(ikl,isn+isnnew) =(1-isnnew)*G2snSV(ikl,isn+isnnew)
-
-        END DO
-           isnoSV(ikl)   =   isnoSV(ikl)-isnUpD            ! Nb of Snow   Layer
-           ispiSV(ikl)   =   ispiSV(ikl)                   ! Nb of SuperI Layer
-     .    -isnUpD *max(0,min(ispiSV(ikl)-isinew,1))        ! Update  if I=0
- 
-      END DO
-
-      IF  (isnitr.GT.0)                                       GO TO 1000
- 
- 
-C +--New upper Limit of the non erodible Snow (istoSV .GT. 1)
-C +  ========================================
- 
-      DO   ikl=1,knonv
-           nh =     0
-cXF
-        DO isn=  isnoSV(ikl),1,-1
-           nh =    nh + isn* min(istoSV(ikl,isn)-1,1)*max(0,1-nh)
-        ENDDO
-           zc =     0.
-           zt =     0.
-cXF
-        DO isn=1,isnoSV(ikl)
-           zc =    zc +          dzsnSV(ikl,isn) *ro__SV(ikl,isn)
-     .                     * max(0,min(1,nh+1-isn))
-           zt =    zt +          dzsnSV(ikl,isn) *ro__SV(ikl,isn)
-        END DO
-           zWE_SV(ikl) =                 zt
-           zWEcSV(ikl) = min(zWEcSV(ikl),zt)
-           zWEcSV(ikl) = max(zWEcSV(ikl),zc)
-      END DO
- 
- 
-C +--Energy Budget (OUT)
-C +  ===================
- 
-! #vm   DO ikl=1,knonv
-! #vm     EqSn01(ikl) =-EqSn_0(ikl)
-! #vm.                 -EExcsv(ikl)
-! #vm   END DO
-! #vm DO   isn=nsno,1,-1
-! #vm   DO ikl=1,knonv
-! #vm     EqSn01(ikl) = EqSn01(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
-! #vm.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
-! #vm.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
-! #vm   END DO
-! #vm END DO
- 
- 
-C +--"Negative Heat" from supercooled rain
-C +   ------------------------------------
- 
-      DO ikl=1,knonv
-          EExcsv(ikl) = EExcsv(ikl) + EExdum(ikl)
- 
- 
-C +--Surficial Water Run OFF
-C +  -----------------------
- 
-          rusnew      = rusnSV(ikl) * SWf_SV(ikl)
- 
-          if(isnoSV(ikl)<=1 .OR. opt_runoff_ac) rusnew = 0.
-          !if(ivgtSV(ikl)>=1) rusnew = 0.
- 
-c #EU                        rusnew = 0.
-c #AC               rusnew = 0.
-
-          RnofSV(ikl) = RnofSV(ikl)
-     .                +(rusnSV(ikl) - rusnew     ) / dt__SV
-          RuofSV(ikl,1) = RuofSV(ikl,1)
-     .                +(rusnSV(ikl) - rusnew     ) / dt__SV
-          RuofSV(ikl,4) = RuofSV(ikl,4)
-     .                +(rusnSV0(ikl)             ) / dt__SV
-          rusnSV(ikl) = rusnew
-      END DO
- 
- 
-C +--Percolation down the Continental Ice Pack
-C +  -----------------------------------------
- 
-        DO ikl=1,knonv
-          drr_SV(ikl) = drr_SV(ikl) + rusnSV(ikl)
-     .                     * (1-min(1,ispiSV(ikl)))/ dt__SV
-          rusnSV(ikl) = rusnSV(ikl)
-     .                     *    min(1,ispiSV(ikl))
-        END DO
- 
-cXF removal of too thin snowlayers if TT> 275.15 + bug if TT>> 273.15
-        DO ikl=1,knonv
-         zt=0.
-         DO isn=1,isnoSV(ikl)
-          zt=zt+dzsnSV(ikl,isn)
-         ENDDO
-         
-         if(zt<0.005+(TaT_SV(ikl)-TfSnow)/1000..and.
-     .      isnoSV(ikl)             >0         .and.
-     .      TaT_SV(ikl)             >=TfSnow   .and.
-     .      istoSV(ikl,isnoSV(ikl)) >1       ) then
-          DO isn=1,isnoSV(ikl)
-           drr_SV(ikl)    = drr_SV(ikl)
-     .                    + dzsnSV(ikl,isn)*ro__SV(ikl,isn) /dt__SV
-           dzsnSV(ikl,isn)= 0.
-
-          ENDDO
-          isnoSV(ikl)     = 0
-         endif
-        ENDDO
- 
-C +--Slush Formation (Activated. CAUTION: ADD RunOff Possibility before Activation)
-C +  ---------------  ^^^^^^^  ^^^
- 
-      IF (is_ok_slush) THEN 
-
-      DO  ikl=1,knonv
-       DO isn=1,isnoSV(ikl)
-          kSlush = min(1,max(0,isn+1-ispiSV(ikl)))        ! Slush Switch
- 
-C +--Available Additional Pore   Volume [-]
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          PorVol = 1. - ro__SV(ikl,isn)                    ! [--]
-     .           *(1. - eta_SV(ikl,isn))/ ro_Ice           !
-     .           -      eta_SV(ikl,isn)                    !
-     .                 *ro__SV(ikl,isn) / ro_Wat           !
-          PorVol =  max(PorVol          , zero  )          !
-          zWater =      dzsnSV(ikl,isn) * PorVol * 1000.   ! [mm] OR [kg/m2]
-     .           * (1. -SWS_SV(ikl)                        ! 0 <=> freezing
-     .                *(1 -min(1,iabs(isn-isnoSV(ikl)))))  ! 1 <=> isn=isnoSV
-          zSlush =  min(rusnSV(ikl)     , zWater)          ! [mm] OR [kg/m2]
-          ro_new      =(dzsnSV(ikl,isn) * ro__SV(ikl,isn)  !
-     .                 +zSlush                           ) !
-     .            / max(dzsnSV(ikl,isn) , epsi           ) !
-          if(ro_new<ro_Ice+20) then ! MAX 940kg/m3         !
-           rusnSV(ikl)  = rusnSV(ikl)          - zSlush    ! [mm] OR [kg/m2]
-           RuofSV(ikl,4)= max(0.,RuofSV(ikl,4) - zSlush/dt__SV)
-           eta_SV(ikl,isn) =(ro_new - ro__SV(ikl,isn)      !
-     .                     *(1.     - eta_SV(ikl,isn)))    !
-     .                / max (ro_new , epsi            )    !
-           ro__SV(ikl,isn) =      ro_new                   !
-          endif
-        END DO
-      END DO
-      END IF
- 
-C +--Impact of the Sublimation/Deposition on the Surface Mass Balance
-C +  ================================================================
- 
-      DO ikl=1,knonv
-         isn                     = isnoSV(ikl)
-          dzVap0                  =                   dt__SV
-     .  * HLs_sv(ikl)         * min(isn             , 1   )
-     .  /(Lx_H2O(ikl)         * max(ro__SV(ikl,isn) , epsi))
-          NOLayr=min(zero,sign(unun,dzsnSV(ikl,isn) + dzVap0))
-          dzVap1=min(zero,          dzsnSV(ikl,isn) + dzVap0)
- 
- 
-C +--Additional Energy
-C +  -----------------
- 
-c #VH     AdEnrg = dzVap0 * ro__SV(ikl,isnoSV(ikl))           ! Water   Vapor
-c #VH.            *C__Wat *(TsisSV(ikl,isnoSV(ikl)) -TfSnow)  ! Sensible Heat
- 
-c #aH     B_Enrg =(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
-c #aH.            -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
-c #aH.           /(1.          + dzVap0 /max(epsi,dzsnSV(ikl,isn)))
-c #aH     eta_SV(ikl,isn) =
-c #aH.           max(zero,unun +(B_Enrg
-c #aH.                         -(TsisSV(ikl,isn) -TfSnow)*Cn_dSV)
-c #aH.                          /Lf_H2O                          )
-c #aH     TsisSV(ikl,isn) =    ( B_Enrg
-c #aH.                         +(1.              -eta_SV(ikl,isn))
-c #aH.                          *Lf_H2O                          )
-c #aH.                         / Cn_dSV
-c #aH.                         + TfSnow
- 
-! #e1     STOP "PLEASE add Energy (#aH) from deposition/sublimation"
- 
- 
-C +--Update of the upper Snow layer Thickness
-C +  ----------------------------------------
- 
-          dzsnSV(ikl,isn) =
-     .           max(zero,  dzsnSV(ikl,isnoSV(ikl)) + dzVap0)
-          isnoSV(ikl)     = isnoSV(ikl)             + NOLayr
-          isn             = isnoSV(ikl)
-          dzsnSV(ikl,isn) = dzsnSV(ikl,isn) + dzVap1
-          wes_SV(ikl)     = ro__SV(ikl,isn) * dzVap0
-
-      END DO
- 
- 
-C +--Energy Budget (OUT)
-C +  ===================
- 
-! #vm   DO ikl=1,knonv
-! #vm     EqSn02(ikl) =-EqSn_0(ikl)
-! #vm.                 -EExcsv(ikl)
-! #vm   END DO
-! #vm DO   isn=nsno,1,-1
-! #vm   DO ikl=1,knonv
-! #vm     EqSn02(ikl) = EqSn01(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
-! #vm.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
-! #vm.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
-! #vm   END DO
-! #vm END DO
- 
- 
-C +--Snow/I Budget
-C +  -------------
- 
-! #m1   DO ikl=1,knonv
-! #m1     SIsubl(ikl) = dt__SV*HLs_sv(ikl)*min(isnoSV(ikl),1)
-! #m1.                        /Lx_H2O(ikl)
-! #m1     SIrnof(ikl) = rusnSV(ikl) + RnofSV(ikl) * dt__SV
-! #m1.                - SIrnof(ikl)
-! #m1   END DO
- 
- 
-C +--Anticipated Disappearance of a rapidly Melting too thin Last Snow Layer
-C +  =======================================================================
- 
-      DO ikl=1,knonv
-        LastOK = min(1   , max(0   ,iiceSV(ikl)-isnoSV(ikl)+2)
-     .                    *min(1   ,isnoSV(ikl)-iiceSV(ikl))
-     .                    +min(1   ,isnoSV(ikl))              )
-        RapdOK = max(zero,sign(unun,dzMelt(ikl)-epsi         ))
-        ThinOK = max(zero,sign(unun,dz_Min     -dzsnSV(ikl,1)))
-        z_Melt = LastOK     *RapdOK*ThinOK
-        noSnow(ikl)   = noSnow(ikl)   + z_Melt
-        z_Melt        =                 z_Melt *dzsnSV(ikl,1)
-        dzsnSV(ikl,1) = dzsnSV(ikl,1) - z_Melt
-        EExcsv(ikl)   = EExcsv(ikl)   - z_Melt *ro__SV(ikl,1)
-     .                                *(1.     -eta_SV(ikl,1))*Lf_H2O
- 
-C +--Water  Production
-C +  ^^^^^^^^^^^^^^^^^
-        drr_SV(ikl)   = drr_SV(ikl)
-     .                + ro__SV(ikl,1) * z_Melt /dt__SV
-      END DO
- 
- 
-C +--Update Nb of Layers
-C +  ===================
- 
-      DO ikl=1,knonv
-        isnoSV(ikl)   = isnoSV(ikl)
-     .     * min(1,iabs(isnoSV(ikl)-noSnow(ikl)))
-      END DO
- 
- 
-! Energy Budget (OUT)
-! ===================
- 
-! #e1   DO ikl=1,knonv
-! #e1     EqSn_1(ikl) = 0.
-! #e1   END DO
-! #e1 DO   isn=nsno,1,-1
-! #e1   DO ikl=1,knonv
-! #e1     EqSn_1(ikl) = EqSn_1(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
-! #e1.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
-! #e1.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
-! #e1   END DO
-! #e1 END DO
- 
- 
-C +--Water  Budget (OUT)
-C +  ===================
- 
-! #vm   DO ikl=1,knonv
-! #vm     WqSn_0(ikl) = WqSn_0(ikl)
-! #vm.                + HLs_sv(ikl)    * dt__SV
-! #vm.             *min(isnoSV(ikl),1) / Lx_H2O(ikl)
-! #vm     WqSn_1(ikl) = drr_SV(ikl)    * dt__SV
-! #vm.                + rusnSV(ikl)
-! #vm.                + RnofSV(ikl)    * dt__SV
-! #vm   END DO
-! #vm DO   isn=nsno,1,-1
-! #vm   DO ikl=1,knonv
-! #vm     WqSn_1(ikl) = WqSn_1(ikl)
-! #vm.                + ro__SV(ikl,isn)* dzsnSV(ikl,isn)
-! #vm   END DO
-! #vm END DO
- 
- 
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qsn.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qsn.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qsn.f90	(revision 5246)
@@ -0,0 +1,717 @@
+
+
+subroutine SISVAT_qSn &
+        ( &
+  ! #e1.                      EqSn_0,EqSn_1,EqSn_d
+  ! #m1.                     ,SIsubl,SImelt,SIrnof
+        )
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_qSn                           Fri 29-Jul-2011  MAR |
+  ! |   SubRoutine SISVAT_qSn updates  the Snow Water Content                |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  ! |                     X       Number of Mosaic Cell per grid box         |
+  ! |                                                                        |
+  ! |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |   ^^^^^                                                                |
+  ! |                                                                        |
+  ! |   INPUT:   TaT_SV   : SBL Top    Temperature                       [K] |
+  ! |   ^^^^^    dt__SV   : Time Step                                    [s] |
+  ! |                                                                        |
+  ! |   INPUT /  drr_SV   : Rain Intensity                         [kg/m2/s] |
+  ! |   OUTPUT:  dzsnSV   : Snow Layer Thickness                         [m] |
+  ! |   ^^^^^^   eta_SV   : Snow Water Content                       [m3/m3] |
+  ! |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
+  ! |            TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+  ! |                     & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+  ! |                                                                        |
+  ! |   OUTPUT:  SWS_SV   : Surficial Water Status                           |
+  ! |   ^^^^^^                                                               |
+  ! |            EExcsv   : Snow Energy in Excess, initial Forcing    [J/m2] |
+  ! |            EqSn_d   : Snow Energy in Excess, remaining          [J/m2] |
+  ! |            EqSn_0   : Snow Energy, before Phase Change          [J/m2] |
+  ! |            EqSn_1   : Snow Energy, after  Phase Change          [J/m2] |
+  ! |            SIsubl   : Snow sublimed/deposed Mass             [mm w.e.] |
+  ! |            SImelt   : Snow Melted           Mass             [mm w.e.] |
+  ! |            SIrnof   : Surficial Water + Run OFF Change       [mm w.e.] |
+  ! |                                                                        |
+  ! |   Internal Variables:                                                  |
+  ! |   ^^^^^^^^^^^^^^^^^^                                                   |
+  ! |                                                                        |
+  ! | # OPTIONS: #E0: IO for Verification: Energy       Budget               |
+  ! | # ^^^^^^^                                                              |
+  ! | #          #su: IO for Verification: Slush        Diagnostic           |
+  ! |                                                                        |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VAR0SV
+  use VARxSV
+  use VARySV
+  use surface_data, only: is_ok_slush,opt_runoff_ac
+
+
+  IMPLICIT NONE
+
+
+  ! Energy          Budget
+  ! ~~~~~~~~~~~~~~~~~~~~~~
+  ! #e1 real     EqSn_d(knonv)                 ! Energy in Excess, initial
+  ! #e1 real     EqSn_0(knonv)                 ! Snow Energy, befor Phase Change
+  ! #vm real     EqSn01(knonv)                 ! Snow Energy, after Phase Change
+  ! #vm real     EqSn02(knonv)                 ! Snow Energy, after Phase Change
+                                         ! !              .AND. Last Melting
+  ! #e1 real     EqSn_1(knonv)                 ! Snow Energy, after Phase Change
+                                         ! !              .AND. Mass Redistr.
+  ! Snow/Ice (Mass) Budget
+  ! ~~~~~~~~~~~~~~~~~~~~~~
+  ! #m1 real     SIsubl(knonv)                 ! Snow Deposed Mass
+  ! #m1 real     SImelt(knonv)                 ! Snow Melted  Mass
+  ! #m1 real     SIrnof(knonv)                 ! Local Surficial Water + Run OFF
+
+
+  ! +--Internal Variables
+  ! +  ==================
+
+  integer :: ikl   ,isn                    !
+  integer :: nh                            ! Non erodible Snow: up.lay.Index
+  integer :: LayrOK                        ! 1 (0)  if In(Above) Snow Pack
+  integer :: k_face                        ! 1 (0)  if Crystal(no) faceted
+  integer :: LastOK                        ! 1 ==>  1! Snow Layer
+  integer :: NOLayr                        ! 1     Layer  Update
+  integer :: noSnow(knonv)                 ! Nb of Layers Updater
+  integer :: kSlush                        ! Slush Switch
+  real :: dTSnow                        ! Temperature                  [C]
+  real :: EExdum(knonv)                 ! Energy in Excess when no Snow
+  real :: OKmelt                        ! 1 (0)  if        (no) Melting
+  real :: EnMelt                        ! Energy in excess, for Melting
+  real :: SnHLat                        ! Energy consumed   in  Melting
+  real :: AdEnrg,B_Enrg                 ! Additional Energy from  Vapor
+  real :: dzVap0,dzVap1                 ! Vaporized Thickness          [m]
+  real :: dzMelt(knonv)                 ! Melted    Thickness          [m]
+  real :: rosDry                        ! Snow volumic Mass if no Water in
+  real :: PorVol                        ! Pore volume
+  real :: PClose                        ! Pore Hole Close OFF Switch
+  real :: SGDiam                        !      Snow Grain Diameter
+  real :: SGDmax                        ! Max. Snow Grain Diameter
+  real :: rWater                        ! Retained Water           [kg/m2]
+  real :: drrNEW                        ! New available Water      [kg/m2]
+  real :: rdzNEW                        ! Snow          Mass       [kg/m2]
+  real :: rdzsno                        ! Snow          Mass       [kg/m2]
+  real :: EnFrez                        ! Energy Release    in  Freezing
+  real :: WaFrez                        ! Water  consumed   in  Melting
+  real :: RapdOK                        ! 1. ==> Snow melts rapidly
+  real :: ThinOK                        ! 1. ==> Snow Layer is thin
+  real :: dzepsi                        ! Minim. Snow Layer Thickness (!)
+  real :: dz_Min                        ! Minim. Snow Layer Thickness
+  real :: z_Melt                        ! Last (thin) Layer Melting
+  real :: rusnew                        ! Surficial Water Thickness   [mm]
+  real :: zWater                        ! Max Slush Water Thickness   [mm]
+  real :: zSlush                        !     Slush Water Thickness   [mm]
+  real :: ro_new                        ! New Snow/ice  Density    [kg/m3]
+  real :: zc,zt                         ! Non erod.Snow Thickness[mm w.e.]
+  real :: rusnSV0(knonv)
+  real :: Tsave
+
+  ! +--OUTPUT of SISVAT Trace Statistics (see assignation in PHY_SISVAT)
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  integer :: isnnew,isinew,isnUpD,isnitr
+
+  ! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  ! #wx integer             iSV_v1,jSV_v1,nSV_v1,kSV_v1,lSV_v1
+  ! #wx common/SISVAT_EV/   iSV_v1,jSV_v1,nSV_v1,kSV_v1,lSV_v1
+
+  ! +--Energy and Mass Budget
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~
+  ! #vm real     WqSn_0(knonv)                 ! Snow Water+Forcing  Initial
+  ! #vm real     WqSn_1(knonv)                 ! Snow Water+Forcing, Final
+  ! #vm logical         emopen                 ! IO   Switch
+  ! #vm common/Se_qSn_L/emopen                 !
+  ! #vm integer         no_err                 !
+  ! #vm common/Se_qSn_I/no_err                 !
+  ! #vm real     hourer,timeer                 !
+  ! #vm common/Se_qSn_R/timeer                 !
+
+  ! +--Slush Diagnostic: IO
+  ! +  ~~~~~~~~~~~~~~~~~~~~
+  ! #vu logical         su_opn                 ! IO   Switch
+  ! #vu common/SI_qSn_L/su_opn                 !
+
+
+  ! +--DATA
+  ! +  ====
+
+  data      dzepsi/0.0001/                ! Minim. Snow Layer Thickness (!)
+  ! #?? data      dz_Min/0.005/                 ! Minim. Snow Layer Thickness
+  ! ... Warning: Too high for Col de Porte: precludes 1st snow (layer) apparition
+  data      dz_Min/2.5e-3/                ! Minim. Snow Layer Thickness
+  data      SGDmax/0.003/                 ! Maxim. Snow Grain Diameter  [m]
+                                          ! ! (Rowe et al. 1995, JGR p.16268)
+
+  ! +--Energy Budget (IN)
+  ! +  ==================
+
+  ! #e1   DO ikl=1,knonv
+  ! #e1     EqSn_0(ikl) = 0.
+  ! #e1   END DO
+  ! #e1 DO   isn=nsno,1,-1
+  ! #e1   DO ikl=1,knonv
+  ! #e1     EqSn_0(ikl) = EqSn_0(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+  ! #e1.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+  ! #e1.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+  ! #e1   END DO
+  ! #e1 END DO
+
+
+  ! +--Water  Budget (IN)
+  ! +  ==================
+
+  ! #vm   DO ikl=1,knonv
+  ! #vm     WqSn_0(ikl) = drr_SV(ikl) * dt__SV
+  ! #vm.                 +rusnSV(ikl)
+  ! #vm   END DO
+  ! #vm DO   isn=nsno,1,-1
+  ! #vm   DO ikl=1,knonv
+  ! #vm     WqSn_0(ikl) = WqSn_0(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+  ! #vm   END DO
+  ! #vm END DO
+
+
+  ! +--Snow Melt Budget
+  ! +  ================
+
+  ! #m1   DO ikl=1,knonv
+  ! #m1     SImelt(ikl) = 0.
+  ! #m1     SIrnof(ikl) = rusnSV(ikl) + RnofSV(ikl) * dt__SV
+  ! #m1   END DO
+
+
+  ! +--Initialization
+  ! +  ==============
+
+  DO ikl=1,knonv
+    noSnow(ikl)   = 0                   ! Nb of Layers Updater
+    ispiSV(ikl)   = 0                   ! Pore Hole Close OFF Index
+                                        ! ! (assumed to be the Top of
+                                        ! !  the surimposed Ice Layer)
+    zn5_SV(ikl)   = 0.
+    rusnSV0(ikl)  = 0.
+
+  END DO
+
+
+  ! +--Melting/Freezing Energy
+  ! +  =======================
+
+  ! +...REMARK: Snow liquid Water Temperature assumed = TfSnow
+  ! +   ^^^^^^
+    DO ikl=1,knonv
+      EExdum(ikl) = drr_SV(ikl)     * C__Wat *(TaT_SV(ikl)-TfSnow) &
+            * dt__SV
+      EExcsv(ikl) = EExdum(ikl)     *    min(1,isnoSV(ikl)) ! Snow exists
+      EExdum(ikl) = EExdum(ikl)     -          EExcsv(ikl)  !
+  ! #e1     EqSn_d(ikl) = EExcsv(ikl)                             !
+    END DO
+
+
+  ! +--Surficial Water Status
+  ! +  ----------------------
+
+    DO ikl=1,knonv
+      SWS_SV(ikl) = max(zero,sign(unun,TfSnow &
+            -TsisSV(ikl,isnoSV(ikl))))
+    END DO
+
+  DO ikl=1,knonv
+
+  DO isn=min(nsno,isnoSV(ikl)+1),1,-1
+  ! EV          DO isn=nsno,1,-1
+  ! +--Energy, store Previous Content
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      dTSnow      = TsisSV(ikl,isn) -          TfSnow
+      EExcsv(ikl) = EExcsv(ikl) &
+            + ro__SV(ikl,isn) * Cn_dSV * dTSnow &
+            * dzsnSV(ikl,isn)
+      TsisSV(ikl,isn) =                        TfSnow
+
+  ! +--Water,  store Previous Content
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      drr_SV(ikl) = drr_SV(ikl) &
+            + ro__SV(ikl,isn)          * eta_SV(ikl,isn) &
+            * dzsnSV(ikl,isn) &
+            / dt__SV
+      ro__SV(ikl,isn) = &
+            ro__SV(ikl,isn) *(1.     - eta_SV(ikl,isn))
+      eta_SV(ikl,isn) =  0.
+
+
+  ! +--Melting  if EExcsv > 0
+  ! +  ======================
+
+      EnMelt      =    max(zero,          EExcsv(ikl) )
+
+  ! +--Energy Consumption
+  ! +  ^^^^^^^^^^^^^^^^^^
+      SnHLat      = ro__SV(ikl,isn) * Lf_H2O
+      dzMelt(ikl) = EnMelt      / max(SnHLat,    epsi )
+      noSnow(ikl) = noSnow(ikl) &
+            + max(zero  ,sign(unun,dzMelt(ikl) & !
+            -dzsnSV(ikl ,isn))) & ! 1 if full Melt
+            *min(1     , max(0 ,1+isnoSV(ikl)-isn))          ! 1 in the  Pack
+      dzMelt(ikl) = &
+            min(dzsnSV(ikl, isn),dzMelt(ikl))
+      dzsnSV(ikl,isn) = &
+            dzsnSV(ikl,isn) -dzMelt(ikl)
+      zn5_SV(ikl) = zn5_SV(ikl)     +dzMelt(ikl)
+      EExcsv(ikl) = EExcsv(ikl)     -dzMelt(ikl)*SnHLat
+      wem_SV(ikl) = wem_SV(ikl)     -dzMelt(ikl)*ro__SV(ikl,isn)
+
+  ! +--Water  Production
+  ! +  ^^^^^^^^^^^^^^^^^
+      drr_SV(ikl) = drr_SV(ikl) &
+            + ro__SV(ikl,isn) * dzMelt(ikl)/dt__SV
+  ! #m1     SImelt(ikl) = SImelt(ikl)
+  ! #m1.                + ro__SV(ikl,isn) * dzMelt(ikl)
+      OKmelt      =max(zero,sign(unun,drr_SV(ikl)-epsi))
+
+  ! +--Snow History
+  ! +  ^^^^^^^^^^^^
+      k_face          =       min(    istoSV(ikl,isn),istdSV(1)) & ! = 1  if
+            *max(0,2-istoSV(ikl,isn)          ) ! faceted
+      istoSV(ikl,isn) = & !
+            (1.-OKmelt) *               istoSV(ikl,isn) & !
+            +     OKmelt  *((1-k_face) *  istdSV(2) & !
+            +   k_face  *  istdSV(3)      )           !
+
+
+  ! +--Freezing if EExcsv < 0
+  ! +  ======================
+
+      rdzsno      =          ro__SV(ikl,isn) * dzsnSV(ikl ,isn)
+      LayrOK      = min(   1, max(0          , isnoSV(ikl)-isn+1))
+      EnFrez      = min(zero,                  EExcsv(ikl))
+      WaFrez      =   -(     EnFrez          * LayrOK / Lf_H2O)
+      drrNEW      = max(zero,drr_SV(ikl)     - WaFrez / dt__SV)
+      WaFrez      =    (     drr_SV(ikl)     - drrNEW)* dt__SV
+      drr_SV(ikl) =          drrNEW
+      EExcsv(ikl) =          EExcsv(ikl)     + WaFrez * Lf_H2O
+      EnFrez      = min(zero,EExcsv(ikl))    * LayrOK
+      rdzNEW      = WaFrez + rdzsno
+      ro__SV(ikl,isn) =      rdzNEW /max(epsi, dzsnSV(ikl,isn))
+      TsisSV(ikl,isn) =      TfSnow &
+            + EnFrez /(Cn_dSV *max(epsi, rdzNEW)        )
+      EExcsv(ikl) =          EExcsv(ikl)     - EnFrez
+      wer_SV(ikl) = WaFrez &
+            + wer_SV(ikl)
+
+
+
+  ! +--Snow Water Content
+  ! +  ==================
+
+  ! +--Percolation Velocity
+  ! +  ^^^^^^^^^^^^^^^^^^^^
+  ! #PW     SGDiam    = 1.6d-4
+  ! #PW.              + 1.1d-13 *(ro__SV(ikl,isn)*ro__SV(ikl,isn)
+  ! #PW.                         *ro__SV(ikl,isn)*ro__SV(ikl,isn))
+
+  ! +--Pore   Volume [-]
+  ! +  ^^^^^^^^^^^^^^^^^
+      rosDry      =(1.     - eta_SV(ikl,isn))* ro__SV(ikl,isn) !
+      PorVol      = 1.     - rosDry          / ro_Ice          !
+      PorVol      =      max(PorVol          , zero  )         !
+
+  ! +--Water  Retention
+  ! +  ^^^^^^^^^^^^^^^^
+      rWater      = ws0dSV * PorVol * ro_Wat * dzsnSV(ikl,isn)
+      drrNEW      = max(zero,drr_SV(ikl)     - rWater /dt__SV)
+      rWater      =    (     drr_SV(ikl)     - drrNEW)*dt__SV
+      drr_SV(ikl)     =      drrNEW
+      rdzNEW          =      rWater &
+            + rosDry          * dzsnSV(ikl,isn)
+      eta_SV(ikl,isn) =      rWater / max(epsi,rdzNEW)
+      ro__SV(ikl,isn) =      rdzNEW / max(epsi,dzsnSV(ikl,isn))
+
+  ! +--Pore Hole Close OFF
+  ! +  ^^^^^^^^^^^^^^^^^^^
+      PClose = max(zero, &
+            sign(unun,ro__SV(ikl,isn) &
+            -roCdSV         ))
+      ispiSV(ikl) =          ispiSV(ikl)      *(1.-PClose) &
+            +      max(ispiSV(ikl),isn)    * Pclose
+      PClose = max(0   , & ! Water under SuPer.Ice
+            min (1   ,ispiSV(ikl) & ! contributes to
+            -isn            ))   ! Surficial   Water
+
+  !XF
+      if(ro__SV(ikl,isn) >= roCdSV.and.ro__SV(ikl,1)<900) &
+            PClose = min(0.50,PClose * &
+            (1.-(ro_ice-ro__SV(ikl,isn))/(ro_ice-roCdSV)))
+
+      PClose = max(0.,min(1.,PClose))
+
+      if(isn==1) then
+           PClose = 1
+       ispiSV(ikl)= max(ispiSV(ikl),1)
+      endif
+
+      if(drr_SV(ikl)    >0  .and.TsisSV(ikl,isn)>273.14) then
+       if((ro__SV(ikl,isn)>900.and.ro__SV(ikl,isn)<920).or. &
+             ro__SV(ikl,isn)>950) then
+         dzsnSV(ikl,isn) = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/ro_ice
+         ro__SV(ikl,isn) = ro_ice
+         PClose          = 1
+       endif
+      endif
+
+      ! if (isn>1.and.isn<nsno     .and.
+  !    .      ro__SV(ikl,isn-1)>900    .and.
+  !    .      ro__SV(ikl,isn)  >roCdSV .and.
+  !    .      ro__SV(ikl,isn)  <900    .and.
+  !    .      TsisSV(ikl,isn)  >273.14 .and.
+  !    .      TsisSV(ikl,isn+1)<273.15 .and.
+  !    .      drr_SV(ikl)      >0)     then
+      !  TsisSV(ikl,isn)=273.14
+      !  PClose = 1
+      ! endif
+
+  !XF
+      rusnSV(ikl) =          rusnSV(ikl) &
+            +          drr_SV(ikl) *dt__SV * PClose
+      rusnSV0(ikl)=         rusnSV0(ikl) &
+            +          drr_SV(ikl) *dt__SV * PClose
+      drr_SV(ikl) =          drr_SV(ikl)      *(1.-PClose)
+
+    END DO
+
+  END DO
+
+
+  ! +--Remove Zero-Thickness Layers
+  ! +  ============================
+
+ 1000   CONTINUE
+       isnitr =          0
+  DO   ikl=1,knonv
+       isnUpD =          0
+       isinew =          0
+  !XF
+
+
+    DO isn=1,min(nsno-1,isnoSV(ikl))
+       isnnew =(unun-max(zero  ,sign(unun,dzsnSV(ikl,isn)-dzepsi))) &
+             *     max(0     , min(1   ,isnoSV(ikl) +1 -isn ))
+       isnUpD =      max(isnUpD,          isnnew)
+       isnitr =      max(isnitr,          isnnew)
+       isinew =      isn*isnUpD *max(0, 1-isinew) & ! LowerMost  0-Layer
+             +isinew       ! Index
+       dzsnSV(ikl,isn) =                  dzsnSV(ikl,isn+isnnew)
+       ro__SV(ikl,isn) =                  ro__SV(ikl,isn+isnnew)
+       TsisSV(ikl,isn) =                  TsisSV(ikl,isn+isnnew)
+       eta_SV(ikl,isn) =                  eta_SV(ikl,isn+isnnew)
+       G1snSV(ikl,isn) =                  G1snSV(ikl,isn+isnnew)
+       G2snSV(ikl,isn) =                  G2snSV(ikl,isn+isnnew)
+       dzsnSV(ikl,isn+isnnew) =(1-isnnew)*dzsnSV(ikl,isn+isnnew)
+       ro__SV(ikl,isn+isnnew) =(1-isnnew)*ro__SV(ikl,isn+isnnew)
+       eta_SV(ikl,isn+isnnew) =(1-isnnew)*eta_SV(ikl,isn+isnnew)
+       G1snSV(ikl,isn+isnnew) =(1-isnnew)*G1snSV(ikl,isn+isnnew)
+       G2snSV(ikl,isn+isnnew) =(1-isnnew)*G2snSV(ikl,isn+isnnew)
+
+    END DO
+       isnoSV(ikl)   =   isnoSV(ikl)-isnUpD            ! Nb of Snow   Layer
+       ispiSV(ikl)   =   ispiSV(ikl) & ! Nb of SuperI Layer
+             -isnUpD *max(0,min(ispiSV(ikl)-isinew,1))        ! Update  if I=0
+
+  END DO
+
+  IF  (isnitr.GT.0)                                       GO TO 1000
+
+
+  ! +--New upper Limit of the non erodible Snow (istoSV .GT. 1)
+  ! +  ========================================
+
+  DO   ikl=1,knonv
+       nh =     0
+  !XF
+    DO isn=  isnoSV(ikl),1,-1
+       nh =    nh + isn* min(istoSV(ikl,isn)-1,1)*max(0,1-nh)
+    ENDDO
+       zc =     0.
+       zt =     0.
+  !XF
+    DO isn=1,isnoSV(ikl)
+       zc =    zc +          dzsnSV(ikl,isn) *ro__SV(ikl,isn) &
+             * max(0,min(1,nh+1-isn))
+       zt =    zt +          dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+    END DO
+       zWE_SV(ikl) =                 zt
+       zWEcSV(ikl) = min(zWEcSV(ikl),zt)
+       zWEcSV(ikl) = max(zWEcSV(ikl),zc)
+  END DO
+
+
+  ! +--Energy Budget (OUT)
+  ! +  ===================
+
+  ! #vm   DO ikl=1,knonv
+  ! #vm     EqSn01(ikl) =-EqSn_0(ikl)
+  ! #vm.                 -EExcsv(ikl)
+  ! #vm   END DO
+  ! #vm DO   isn=nsno,1,-1
+  ! #vm   DO ikl=1,knonv
+  ! #vm     EqSn01(ikl) = EqSn01(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+  ! #vm.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+  ! #vm.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+  ! #vm   END DO
+  ! #vm END DO
+
+
+  ! +--"Negative Heat" from supercooled rain
+  ! +   ------------------------------------
+
+  DO ikl=1,knonv
+      EExcsv(ikl) = EExcsv(ikl) + EExdum(ikl)
+
+
+  ! +--Surficial Water Run OFF
+  ! +  -----------------------
+
+      rusnew      = rusnSV(ikl) * SWf_SV(ikl)
+
+      if(isnoSV(ikl)<=1 .OR. opt_runoff_ac) rusnew = 0.
+      ! !if(ivgtSV(ikl)>=1) rusnew = 0.
+
+  ! #EU                        rusnew = 0.
+  ! #AC               rusnew = 0.
+
+      RnofSV(ikl) = RnofSV(ikl) &
+            +(rusnSV(ikl) - rusnew     ) / dt__SV
+      RuofSV(ikl,1) = RuofSV(ikl,1) &
+            +(rusnSV(ikl) - rusnew     ) / dt__SV
+      RuofSV(ikl,4) = RuofSV(ikl,4) &
+            +(rusnSV0(ikl)             ) / dt__SV
+      rusnSV(ikl) = rusnew
+  END DO
+
+
+  ! +--Percolation down the Continental Ice Pack
+  ! +  -----------------------------------------
+
+    DO ikl=1,knonv
+      drr_SV(ikl) = drr_SV(ikl) + rusnSV(ikl) &
+            * (1-min(1,ispiSV(ikl)))/ dt__SV
+      rusnSV(ikl) = rusnSV(ikl) &
+            *    min(1,ispiSV(ikl))
+    END DO
+
+  !XF removal of too thin snowlayers if TT> 275.15 + bug if TT>> 273.15
+    DO ikl=1,knonv
+     zt=0.
+     DO isn=1,isnoSV(ikl)
+      zt=zt+dzsnSV(ikl,isn)
+     ENDDO
+
+     if(zt<0.005+(TaT_SV(ikl)-TfSnow)/1000..and. &
+           isnoSV(ikl)             >0         .and. &
+           TaT_SV(ikl)             >=TfSnow   .and. &
+           istoSV(ikl,isnoSV(ikl)) >1       ) then
+      DO isn=1,isnoSV(ikl)
+       drr_SV(ikl)    = drr_SV(ikl) &
+             + dzsnSV(ikl,isn)*ro__SV(ikl,isn) /dt__SV
+       dzsnSV(ikl,isn)= 0.
+
+      ENDDO
+      isnoSV(ikl)     = 0
+     endif
+    ENDDO
+
+  ! +--Slush Formation (Activated. CAUTION: ADD RunOff Possibility before Activation)
+  ! +  ---------------  ^^^^^^^  ^^^
+
+  IF (is_ok_slush) THEN
+
+  DO  ikl=1,knonv
+   DO isn=1,isnoSV(ikl)
+      kSlush = min(1,max(0,isn+1-ispiSV(ikl)))        ! Slush Switch
+
+  ! +--Available Additional Pore   Volume [-]
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      PorVol = 1. - ro__SV(ikl,isn) & ! [--]
+            *(1. - eta_SV(ikl,isn))/ ro_Ice & !
+            -      eta_SV(ikl,isn) & !
+            *ro__SV(ikl,isn) / ro_Wat           !
+      PorVol =  max(PorVol          , zero  )          !
+      zWater =      dzsnSV(ikl,isn) * PorVol * 1000. & ! [mm] OR [kg/m2]
+            * (1. -SWS_SV(ikl) & ! 0 <=> freezing
+            *(1 -min(1,iabs(isn-isnoSV(ikl)))))  ! 1 <=> isn=isnoSV
+      zSlush =  min(rusnSV(ikl)     , zWater)          ! [mm] OR [kg/m2]
+      ro_new      =(dzsnSV(ikl,isn) * ro__SV(ikl,isn) & !
+            +zSlush                           ) & !
+            / max(dzsnSV(ikl,isn) , epsi           ) !
+      if(ro_new<ro_Ice+20) then ! MAX 940kg/m3         !
+       rusnSV(ikl)  = rusnSV(ikl)          - zSlush    ! [mm] OR [kg/m2]
+       RuofSV(ikl,4)= max(0.,RuofSV(ikl,4) - zSlush/dt__SV)
+       eta_SV(ikl,isn) =(ro_new - ro__SV(ikl,isn) & !
+             *(1.     - eta_SV(ikl,isn))) & !
+             / max (ro_new , epsi            )    !
+       ro__SV(ikl,isn) =      ro_new                   !
+      endif
+    END DO
+  END DO
+  END IF
+
+  ! +--Impact of the Sublimation/Deposition on the Surface Mass Balance
+  ! +  ================================================================
+
+  DO ikl=1,knonv
+     isn                     = isnoSV(ikl)
+      dzVap0                  =                   dt__SV &
+            * HLs_sv(ikl)         * min(isn             , 1   ) &
+            /(Lx_H2O(ikl)         * max(ro__SV(ikl,isn) , epsi))
+      NOLayr=min(zero,sign(unun,dzsnSV(ikl,isn) + dzVap0))
+      dzVap1=min(zero,          dzsnSV(ikl,isn) + dzVap0)
+
+
+  ! +--Additional Energy
+  ! +  -----------------
+
+  ! #VH     AdEnrg = dzVap0 * ro__SV(ikl,isnoSV(ikl))           ! Water   Vapor
+  ! #VH.            *C__Wat *(TsisSV(ikl,isnoSV(ikl)) -TfSnow)  ! Sensible Heat
+
+  ! #aH     B_Enrg =(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+  ! #aH.            -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+  ! #aH.           /(1.          + dzVap0 /max(epsi,dzsnSV(ikl,isn)))
+  ! #aH     eta_SV(ikl,isn) =
+  ! #aH.           max(zero,unun +(B_Enrg
+  ! #aH.                         -(TsisSV(ikl,isn) -TfSnow)*Cn_dSV)
+  ! #aH.                          /Lf_H2O                          )
+  ! #aH     TsisSV(ikl,isn) =    ( B_Enrg
+  ! #aH.                         +(1.              -eta_SV(ikl,isn))
+  ! #aH.                          *Lf_H2O                          )
+  ! #aH.                         / Cn_dSV
+  ! #aH.                         + TfSnow
+
+  ! #e1     STOP "PLEASE add Energy (#aH) from deposition/sublimation"
+
+
+  ! +--Update of the upper Snow layer Thickness
+  ! +  ----------------------------------------
+
+      dzsnSV(ikl,isn) = &
+            max(zero,  dzsnSV(ikl,isnoSV(ikl)) + dzVap0)
+      isnoSV(ikl)     = isnoSV(ikl)             + NOLayr
+      isn             = isnoSV(ikl)
+      dzsnSV(ikl,isn) = dzsnSV(ikl,isn) + dzVap1
+      wes_SV(ikl)     = ro__SV(ikl,isn) * dzVap0
+
+  END DO
+
+
+  ! +--Energy Budget (OUT)
+  ! +  ===================
+
+  ! #vm   DO ikl=1,knonv
+  ! #vm     EqSn02(ikl) =-EqSn_0(ikl)
+  ! #vm.                 -EExcsv(ikl)
+  ! #vm   END DO
+  ! #vm DO   isn=nsno,1,-1
+  ! #vm   DO ikl=1,knonv
+  ! #vm     EqSn02(ikl) = EqSn01(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+  ! #vm.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+  ! #vm.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+  ! #vm   END DO
+  ! #vm END DO
+
+
+  ! +--Snow/I Budget
+  ! +  -------------
+
+  ! #m1   DO ikl=1,knonv
+  ! #m1     SIsubl(ikl) = dt__SV*HLs_sv(ikl)*min(isnoSV(ikl),1)
+  ! #m1.                        /Lx_H2O(ikl)
+  ! #m1     SIrnof(ikl) = rusnSV(ikl) + RnofSV(ikl) * dt__SV
+  ! #m1.                - SIrnof(ikl)
+  ! #m1   END DO
+
+
+  ! +--Anticipated Disappearance of a rapidly Melting too thin Last Snow Layer
+  ! +  =======================================================================
+
+  DO ikl=1,knonv
+    LastOK = min(1   , max(0   ,iiceSV(ikl)-isnoSV(ikl)+2) &
+          *min(1   ,isnoSV(ikl)-iiceSV(ikl)) &
+          +min(1   ,isnoSV(ikl))              )
+    RapdOK = max(zero,sign(unun,dzMelt(ikl)-epsi         ))
+    ThinOK = max(zero,sign(unun,dz_Min     -dzsnSV(ikl,1)))
+    z_Melt = LastOK     *RapdOK*ThinOK
+    noSnow(ikl)   = noSnow(ikl)   + z_Melt
+    z_Melt        =                 z_Melt *dzsnSV(ikl,1)
+    dzsnSV(ikl,1) = dzsnSV(ikl,1) - z_Melt
+    EExcsv(ikl)   = EExcsv(ikl)   - z_Melt *ro__SV(ikl,1) &
+          *(1.     -eta_SV(ikl,1))*Lf_H2O
+
+  ! +--Water  Production
+  ! +  ^^^^^^^^^^^^^^^^^
+    drr_SV(ikl)   = drr_SV(ikl) &
+          + ro__SV(ikl,1) * z_Melt /dt__SV
+  END DO
+
+
+  ! +--Update Nb of Layers
+  ! +  ===================
+
+  DO ikl=1,knonv
+    isnoSV(ikl)   = isnoSV(ikl) &
+          * min(1,iabs(isnoSV(ikl)-noSnow(ikl)))
+  END DO
+
+
+  ! Energy Budget (OUT)
+  ! ===================
+
+  ! #e1   DO ikl=1,knonv
+  ! #e1     EqSn_1(ikl) = 0.
+  ! #e1   END DO
+  ! #e1 DO   isn=nsno,1,-1
+  ! #e1   DO ikl=1,knonv
+  ! #e1     EqSn_1(ikl) = EqSn_1(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+  ! #e1.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+  ! #e1.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+  ! #e1   END DO
+  ! #e1 END DO
+
+
+  ! +--Water  Budget (OUT)
+  ! +  ===================
+
+  ! #vm   DO ikl=1,knonv
+  ! #vm     WqSn_0(ikl) = WqSn_0(ikl)
+  ! #vm.                + HLs_sv(ikl)    * dt__SV
+  ! #vm.             *min(isnoSV(ikl),1) / Lx_H2O(ikl)
+  ! #vm     WqSn_1(ikl) = drr_SV(ikl)    * dt__SV
+  ! #vm.                + rusnSV(ikl)
+  ! #vm.                + RnofSV(ikl)    * dt__SV
+  ! #vm   END DO
+  ! #vm DO   isn=nsno,1,-1
+  ! #vm   DO ikl=1,knonv
+  ! #vm     WqSn_1(ikl) = WqSn_1(ikl)
+  ! #vm.                + ro__SV(ikl,isn)* dzsnSV(ikl,isn)
+  ! #vm   END DO
+  ! #vm END DO
+
+
+  return
+end subroutine sisvat_qsn
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qso.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qso.F	(revision 5084)
+++ 	(revision )
@@ -1,710 +1,0 @@
- 
- 
-      subroutine SISVAT_qSo
-! #m0.                     (Wats_0,Wats_1,Wats_d)
- 
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_qSo                                 6-04-2001  MAR |
-C |   SubRoutine SISVAT_qSo computes the Soil      Water  Balance          |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  knonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-C |                     X       Number of Mosaic Cell per grid box         |
-C |                                                                        |
-C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
-C |   ^^^^^    isotSV   = 0,...,11:   Soil       Type                      |
-C |                       0:          Water, Solid or Liquid               |
-C |                                                                        |
-C |   INPUT:   rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
-C |   ^^^^^    drr_SV   : Rain   Intensity                       [kg/m2/s] |
-C |            LSdzsv   : Vertical   Discretization Factor             [-] |
-C |                     =    1. Soil                                       |
-C |                     = 1000. Ocean                                      |
-C |            dt__SV   : Time   Step                                  [s] |
-C |                                                                        |
-C |            Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
-C |            HLs_sv   : Latent Heat  Flux                         [W/m2] |
-C |                                                                        |
-C |   INPUT /  eta_SV   : Water      Content                       [m3/m3] |
-C |   OUTPUT:  Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
-C |   ^^^^^^                                                               |
-C |                                                                        |
-C |   OUTPUT:  RnofSV   : RunOFF Intensity                       [kg/m2/s] |
-C |   ^^^^^^   Wats_0   : Soil Water,  before Forcing                 [mm] |
-C |            Wats_1   : Soil Water,  after  Forcing                 [mm] |
-C |            Wats_d   : Soil Water          Forcing                 [mm] |
-C |                                                                        |
-C |   Internal Variables:                                                  |
-C |   ^^^^^^^^^^^^^^^^^^                                                   |
-C |            z_Bump   : (Partly)Bumpy Layers Height                  [m] |
-C |            z0Bump   :         Bumpy Layers Height                  [m] |
-C |            dzBump   :  Lowest Bumpy Layer:                         [m] |
-C |            etBump   :         Bumps Layer Averaged Humidity    [m3/m3] |
-C |            etaMid   : Layer Interface's Humidity               [m3/m3] |
-C |            eta__f   : Layer             Humidity  (Water Front)[m3/m3] |
-C |            Dhyd_f   : Soil  Hydraulic Diffusivity (Water Front) [m2/s] |
-C |            Dhydif   : Soil  Hydraulic Diffusivity               [m2/s] |
-C |            WgFlow   : Water         gravitational     Flux   [kg/m2/s] |
-C |            Wg_MAX   : Water MAXIMUM gravitational     Flux   [kg/m2/s] |
-C |            SatRat   : Water         Saturation        Flux   [kg/m2/s] |
-C |            WExces   : Water         Saturation Excess Flux   [kg/m2/s] |
-C |            Dhydtz   : Dhydif * dt / dz                             [m] |
-C |            FreeDr   : Free Drainage Fraction                       [-] |
-C |            Elem_A   : A Diagonal Coefficient                           |
-C |            Elem_C   : C Diagonal Coefficient                           |
-C |            Diag_A   : A Diagonal                                       |
-C |            Diag_B   : B Diagonal                                       |
-C |            Diag_C   : C Diagonal                                       |
-C |            Term_D   :   Independant Term                               |
-C |            Aux__P   : P Auxiliary Variable                             |
-C |            Aux__Q   : Q Auxiliary Variable                             |
-C |                                                                        |
-C |   TUNING PARAMETER:                                                    |
-C |   ^^^^^^^^^^^^^^^^                                                     |
-C |            z0soil   : Soil Surface averaged Bumps Height           [m] |
-C |                                                                        |
-C |   METHOD: NO   Skin Surface Humidity                                   |
-C |   ^^^^^^  Semi-Implicit Crank Nicholson Scheme                         |
-C |           (Partial) free Drainage, Water Bodies excepted (Lakes, Sea)  |
-C |                                                                        |
-
-C |                                                                        |
-C | # OPTIONS: #GF: Saturation Front                                       |
-C | # ^^^^^^^  #GH: Saturation Front allows Horton Runoff                  |
-C | #          #GA: Soil Humidity Geometric Average                        |
-C | #          #BP: Parameterization of Terrain Bumps                      |
-C |                                                                        |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
- 
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VAR0SV
-      use VARxSV
-      use VARySV
-
-     
-      IMPLICIT NONE
-
- 
-C +--OUTPUT
-C +  ------
- 
-! Water (Mass) Budget
-! ~~~~~~~~~~~~~~~~~~~
-! #m0 real      Wats_0(knonv)                 ! Soil Water,  before forcing
-! #m0 real      Wats_1(knonv)                 ! Soil Water,  after  forcing
-! #m0 real      Wats_d(knonv)                 ! Soil Water          forcing
- 
- 
-C +--Internal Variables
-C +  ==================
- 
-      integer   isl   ,jsl   ,ist   ,ikl      !
-      integer   ikm   ,ikp   ,ik0   ,ik1      !
-      integer   ist__s,ist__w                 ! Soil/Water Body Identifier
-c #BP real      z0soil                        ! Soil Surface Bumps Height  [m]
-c #BP real      z_Bump                        !(Partly)Bumpy Layers Height [m]
-c #BP real      z0Bump                        !        Bumpy Layers Height [m]
-c #BP real      dzBump                        ! Lowest Bumpy Layer:
- 
-c #BP real      etBump(knonv)                 ! Bumps Layer Averaged Humidity
-      real      etaMid                        ! Layer Interface's Humidity
-      real      Dhydif                        ! Hydraulic Diffusivity   [m2/s]
-      real      eta__f                        ! Water Front Soil Water Content
-      real      Khyd_f                        ! Water Front Hydraulic Conduct.
-      real      Khydav                        ! Hydraulic Conductivity   [m/s]
-      real      WgFlow                        ! Water gravitat. Flux [kg/m2/s]
-      real      Wg_MAX                        ! Water MAX.grav. Flux [kg/m2/s]
-      real      SatRat                        ! Saturation      Flux [kg/m2/s]
-      real      WExces                        ! Saturat. Excess Flux [kg/m2/s]
-      real      SoRnOF(knonv)                 ! Soil     Run    OFF
-      real      Dhydtz(knonv,-nsol:0)         ! Dhydif * dt / dz           [m]
-      real      Elem_A,Elem_B,Elem_C          !   Diagonal Coefficients
-      real      Diag_A(knonv,-nsol:0)         ! A Diagonal
-      real      Diag_B(knonv,-nsol:0)         ! B Diagonal
-      real      Diag_C(knonv,-nsol:0)         ! C Diagonal
-      real      Term_D(knonv,-nsol:0)         !   Independant Term
-      real      Aux__P(knonv,-nsol:0)         ! P Auxiliary Variable
-      real      Aux__Q(knonv,-nsol:0)         ! Q Auxiliary Variable
-      real      etaaux(knonv,-nsol:-nsol+1)   ! Soil Water Content     [m3/m3]
-      real      FreeDr                        ! Free Drainage Fraction (actual)
-      real      FreeD0                        ! Free Drainage Fraction (1=Full)
-      real      aKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: a * dt
-      real      bKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: b * dt
- 
-! Water (Mass) Budget
-! ~~~~~~~~~~~~~~~~~~~
-c #mw logical         mwopen                  ! IO   Switch
-c #mw common/Sm_qSo_L/mwopen                  !
-c #mw real     hourwr,timewr                  !
-c #mw common/Sm_qSo_R/timewr                  !
-c #mw real            Evapor(knonv)           !
- 
- 
-C +--Internal DATA
-C +  =============
- 
-c #BP data      z0soil/0.020/                 ! Soil Surface Bumps Height  [m]
-      data      FreeD0/1.000/                 ! Free Drainage Fraction (1=Full)
- 
-      aKdtSV3=aKdtSV2*dt__SV
-      bKdtSV3=bKdtSV2*dt__SV
- 
-! Water  Budget (IN)
-! ==================
- 
-! #m0   DO ikl=1,knonv
-! #m0     Wats_0(ikl) = 0.                    ! OLD RunOFF Contrib.
-! #m0     Wats_d(ikl) = drr_SV(ikl)           ! Water Surface Forc.
-! #m0   END DO
- 
-! #m0      isl= -nsol
-! #m0   DO ikl=1,knonv
-! #m0     Wats_0(ikl) = Wats_0(ikl)
-! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
-! #m0.                + eta_SV(ikl,isl+1) *dz_8SV(isl) ) * LSdzsv(ikl)
-! #m0   END DO
- 
-! #m0 DO   isl= -nsol+1,-1
-! #m0   DO ikl=1,knonv
-! #m0     Wats_0(ikl) = Wats_0(ikl)
-! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz34SV(isl)
-! #m0.                +(eta_SV(ikl,isl-1)
-! #m0.                 +eta_SV(ikl,isl+1))*dz_8SV(isl) ) * LSdzsv(ikl)
-! #m0   END DO
-! #m0 END DO
- 
-! #m0      isl=  0
-! #m0   DO ikl=1,knonv
-! #m0     Wats_0(ikl) = Wats_0(ikl)
-! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
-! #m0.                + eta_SV(ikl,isl-1) *dz_8SV(isl) ) * LSdzsv(ikl)
-! #m0   END DO
- 
- 
-C +--Gravitational Flow
-C +  ==================
- 
-C +...    METHOD: Surface Water Flux saturates successively the soil layers
-C +       ^^^^^^  from up to below, but is limited by infiltration capacity.
-C +               Hydraulic Conductivity again contributes after this step,
-C +               not redundantly because of a constant (saturated) profile.
- 
-C +--Flux  Limitor
-C +  ^^^^^^^^^^^^^
-           isl=0
-        DO ikl=1,knonv
-          ist    = isotSV(ikl)                     ! Soil Type
-          ist__s = min(ist, 1)                     ! 1 => Soil
-          ist__w = 1 - ist__s                      ! 1 => Water Body
-          Dhydif = s1__SV(ist)
-     .               *max(epsi,eta_SV(ikl,isl))    ! Hydraulic Diffusivity
-     .                      **(bCHdSV(ist)+2.)     ! DR97, Eqn.(3.36)
-          Dhydif = ist__s    * Dhydif              !
-     .           + ist__w    * vK_dSV              ! Water Bodies
-C +
-          Khydav = ist__s    * Ks_dSV(ist)         ! DR97  Assumption
-     .           + ist__w    * vK_dSV              ! Water Bodies
-C +
-          Wg_MAX = ro_Wat     *Dhydif              ! MAXimum  Infiltration
-     .           *(etadSV(ist)-eta_SV(ikl,isl))    !          Rate
-     .           /(dzAvSV(isl)*LSdzsv(ikl)    )    !
-     .          +  ro_Wat     *Khydav              !
- 
-C +--Surface Horton RunOFF
-C +  ^^^^^^^^^^^^^^^^^^^^^
-          SoRnOF(ikl) =
-     .                max(zero,drr_SV(ikl)-Wg_MAX)
-        RuofSV(ikl,1) = RuofSV(ikl,1) +    SoRnOF(ikl)
-          drr_SV(ikl) =        drr_SV(ikl)-SoRnOF(ikl)
-        RuofSV(ikl,2) = RuofSV(ikl,2) +max(0.,drr_SV(ikl))
-        END DO
- 
-c #GF DO   isl=0,-nsol,-1
-c #GF   DO ikl=1,knonv
-c #GF     ist    = isotSV(ikl)                     ! Soil Type
-c #GF     ist__s = min(ist, 1)                     ! 1 => Soil
-c #GF     ist__w = 1 - ist__s                      ! 1 => Water Body
- 
-C +--Water Diffusion
-C +  ^^^^^^^^^^^^^^^
-c #GF     Dhydif = s1__SV(ist)
-c #GF.               *max(epsi,eta_SV(ikl,isl))    ! Hydraulic Diffusivity
-c #GF.                      **(bCHdSV(ist)+2.)     ! DR97, Eqn.(3.36)
-c #GF     Dhydif = ist__s    * Dhydif              !
-c #GF.           + ist__w    * vK_dSV              ! Water Bodies
- 
-C +--Water Conduction (without Horton Runoff)
-C +  ^^^^^^^^^^^^^^^^
-c #GF     Khyd_f =             Ks_dSV(ist)
-C +...    Uses saturated K ==> Horton Runoff ~0    !
- 
-C +--Water Conduction (with    Horton Runoff)
-C +  ^^^^^^^^^^^^^^^^
-c #GH     ik0    = nkhy       *eta_SV(ikl,isl)
-c #GH.                        /etadSV(ist)
-c #GH     eta__f         =            1.
-c #GH.   -aKdtSV3(ist,ik0)/(2. *dzAvSV(isl)
-c #GH.                        *LSdzsv(ikl))
-c #GH     eta__f         = max(eps_21,eta__f)
-c #GH     eta__f         = min(etadSV(ist),
-c #GH.                         eta_SV(ikl,isl) +
-c #GH.   (aKdtSV3(ist,ik0)     *eta_SV(ikl,isl)
-c #GH.   +bKdtSV3(ist,ik0))   /(dzAvSV(isl)
-c #GH.                        *LSdzsv(ikl))
-c #GH.                       / eta__f          )
-c #GH     eta__f         = .5*(eta_SV(ikl,isl)
-c #GH.                        +eta__f)
- 
-c #gh     eta__f         =     eta_SV(ikl,isl)
- 
-c #GH     ik0    = nkhy       *eta__f
-c #GH.                        /etadSV(ist)
-c #GH     Khyd_f =
-c #GH.   (aKdtSV3(ist,ik0)     *eta__f
-c #GH.   +bKdtSV3(ist,ik0))    /dt__SV
- 
-c #GF     Khydav = ist__s    * Khyd_f              ! DR97  Assumption
-c #GF.           + ist__w    * vK_dSV              ! Water Bodies
- 
-C +--Gravitational Flow
-C +  ^^^^^^^^^^^^^^^^^^
-c #GF     Wg_MAX =                                 ! MAXimum  Infiltration
-c #GF.             ro_Wat     *Dhydif              !          Rate
-c #GF.           *(etadSV(ist)-eta_SV(ikl,isl))    !
-c #GF.           /(dzAvSV(isl)*LSdzsv(ikl)    )    !
-c #GF.          +  ro_Wat     *Khydav              !
-c #GF   END DO
-c #GF END DO
-c #GF   DO ikl=1,knonv
-c #GF     SoRnOF(ikl)     =    SoRnOF(ikl)         ! RunOFF Intensity
-c #GF.                    +    drr_SV(ikl)         ! [kg/m2/s]
-C +!!!    Inclure la possibilite de creer une mare sur un bedrock impermeable
-c #GF     drr_SV(ikl) = 0.
-c #GF   END DO
- 
- 
-C +--Temperature Correction due to a changed Soil Energy Content
-C +  ===========================================================
- 
-C +!!!    Mettre en oeuvre le couplage humidit?-?nergie
- 
- 
-C +--Full Resolution of the Richard's Equation
-C +  =========================================
- 
-C +...    METHOD: Water content evolution results from water fluxes
-C +       ^^^^^^  at the layer boundaries
-C +               Conductivity is approximated by a piecewise linear profile.
-C +               Semi-Implicit Crank-Nicholson scheme is used.
-C +              (Bruen, 1997, Sensitivity of hydrological processes
-C +                            at the land-atmosphere interface.
-C +                            Proc. Royal Irish Academy,  IGBP symposium
-C +                            on global change and the Irish Environment.
-C +                            Publ.: Maynooth)
- 
-C +                      - - - - - - - -   isl+1/2   - -  ^
-C +                                                       |
-C +   eta_SV(isl)        ---------------   isl     -----  +--dz_dSV(isl)  ^
-C +                                                       |               |
-C +   Dhydtz(isl) etaMid - - - - - - - -   isl-1/2   - -  v  dzmiSV(isl)--+
-C +                                                                       |
-C +   eta_SV(isl-1)      ---------------   isl-1   -----                  v
- 
-C +--Transfert       Coefficients
-C +  ----------------------------
- 
-      DO   isl=-nsol+1,0
-        DO ikl=1,knonv
-          ist    =      isotSV(ikl)                       ! Soil Type
-          ist__s =      min(ist, 1)                       ! 1 => Soil
-          ist__w =      1 - ist__s                        ! 1 => Water Body
-          etaMid =     (dz_dSV(isl)  *eta_SV(ikl,isl-1)   ! eta at layers
-     .                 +dz_dSV(isl-1)*eta_SV(ikl,isl)  )  !     interface
-     .           /(2.0* dzmiSV(isl))                      ! LSdzsv implicit !
-c #GA     etaMid = sqrt(dz_dSV(isl)  *eta_SV(ikl,isl-1)   ! Idem, geometric
-c #GA.                 *dz_dSV(isl-1)*eta_SV(ikl,isl)  )  !       average
-c #GA.           /(2.0* dzmiSV(isl))                      ! (Vauclin&al.1979)
-          Dhydif          =    s1__SV(ist)                ! Hydraul.Diffusi.
-     .  *(etaMid         **(   bCHdSV(ist)+2.))           ! DR97, Eqn.(3.36)
-          Dhydtz(ikl,isl) =    Dhydif*dt__SV              !
-     .                              /(dzmiSV(isl)         !
-     .                               *LSdzsv(ikl))        !
-          Dhydtz(ikl,isl) =    Dhydtz(ikl,isl) * ist__s   ! Soil
-     .        +0.5*dzmiSV(isl)*LSdzsv(ikl)     * ist__w   ! Water bodies
- 
-        END DO
-      END DO
-           isl=-nsol
-        DO ikl=1,knonv
-          Dhydtz(ikl,isl) =    0.0                        !
-        END DO
- 
- 
-C +--Tridiagonal Elimination: Set Up
-C +  -------------------------------
- 
-C +--Soil/Snow Interior
-C +  ^^^^^^^^^^^^^^^^^^
- 
-      DO   isl=0,-nsol,-1
-        DO ikl=1,knonv
-         ist             = isotSV(ikl)
-         eta_SV(ikl,isl) = max(epsi,           eta_SV(ikl,isl))
-        END DO
-      END DO
- 
-      DO   isl=-nsol,-nsol+1
-        DO ikl=1,knonv
-          etaaux(ikl,isl) =  eta_SV(ikl,isl)
-        END DO
-      END DO
- 
-      DO   isl=-nsol+1,-1
-        DO ikl=1,knonv
-          ist      =         isotSV(ikl)
-          ikm      = nkhy *  eta_SV(ikl,isl-1) / etadSV(ist)
-          ik0      = nkhy *  eta_SV(ikl,isl)   / etadSV(ist)
-          ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
- 
-          if(ikm<0.or.ik0<0.or.ikp<0)then
-           print *,"CRASH1 in sisvat_qso.f on pixel (i,j,n)",
-     .     ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
-           print *,"decrease your time step or increase ntphys "//
-     .             "and ntdiff in time_steps.f"
-           stop
-          endif
- 
- 
-          Elem_A   =         Dhydtz(ikl,isl)
-     .                    -  aKdtSV3(ist,ikm)* dziiSV(isl)  *LSdzsv(ikl)
-          Elem_B   =      - (Dhydtz(ikl,isl)
-     .                      +Dhydtz(ikl,isl+1)
-     .                      -aKdtSV3(ist,ik0)*(dziiSV(isl+1)
-     .                                       -dzi_SV(isl) )*LSdzsv(ikl))
-          Elem_C   =         Dhydtz(ikl,isl+1)
-     .                    +  aKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
-          Diag_A(ikl,isl) =  dz_8SV(isl)        *LSdzsv(ikl)
-     .                      -Implic            * Elem_A
-          Diag_B(ikl,isl) =  dz34SV(isl)        *LSdzsv(ikl)
-     .                      -Implic            * Elem_B
-          Diag_C(ikl,isl) =  dz_8SV(isl)        *LSdzsv(ikl)
-     .                      -Implic            * Elem_C
- 
-          Term_D(ikl,isl) = (dz_8SV(isl) *LSdzsv(ikl)
-     .                      +Explic      *Elem_A     )*eta_SV(ikl,isl-1)
-     .                    + (dz34SV(isl) *LSdzsv(ikl)
-     .                      +Explic      *Elem_B     )*eta_SV(ikl,isl)
-     .                    + (dz_8SV(isl) *LSdzsv(ikl)
-     .                      +Explic      *Elem_C     )*eta_SV(ikl,isl+1)
-     .                    + (bKdtSV3(ist,ikp)* dzi_SV(isl+1)
-     .                      +bKdtSV3(ist,ik0)*(dziiSV(isl+1)
-     .                                       -dzi_SV(isl)  )
-     .                      -bKdtSV3(ist,ikm)* dziiSV(isl)   )
-     .                                      * LSdzsv(ikl)
-        END DO
-      END DO
- 
-           isl=-nsol
-        DO ikl=1,knonv
-          ist      =         isotSV(ikl)
-c #       FreeDr   =         FreeD0            *  min(ist,1)
-          FreeDr   =         iWaFSV(ikl)       *  min(ist,1)
-          ik0      = nkhy *  eta_SV(ikl,isl  ) / etadSV(ist)
-          ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
- 
-          if(ik0<0.or.ikp<0)then
-           print *,"CRASH2 in sisvat_qso.f on pixel (i,j,n)",
-     .     ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
-           print *,"decrease your time step or increase ntphys "//
-     .             "and ntdiff in time_steps.f"
-           stop
-          endif
- 
-          Elem_A   =         0.
-          Elem_B   =      - (Dhydtz(ikl,isl+1)
-     .                      -aKdtSV3(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl)
-     .                                       -FreeDr                  ))
-          Elem_C   =         Dhydtz(ikl,isl+1)
-     .                    +  aKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
-          Diag_A(ikl,isl) =  0.
-          Diag_B(ikl,isl) =  dz78SV(isl) *LSdzsv(ikl)
-     .                      -Implic      *Elem_B
-          Diag_C(ikl,isl) =  dz_8SV(isl) *LSdzsv(ikl)
-     .                      -Implic      *Elem_C
- 
-          Term_D(ikl,isl) = (dz78SV(isl) *LSdzsv(ikl)
-     .                      +Explic      *Elem_B     )*eta_SV(ikl,isl)
-     .                    + (dz_8SV(isl) *LSdzsv(ikl)
-     .                      +Explic      *Elem_C     )*eta_SV(ikl,isl+1)
-     .                    + (bKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
-     .                      +bKdtSV3(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl)
-     .                                       -FreeDr                  ))
-        END DO
- 
-           isl=0
-        DO ikl=1,knonv
-          ist      =         isotSV(ikl)
-          ikm      = nkhy *  eta_SV(ikl,isl-1) / etadSV(ist)
-          ik0      = nkhy *  eta_SV(ikl,isl)   / etadSV(ist)
-          Elem_A   =         Dhydtz(ikl,isl)
-     .                    -  aKdtSV3(ist,ikm)* dziiSV(isl)*LSdzsv(ikl)
-          Elem_B   =      - (Dhydtz(ikl,isl)
-     .                      +aKdtSV3(ist,ik0)* dzi_SV(isl)*LSdzsv(ikl))
-          Elem_C   =         0.
-          Diag_A(ikl,isl) =  dz_8SV(isl) *LSdzsv(ikl)
-     .                    -  Implic      *Elem_A
-          Diag_B(ikl,isl) =  dz78SV(isl) *LSdzsv(ikl)
-     .                    -  Implic      *Elem_B
-          Diag_C(ikl,isl) =  0.
-C +
-          Term_D(ikl,isl) = (dz_8SV(isl) *LSdzsv(ikl)
-     .                      +Explic      *Elem_A     )*eta_SV(ikl,isl-1)
-     .                    + (dz78SV(isl) *LSdzsv(ikl)
-     .                      +Explic      *Elem_B     )*eta_SV(ikl,isl)
-     .                    - (bKdtSV3(ist,ik0)* dzi_SV(isl)
-     .                      +bKdtSV3(ist,ikm)* dziiSV(isl))*LSdzsv(ikl)
-     .            + dt__SV *(HLs_sv(ikl)    *     (1-min(1,isnoSV(ikl)))
-     .                     / (ro_Wat *dz_dSV(0) * Lx_H2O(ikl))
-cXF bug 17/05/2017
-     .                      +drr_SV(ikl))/ro_Wat
-        END DO
- 
-        DO ikl=1,knonv
-         drr_SV(ikl)=0. ! drr is included in the 1st soil layer
-        ENDDO
- 
-C +
-C +
-C +--Tridiagonal Elimination
-C +  =======================
-C +
-C +--Forward  Sweep
-C +  ^^^^^^^^^^^^^^
-        DO ikl=  1,knonv
-          Aux__P(ikl,-nsol) = Diag_B(ikl,-nsol)
-          Aux__Q(ikl,-nsol) =-Diag_C(ikl,-nsol)/Aux__P(ikl,-nsol)
-        END DO
-C +
-      DO   isl=-nsol+1,0
-        DO ikl=      1,knonv
-          Aux__P(ikl,isl)   = Diag_A(ikl,isl)  *Aux__Q(ikl,isl-1)
-     .                       +Diag_B(ikl,isl)
-          Aux__Q(ikl,isl)   =-Diag_C(ikl,isl)  /Aux__P(ikl,isl)
-        END DO
-      END DO
-C +
-        DO ikl=      1,knonv
-          eta_SV(ikl,-nsol) = Term_D(ikl,-nsol)/Aux__P(ikl,-nsol)
-        END DO
-C +
-      DO   isl=-nsol+1,0
-        DO ikl=      1,knonv
-          eta_SV(ikl,isl)   =(Term_D(ikl,isl)
-     .                       -Diag_A(ikl,isl)  *eta_SV(ikl,isl-1))
-     .                                         /Aux__P(ikl,isl)
-        END DO
-      END DO
- 
-C +--Backward Sweep
-C +  ^^^^^^^^^^^^^^
-      DO   isl=-1,-nsol,-1
-        DO ikl= 1,knonv
-          eta_SV(ikl,isl)   = Aux__Q(ikl,isl)  *eta_SV(ikl,isl+1)
-     .                                         +eta_SV(ikl,isl)
-        END DO
-      END DO
- 
- 
-C +--Horton RunOFF Intensity
-C +  =======================
- 
-      DO   isl=0,-nsol,-1
-        DO ikl=1,knonv
-          ist    =   isotSV(ikl)                   ! Soil Type
-          SatRat =  (eta_SV(ikl,isl)-etadSV(ist))  ! OverSaturation Rate
-     .              *ro_Wat         *dzAvSV(isl)   !
-     .                              *LSdzsv(ikl)   !
-     .                              /dt__SV        !
-          SoRnOF(ikl)     =          SoRnOF(ikl)   !
-     .                    + max(zero,SatRat)       !
-          RuofSV(ikl,3)   = RuofSV(ikl,3) +
-     .                    + max(zero,SatRat)
-          eta_SV(ikl,isl) = max(epsi               !
-c #ED.                         +etamSV(isotSV(ikl))!
-     .                         ,eta_SV(ikl,isl))   !
-          eta_SV(ikl,isl) = min(eta_SV(ikl,isl)    !
-     .                         ,etadSV(ist)    )   !
-        END DO
-      END DO
- 
-C +--IO, for Verification
-C +  ~~~~~~~~~~~~~~~~~~~~
-c #WR     write(6,6010)
- 6010     format(/,1x)
-      DO   isl= 0,-nsol,-1
-        DO ikl= 1,knonv
-          ist      =          isotSV(ikl)
-          ikp      = nkhy  *  eta_SV(ikl,isl)  /etadSV(ist)
-          Khydsv(ikl,isl)   =(aKdtSV3(ist,ikp)  *eta_SV(ikl,isl)
-     .                       +bKdtSV3(ist,ikp)) *2.0/dt__SV
-c #WR     write(6,6011) ikl,isl,eta_SV(ikl,isl)*1.e3,
-c #WR.                  ikp,    aKdtSV3(ist,ikp),bKdtSV3(ist,ikp),
-c #WR.                          Khydsv(ikl,isl)
- 6011     format(2i3,f8.1,i3,3e12.3)
-        END DO
-      END DO
- 
- 
-C +--Additional RunOFF Intensity
-C +  ===========================
- 
-        DO ikl=1,knonv
-          ist      =          isotSV(ikl)
-          ik0      = nkhy  *  etaaux(ikl,-nsol  ) /etadSV(ist)
-c #       FreeDr   =          FreeD0            *  min(ist,1)
-          FreeDr   =          iWaFSV(ikl)       *  min(ist,1)
-          SoRnOF(ikl) =  SoRnOF(ikl)
-     .                + (aKdtSV3(ist,ik0)*(etaaux(ikl,-nsol)*Explic
-     .                                   +eta_SV(ikl,-nsol)*Implic)
-     .                 + bKdtSV3(ist,ik0)                           )
-     .                 * FreeDr          *ro_Wat           /dt__SV
-        RuofSV(ikl,3) = RuofSV(ikl,3)
-     .                + (aKdtSV3(ist,ik0)*(etaaux(ikl,-nsol)*Explic
-     .                                   +eta_SV(ikl,-nsol)*Implic)
-     .                 + bKdtSV3(ist,ik0)                           )
-     .                 * FreeDr          *ro_Wat           /dt__SV
- 
-C +--Full Run OFF: Update
-C +  ~~~~~~~~~~~~~~~~~~~~
-          RnofSV(ikl)   = RnofSV(ikl)   + SoRnOF(ikl)
-          RuofSV(ikl,4) = RuofSV(ikl,4) + SoRnOF(ikl)
-        END DO
- 
- 
-C +--Temperature Correction due to a changed Soil Energy Content
-C +  ===========================================================
- 
-C +!!!    Mettre en oeuvre le couplage humidit?-?nergie
- 
- 
-C +--Bumps/Asperites Treatment
-C +  =========================
- 
-C +--Average over Bump Depth (z0soil)
-C +  --------------------------------
- 
-c #BP       z_Bump      = 0.
-c #BP     DO ikl=1,knonv
-c #BP       etBump(ikl) = 0.
-c #BP     END DO
-C +
-c #BP DO     isl=0,-nsol,-1
-c #BP       z0Bump      = z_Bump
-c #BP       z_Bump      = z_Bump      +  dzAvSV(isl)
-c #BP   IF (z_Bump.lt.z0soil)                                       THEN
-c #BP     DO ikl=1,knonv
-c #BP       etBump(ikl) = etBump(ikl) +  dzAvSV(isl)   *eta_SV(ikl,isl)
-c #BP     END DO
-c #BP   END IF
-c #BP   IF (z_Bump.gt.z0soil.AND.z0Bump.lt.z0soil)                  THEN
-c #BP     DO ikl=1,knonv
-c #BP       etBump(ikl) = etBump(ikl) + (z0soil-z0Bump)*eta_SV(ikl,isl)
-c #BP       etBump(ikl) = etBump(ikl) /  z0soil
-c #BP     END DO
-c #BP   END IF
-c #BP END DO
- 
- 
-C +--Correction
-C +  ----------
- 
-c #BP       z_Bump      = 0.
-c #BP DO     isl=0,-nsol,-1
-c #BP       z0Bump =  z_Bump
-c #BP       z_Bump =  z_Bump +dzAvSV(isl)
-c #BP   IF (z_Bump.lt.z0soil)                                       THEN
-c #BP     DO ikl=1,knonv
-c #BP       eta_SV(ikl,isl) = etBump(ikl)
-c #BP     END DO
-c #BP   END IF
-c #BP   IF (z_Bump.gt.z0soil.AND.z0Bump.lt.z0soil)                  THEN
-c #BP       dzBump          =    z_Bump -  z0soil
-c #BP     DO ikl=1,knonv
-c #BP       eta_SV(ikl,isl) =(etBump(ikl)    *(dzAvSV(isl)-dzBump)
-c #BP.                      + eta_SV(ikl,isl)*             dzBump)
-c #BP.                      /                  dzAvSV(isl)
-c #BP     END DO
-c #BP   END IF
-c #BP END DO
- 
- 
-C +--Positive Definite
-C +  =================
- 
-c #BP DO   isl= 0,-nsol,-1
-c #BP   DO ikl= 1,knonv
-c #BP     eta_SV(ikl,isl)   =          max(epsi,eta_SV(ikl,isl))
-c #BP   END DO
-c #BP END DO
- 
- 
-C +--Water  Budget (OUT)
-C +  ===================
- 
-! #m0   DO ikl=1,knonv
-! #m0     Wats_d(ikl) = Wats_d(ikl)                    !
-! #m0.                + drr_SV(ikl)     *zero          ! Precipitation is
-C +                                      \______________ already included
-! #m0.                + HLs_sv(ikl)
-! #m0.          *(1-min(isnoSV(ikl),1)) /Lx_H2O(ikl)   ! Evaporation
-! #m0.                - SoRnOF(ikl)                    ! Soil RunOFF Contrib.
-! #m0     Wats_1(ikl) = 0.                             !
-c #mw     Evapor(ikl) = HLs_sv(ikl)     *dt__SV        !
-c #mw.          *(1-min(isnoSV(ikl),1)) /Lx_H2O(ikl)   !
-! #m0   END DO
- 
-! #m0 DO   isl= -nsol,0
-! #m0   DO ikl=1,knonv
-! #m0     Wats_d(ikl) = Wats_d(ikl)                    !
-! #m0   END DO
-! #m0 END DO
-! #m0   DO ikl=1,knonv
-! #m0     Wats_d(ikl) = Wats_d(ikl)     *dt__SV        !
-! #m0   END DO
- 
-! #m0      isl= -nsol
-! #m0   DO ikl=1,knonv
-! #m0     Wats_1(ikl) = Wats_1(ikl)
-! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
-! #m0.                + eta_SV(ikl,isl+1) *dz_8SV(isl) ) *LSdzsv(ikl)
-! #m0   END DO
- 
-! #m0 DO   isl= -nsol+1,-1
-! #m0   DO ikl=1,knonv
-! #m0     Wats_1(ikl) = Wats_1(ikl)
-! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz34SV(isl)
-! #m0.                +(eta_SV(ikl,isl-1)
-! #m0.                 +eta_SV(ikl,isl+1))*dz_8SV(isl) ) *LSdzsv(ikl)
-! #m0   END DO
-! #m0 END DO
- 
-! #m0      isl=  0
-! #m0   DO ikl=1,knonv
-! #m0     Wats_1(ikl) = Wats_1(ikl)
-! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
-! #m0.                + eta_SV(ikl,isl-1) *dz_8SV(isl) ) *LSdzsv(ikl)
-! #m0   END DO
- 
- 
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qso.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qso.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_qso.f90	(revision 5246)
@@ -0,0 +1,710 @@
+
+
+subroutine SISVAT_qSo
+  ! #m0.                     (Wats_0,Wats_1,Wats_d)
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_qSo                                 6-04-2001  MAR |
+  ! |   SubRoutine SISVAT_qSo computes the Soil      Water  Balance          |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  ! |                     X       Number of Mosaic Cell per grid box         |
+  ! |                                                                        |
+  ! |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |   ^^^^^    isotSV   = 0,...,11:   Soil       Type                      |
+  ! |                       0:          Water, Solid or Liquid               |
+  ! |                                                                        |
+  ! |   INPUT:   rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
+  ! |   ^^^^^    drr_SV   : Rain   Intensity                       [kg/m2/s] |
+  ! |            LSdzsv   : Vertical   Discretization Factor             [-] |
+  ! |                     =    1. Soil                                       |
+  ! |                     = 1000. Ocean                                      |
+  ! |            dt__SV   : Time   Step                                  [s] |
+  ! |                                                                        |
+  ! |            Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
+  ! |            HLs_sv   : Latent Heat  Flux                         [W/m2] |
+  ! |                                                                        |
+  ! |   INPUT /  eta_SV   : Water      Content                       [m3/m3] |
+  ! |   OUTPUT:  Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
+  ! |   ^^^^^^                                                               |
+  ! |                                                                        |
+  ! |   OUTPUT:  RnofSV   : RunOFF Intensity                       [kg/m2/s] |
+  ! |   ^^^^^^   Wats_0   : Soil Water,  before Forcing                 [mm] |
+  ! |            Wats_1   : Soil Water,  after  Forcing                 [mm] |
+  ! |            Wats_d   : Soil Water          Forcing                 [mm] |
+  ! |                                                                        |
+  ! |   Internal Variables:                                                  |
+  ! |   ^^^^^^^^^^^^^^^^^^                                                   |
+  ! |            z_Bump   : (Partly)Bumpy Layers Height                  [m] |
+  ! |            z0Bump   :         Bumpy Layers Height                  [m] |
+  ! |            dzBump   :  Lowest Bumpy Layer:                         [m] |
+  ! |            etBump   :         Bumps Layer Averaged Humidity    [m3/m3] |
+  ! |            etaMid   : Layer Interface's Humidity               [m3/m3] |
+  ! |            eta__f   : Layer             Humidity  (Water Front)[m3/m3] |
+  ! |            Dhyd_f   : Soil  Hydraulic Diffusivity (Water Front) [m2/s] |
+  ! |            Dhydif   : Soil  Hydraulic Diffusivity               [m2/s] |
+  ! |            WgFlow   : Water         gravitational     Flux   [kg/m2/s] |
+  ! |            Wg_MAX   : Water MAXIMUM gravitational     Flux   [kg/m2/s] |
+  ! |            SatRat   : Water         Saturation        Flux   [kg/m2/s] |
+  ! |            WExces   : Water         Saturation Excess Flux   [kg/m2/s] |
+  ! |            Dhydtz   : Dhydif * dt / dz                             [m] |
+  ! |            FreeDr   : Free Drainage Fraction                       [-] |
+  ! |            Elem_A   : A Diagonal Coefficient                           |
+  ! |            Elem_C   : C Diagonal Coefficient                           |
+  ! |            Diag_A   : A Diagonal                                       |
+  ! |            Diag_B   : B Diagonal                                       |
+  ! |            Diag_C   : C Diagonal                                       |
+  ! |            Term_D   :   Independant Term                               |
+  ! |            Aux__P   : P Auxiliary Variable                             |
+  ! |            Aux__Q   : Q Auxiliary Variable                             |
+  ! |                                                                        |
+  ! |   TUNING PARAMETER:                                                    |
+  ! |   ^^^^^^^^^^^^^^^^                                                     |
+  ! |            z0soil   : Soil Surface averaged Bumps Height           [m] |
+  ! |                                                                        |
+  ! |   METHOD: NO   Skin Surface Humidity                                   |
+  ! |   ^^^^^^  Semi-Implicit Crank Nicholson Scheme                         |
+  ! |           (Partial) free Drainage, Water Bodies excepted (Lakes, Sea)  |
+  ! |                                                                        |
+
+  ! |                                                                        |
+  ! | # OPTIONS: #GF: Saturation Front                                       |
+  ! | # ^^^^^^^  #GH: Saturation Front allows Horton Runoff                  |
+  ! | #          #GA: Soil Humidity Geometric Average                        |
+  ! | #          #BP: Parameterization of Terrain Bumps                      |
+  ! |                                                                        |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VAR0SV
+  use VARxSV
+  use VARySV
+
+
+  IMPLICIT NONE
+
+
+  ! +--OUTPUT
+  ! +  ------
+
+  ! Water (Mass) Budget
+  ! ~~~~~~~~~~~~~~~~~~~
+  ! #m0 real      Wats_0(knonv)                 ! Soil Water,  before forcing
+  ! #m0 real      Wats_1(knonv)                 ! Soil Water,  after  forcing
+  ! #m0 real      Wats_d(knonv)                 ! Soil Water          forcing
+
+
+  ! +--Internal Variables
+  ! +  ==================
+
+  integer :: isl   ,jsl   ,ist   ,ikl      !
+  integer :: ikm   ,ikp   ,ik0   ,ik1      !
+  integer :: ist__s,ist__w                 ! Soil/Water Body Identifier
+  ! #BP real      z0soil                        ! Soil Surface Bumps Height  [m]
+  ! #BP real      z_Bump                        !(Partly)Bumpy Layers Height [m]
+  ! #BP real      z0Bump                        !        Bumpy Layers Height [m]
+  ! #BP real      dzBump                        ! Lowest Bumpy Layer:
+
+  ! #BP real      etBump(knonv)                 ! Bumps Layer Averaged Humidity
+  real :: etaMid                        ! Layer Interface's Humidity
+  real :: Dhydif                        ! Hydraulic Diffusivity   [m2/s]
+  real :: eta__f                        ! Water Front Soil Water Content
+  real :: Khyd_f                        ! Water Front Hydraulic Conduct.
+  real :: Khydav                        ! Hydraulic Conductivity   [m/s]
+  real :: WgFlow                        ! Water gravitat. Flux [kg/m2/s]
+  real :: Wg_MAX                        ! Water MAX.grav. Flux [kg/m2/s]
+  real :: SatRat                        ! Saturation      Flux [kg/m2/s]
+  real :: WExces                        ! Saturat. Excess Flux [kg/m2/s]
+  real :: SoRnOF(knonv)                 ! Soil     Run    OFF
+  real :: Dhydtz(knonv,-nsol:0)         ! Dhydif * dt / dz           [m]
+  real :: Elem_A,Elem_B,Elem_C          !   Diagonal Coefficients
+  real :: Diag_A(knonv,-nsol:0)         ! A Diagonal
+  real :: Diag_B(knonv,-nsol:0)         ! B Diagonal
+  real :: Diag_C(knonv,-nsol:0)         ! C Diagonal
+  real :: Term_D(knonv,-nsol:0)         !   Independant Term
+  real :: Aux__P(knonv,-nsol:0)         ! P Auxiliary Variable
+  real :: Aux__Q(knonv,-nsol:0)         ! Q Auxiliary Variable
+  real :: etaaux(knonv,-nsol:-nsol+1)   ! Soil Water Content     [m3/m3]
+  real :: FreeDr                        ! Free Drainage Fraction (actual)
+  real :: FreeD0                        ! Free Drainage Fraction (1=Full)
+  real :: aKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: a * dt
+  real :: bKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: b * dt
+
+  ! Water (Mass) Budget
+  ! ~~~~~~~~~~~~~~~~~~~
+  ! #mw logical         mwopen                  ! IO   Switch
+  ! #mw common/Sm_qSo_L/mwopen                  !
+  ! #mw real     hourwr,timewr                  !
+  ! #mw common/Sm_qSo_R/timewr                  !
+  ! #mw real            Evapor(knonv)           !
+
+
+  ! +--Internal DATA
+  ! +  =============
+
+  ! #BP data      z0soil/0.020/                 ! Soil Surface Bumps Height  [m]
+  data      FreeD0/1.000/                 ! Free Drainage Fraction (1=Full)
+
+  aKdtSV3=aKdtSV2*dt__SV
+  bKdtSV3=bKdtSV2*dt__SV
+
+  ! Water  Budget (IN)
+  ! ==================
+
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_0(ikl) = 0.                    ! OLD RunOFF Contrib.
+  ! #m0     Wats_d(ikl) = drr_SV(ikl)           ! Water Surface Forc.
+  ! #m0   END DO
+
+  ! #m0      isl= -nsol
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_0(ikl) = Wats_0(ikl)
+  ! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+  ! #m0.                + eta_SV(ikl,isl+1) *dz_8SV(isl) ) * LSdzsv(ikl)
+  ! #m0   END DO
+
+  ! #m0 DO   isl= -nsol+1,-1
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_0(ikl) = Wats_0(ikl)
+  ! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz34SV(isl)
+  ! #m0.                +(eta_SV(ikl,isl-1)
+  ! #m0.                 +eta_SV(ikl,isl+1))*dz_8SV(isl) ) * LSdzsv(ikl)
+  ! #m0   END DO
+  ! #m0 END DO
+
+  ! #m0      isl=  0
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_0(ikl) = Wats_0(ikl)
+  ! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+  ! #m0.                + eta_SV(ikl,isl-1) *dz_8SV(isl) ) * LSdzsv(ikl)
+  ! #m0   END DO
+
+
+  ! +--Gravitational Flow
+  ! +  ==================
+
+  ! +...    METHOD: Surface Water Flux saturates successively the soil layers
+  ! +       ^^^^^^  from up to below, but is limited by infiltration capacity.
+  ! +               Hydraulic Conductivity again contributes after this step,
+  ! +               not redundantly because of a constant (saturated) profile.
+
+  ! +--Flux  Limitor
+  ! +  ^^^^^^^^^^^^^
+       isl=0
+    DO ikl=1,knonv
+      ist    = isotSV(ikl)                     ! Soil Type
+      ist__s = min(ist, 1)                     ! 1 => Soil
+      ist__w = 1 - ist__s                      ! 1 => Water Body
+      Dhydif = s1__SV(ist) &
+            *max(epsi,eta_SV(ikl,isl)) & ! Hydraulic Diffusivity
+            **(bCHdSV(ist)+2.)     ! DR97, Eqn.(3.36)
+      Dhydif = ist__s    * Dhydif & !
+            + ist__w    * vK_dSV              ! Water Bodies
+  ! +
+      Khydav = ist__s    * Ks_dSV(ist) & ! DR97  Assumption
+            + ist__w    * vK_dSV              ! Water Bodies
+  ! +
+      Wg_MAX = ro_Wat     *Dhydif & ! MAXimum  Infiltration
+            *(etadSV(ist)-eta_SV(ikl,isl)) & !          Rate
+            /(dzAvSV(isl)*LSdzsv(ikl)    ) & !
+            +  ro_Wat     *Khydav              !
+
+  ! +--Surface Horton RunOFF
+  ! +  ^^^^^^^^^^^^^^^^^^^^^
+      SoRnOF(ikl) = &
+            max(zero,drr_SV(ikl)-Wg_MAX)
+    RuofSV(ikl,1) = RuofSV(ikl,1) +    SoRnOF(ikl)
+      drr_SV(ikl) =        drr_SV(ikl)-SoRnOF(ikl)
+    RuofSV(ikl,2) = RuofSV(ikl,2) +max(0.,drr_SV(ikl))
+    END DO
+
+  ! #GF DO   isl=0,-nsol,-1
+  ! #GF   DO ikl=1,knonv
+  ! #GF     ist    = isotSV(ikl)                     ! Soil Type
+  ! #GF     ist__s = min(ist, 1)                     ! 1 => Soil
+  ! #GF     ist__w = 1 - ist__s                      ! 1 => Water Body
+
+  ! +--Water Diffusion
+  ! +  ^^^^^^^^^^^^^^^
+  ! #GF     Dhydif = s1__SV(ist)
+  ! #GF.               *max(epsi,eta_SV(ikl,isl))    ! Hydraulic Diffusivity
+  ! #GF.                      **(bCHdSV(ist)+2.)     ! DR97, Eqn.(3.36)
+  ! #GF     Dhydif = ist__s    * Dhydif              !
+  ! #GF.           + ist__w    * vK_dSV              ! Water Bodies
+
+  ! +--Water Conduction (without Horton Runoff)
+  ! +  ^^^^^^^^^^^^^^^^
+  ! #GF     Khyd_f =             Ks_dSV(ist)
+  ! +...    Uses saturated K ==> Horton Runoff ~0    !
+
+  ! +--Water Conduction (with    Horton Runoff)
+  ! +  ^^^^^^^^^^^^^^^^
+  ! #GH     ik0    = nkhy       *eta_SV(ikl,isl)
+  ! #GH.                        /etadSV(ist)
+  ! #GH     eta__f         =            1.
+  ! #GH.   -aKdtSV3(ist,ik0)/(2. *dzAvSV(isl)
+  ! #GH.                        *LSdzsv(ikl))
+  ! #GH     eta__f         = max(eps_21,eta__f)
+  ! #GH     eta__f         = min(etadSV(ist),
+  ! #GH.                         eta_SV(ikl,isl) +
+  ! #GH.   (aKdtSV3(ist,ik0)     *eta_SV(ikl,isl)
+  ! #GH.   +bKdtSV3(ist,ik0))   /(dzAvSV(isl)
+  ! #GH.                        *LSdzsv(ikl))
+  ! #GH.                       / eta__f          )
+  ! #GH     eta__f         = .5*(eta_SV(ikl,isl)
+  ! #GH.                        +eta__f)
+
+  ! #gh     eta__f         =     eta_SV(ikl,isl)
+
+  ! #GH     ik0    = nkhy       *eta__f
+  ! #GH.                        /etadSV(ist)
+  ! #GH     Khyd_f =
+  ! #GH.   (aKdtSV3(ist,ik0)     *eta__f
+  ! #GH.   +bKdtSV3(ist,ik0))    /dt__SV
+
+  ! #GF     Khydav = ist__s    * Khyd_f              ! DR97  Assumption
+  ! #GF.           + ist__w    * vK_dSV              ! Water Bodies
+
+  ! +--Gravitational Flow
+  ! +  ^^^^^^^^^^^^^^^^^^
+  ! #GF     Wg_MAX =                                 ! MAXimum  Infiltration
+  ! #GF.             ro_Wat     *Dhydif              !          Rate
+  ! #GF.           *(etadSV(ist)-eta_SV(ikl,isl))    !
+  ! #GF.           /(dzAvSV(isl)*LSdzsv(ikl)    )    !
+  ! #GF.          +  ro_Wat     *Khydav              !
+  ! #GF   END DO
+  ! #GF END DO
+  ! #GF   DO ikl=1,knonv
+  ! #GF     SoRnOF(ikl)     =    SoRnOF(ikl)         ! RunOFF Intensity
+  ! #GF.                    +    drr_SV(ikl)         ! [kg/m2/s]
+  ! +!!!    Inclure la possibilite de creer une mare sur un bedrock impermeable
+  ! #GF     drr_SV(ikl) = 0.
+  ! #GF   END DO
+
+
+  ! +--Temperature Correction due to a changed Soil Energy Content
+  ! +  ===========================================================
+
+  ! +!!!    Mettre en oeuvre le couplage humidit?-?nergie
+
+
+  ! +--Full Resolution of the Richard's Equation
+  ! +  =========================================
+
+  ! +...    METHOD: Water content evolution results from water fluxes
+  ! +       ^^^^^^  at the layer boundaries
+  ! +               Conductivity is approximated by a piecewise linear profile.
+  ! +               Semi-Implicit Crank-Nicholson scheme is used.
+  ! +              (Bruen, 1997, Sensitivity of hydrological processes
+  ! +                            at the land-atmosphere interface.
+  ! +                            Proc. Royal Irish Academy,  IGBP symposium
+  ! +                            on global change and the Irish Environment.
+  ! +                            Publ.: Maynooth)
+
+  ! +                      - - - - - - - -   isl+1/2   - -  ^
+  ! +                                                       |
+  ! +   eta_SV(isl)        ---------------   isl     -----  +--dz_dSV(isl)  ^
+  ! +                                                       |               |
+  ! +   Dhydtz(isl) etaMid - - - - - - - -   isl-1/2   - -  v  dzmiSV(isl)--+
+  ! +                                                                       |
+  ! +   eta_SV(isl-1)      ---------------   isl-1   -----                  v
+
+  ! +--Transfert       Coefficients
+  ! +  ----------------------------
+
+  DO   isl=-nsol+1,0
+    DO ikl=1,knonv
+      ist    =      isotSV(ikl)                       ! Soil Type
+      ist__s =      min(ist, 1)                       ! 1 => Soil
+      ist__w =      1 - ist__s                        ! 1 => Water Body
+      etaMid =     (dz_dSV(isl)  *eta_SV(ikl,isl-1) & ! eta at layers
+            +dz_dSV(isl-1)*eta_SV(ikl,isl)  ) & !     interface
+            /(2.0* dzmiSV(isl))                      ! LSdzsv implicit !
+  ! #GA     etaMid = sqrt(dz_dSV(isl)  *eta_SV(ikl,isl-1)   ! Idem, geometric
+  ! #GA.                 *dz_dSV(isl-1)*eta_SV(ikl,isl)  )  !       average
+  ! #GA.           /(2.0* dzmiSV(isl))                      ! (Vauclin&al.1979)
+      Dhydif          =    s1__SV(ist) & ! Hydraul.Diffusi.
+            *(etaMid         **(   bCHdSV(ist)+2.))           ! DR97, Eqn.(3.36)
+      Dhydtz(ikl,isl) =    Dhydif*dt__SV & !
+            /(dzmiSV(isl) & !
+            *LSdzsv(ikl))        !
+      Dhydtz(ikl,isl) =    Dhydtz(ikl,isl) * ist__s & ! Soil
+            +0.5*dzmiSV(isl)*LSdzsv(ikl)     * ist__w   ! Water bodies
+
+    END DO
+  END DO
+       isl=-nsol
+    DO ikl=1,knonv
+      Dhydtz(ikl,isl) =    0.0                        !
+    END DO
+
+
+  ! +--Tridiagonal Elimination: Set Up
+  ! +  -------------------------------
+
+  ! +--Soil/Snow Interior
+  ! +  ^^^^^^^^^^^^^^^^^^
+
+  DO   isl=0,-nsol,-1
+    DO ikl=1,knonv
+     ist             = isotSV(ikl)
+     eta_SV(ikl,isl) = max(epsi,           eta_SV(ikl,isl))
+    END DO
+  END DO
+
+  DO   isl=-nsol,-nsol+1
+    DO ikl=1,knonv
+      etaaux(ikl,isl) =  eta_SV(ikl,isl)
+    END DO
+  END DO
+
+  DO   isl=-nsol+1,-1
+    DO ikl=1,knonv
+      ist      =         isotSV(ikl)
+      ikm      = nkhy *  eta_SV(ikl,isl-1) / etadSV(ist)
+      ik0      = nkhy *  eta_SV(ikl,isl)   / etadSV(ist)
+      ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
+
+      if(ikm<0.or.ik0<0.or.ikp<0)then
+       print *,"CRASH1 in sisvat_qso.f on pixel (i,j,n)", &
+             ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
+       print *,"decrease your time step or increase ntphys "// &
+             "and ntdiff in time_steps.f"
+       stop
+      endif
+
+
+      Elem_A   =         Dhydtz(ikl,isl) &
+            -  aKdtSV3(ist,ikm)* dziiSV(isl)  *LSdzsv(ikl)
+      Elem_B   =      - (Dhydtz(ikl,isl) &
+            +Dhydtz(ikl,isl+1) &
+            -aKdtSV3(ist,ik0)*(dziiSV(isl+1) &
+            -dzi_SV(isl) )*LSdzsv(ikl))
+      Elem_C   =         Dhydtz(ikl,isl+1) &
+            +  aKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
+      Diag_A(ikl,isl) =  dz_8SV(isl)        *LSdzsv(ikl) &
+            -Implic            * Elem_A
+      Diag_B(ikl,isl) =  dz34SV(isl)        *LSdzsv(ikl) &
+            -Implic            * Elem_B
+      Diag_C(ikl,isl) =  dz_8SV(isl)        *LSdzsv(ikl) &
+            -Implic            * Elem_C
+
+      Term_D(ikl,isl) = (dz_8SV(isl) *LSdzsv(ikl) &
+            +Explic      *Elem_A     )*eta_SV(ikl,isl-1) &
+            + (dz34SV(isl) *LSdzsv(ikl) &
+            +Explic      *Elem_B     )*eta_SV(ikl,isl) &
+            + (dz_8SV(isl) *LSdzsv(ikl) &
+            +Explic      *Elem_C     )*eta_SV(ikl,isl+1) &
+            + (bKdtSV3(ist,ikp)* dzi_SV(isl+1) &
+            +bKdtSV3(ist,ik0)*(dziiSV(isl+1) &
+            -dzi_SV(isl)  ) &
+            -bKdtSV3(ist,ikm)* dziiSV(isl)   ) &
+            * LSdzsv(ikl)
+    END DO
+  END DO
+
+       isl=-nsol
+    DO ikl=1,knonv
+      ist      =         isotSV(ikl)
+  ! #       FreeDr   =         FreeD0            *  min(ist,1)
+      FreeDr   =         iWaFSV(ikl)       *  min(ist,1)
+      ik0      = nkhy *  eta_SV(ikl,isl  ) / etadSV(ist)
+      ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
+
+      if(ik0<0.or.ikp<0)then
+       print *,"CRASH2 in sisvat_qso.f on pixel (i,j,n)", &
+             ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
+       print *,"decrease your time step or increase ntphys "// &
+             "and ntdiff in time_steps.f"
+       stop
+      endif
+
+      Elem_A   =         0.
+      Elem_B   =      - (Dhydtz(ikl,isl+1) &
+            -aKdtSV3(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl) &
+            -FreeDr                  ))
+      Elem_C   =         Dhydtz(ikl,isl+1) &
+            +  aKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
+      Diag_A(ikl,isl) =  0.
+      Diag_B(ikl,isl) =  dz78SV(isl) *LSdzsv(ikl) &
+            -Implic      *Elem_B
+      Diag_C(ikl,isl) =  dz_8SV(isl) *LSdzsv(ikl) &
+            -Implic      *Elem_C
+
+      Term_D(ikl,isl) = (dz78SV(isl) *LSdzsv(ikl) &
+            +Explic      *Elem_B     )*eta_SV(ikl,isl) &
+            + (dz_8SV(isl) *LSdzsv(ikl) &
+            +Explic      *Elem_C     )*eta_SV(ikl,isl+1) &
+            + (bKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl) &
+            +bKdtSV3(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl) &
+            -FreeDr                  ))
+    END DO
+
+       isl=0
+    DO ikl=1,knonv
+      ist      =         isotSV(ikl)
+      ikm      = nkhy *  eta_SV(ikl,isl-1) / etadSV(ist)
+      ik0      = nkhy *  eta_SV(ikl,isl)   / etadSV(ist)
+      Elem_A   =         Dhydtz(ikl,isl) &
+            -  aKdtSV3(ist,ikm)* dziiSV(isl)*LSdzsv(ikl)
+      Elem_B   =      - (Dhydtz(ikl,isl) &
+            +aKdtSV3(ist,ik0)* dzi_SV(isl)*LSdzsv(ikl))
+      Elem_C   =         0.
+      Diag_A(ikl,isl) =  dz_8SV(isl) *LSdzsv(ikl) &
+            -  Implic      *Elem_A
+      Diag_B(ikl,isl) =  dz78SV(isl) *LSdzsv(ikl) &
+            -  Implic      *Elem_B
+      Diag_C(ikl,isl) =  0.
+  ! +
+      Term_D(ikl,isl) = (dz_8SV(isl) *LSdzsv(ikl) &
+            +Explic      *Elem_A     )*eta_SV(ikl,isl-1) &
+            + (dz78SV(isl) *LSdzsv(ikl) &
+            +Explic      *Elem_B     )*eta_SV(ikl,isl) &
+            - (bKdtSV3(ist,ik0)* dzi_SV(isl) &
+            +bKdtSV3(ist,ikm)* dziiSV(isl))*LSdzsv(ikl) &
+            + dt__SV *(HLs_sv(ikl)    *     (1-min(1,isnoSV(ikl))) &
+            / (ro_Wat *dz_dSV(0) * Lx_H2O(ikl)) &
+  !XF bug 17/05/2017
+            +drr_SV(ikl))/ro_Wat
+    END DO
+
+    DO ikl=1,knonv
+     drr_SV(ikl)=0. ! drr is included in the 1st soil layer
+    ENDDO
+
+  ! +
+  ! +
+  ! +--Tridiagonal Elimination
+  ! +  =======================
+  ! +
+  ! +--Forward  Sweep
+  ! +  ^^^^^^^^^^^^^^
+    DO ikl=  1,knonv
+      Aux__P(ikl,-nsol) = Diag_B(ikl,-nsol)
+      Aux__Q(ikl,-nsol) =-Diag_C(ikl,-nsol)/Aux__P(ikl,-nsol)
+    END DO
+  ! +
+  DO   isl=-nsol+1,0
+    DO ikl=      1,knonv
+      Aux__P(ikl,isl)   = Diag_A(ikl,isl)  *Aux__Q(ikl,isl-1) &
+            +Diag_B(ikl,isl)
+      Aux__Q(ikl,isl)   =-Diag_C(ikl,isl)  /Aux__P(ikl,isl)
+    END DO
+  END DO
+  ! +
+    DO ikl=      1,knonv
+      eta_SV(ikl,-nsol) = Term_D(ikl,-nsol)/Aux__P(ikl,-nsol)
+    END DO
+  ! +
+  DO   isl=-nsol+1,0
+    DO ikl=      1,knonv
+      eta_SV(ikl,isl)   =(Term_D(ikl,isl) &
+            -Diag_A(ikl,isl)  *eta_SV(ikl,isl-1)) &
+            /Aux__P(ikl,isl)
+    END DO
+  END DO
+
+  ! +--Backward Sweep
+  ! +  ^^^^^^^^^^^^^^
+  DO   isl=-1,-nsol,-1
+    DO ikl= 1,knonv
+      eta_SV(ikl,isl)   = Aux__Q(ikl,isl)  *eta_SV(ikl,isl+1) &
+            +eta_SV(ikl,isl)
+    END DO
+  END DO
+
+
+  ! +--Horton RunOFF Intensity
+  ! +  =======================
+
+  DO   isl=0,-nsol,-1
+    DO ikl=1,knonv
+      ist    =   isotSV(ikl)                   ! Soil Type
+      SatRat =  (eta_SV(ikl,isl)-etadSV(ist)) & ! OverSaturation Rate
+            *ro_Wat         *dzAvSV(isl) & !
+            *LSdzsv(ikl) & !
+            /dt__SV        !
+      SoRnOF(ikl)     =          SoRnOF(ikl) & !
+            + max(zero,SatRat)       !
+      RuofSV(ikl,3)   = RuofSV(ikl,3) + &
+            + max(zero,SatRat)
+      eta_SV(ikl,isl) = max(epsi & !
+  ! #ED.                         +etamSV(isotSV(ikl))!
+            ,eta_SV(ikl,isl))   !
+      eta_SV(ikl,isl) = min(eta_SV(ikl,isl) & !
+            ,etadSV(ist)    )   !
+    END DO
+  END DO
+
+  ! +--IO, for Verification
+  ! +  ~~~~~~~~~~~~~~~~~~~~
+  ! #WR     write(6,6010)
+ 6010   format(/,1x)
+  DO   isl= 0,-nsol,-1
+    DO ikl= 1,knonv
+      ist      =          isotSV(ikl)
+      ikp      = nkhy  *  eta_SV(ikl,isl)  /etadSV(ist)
+      Khydsv(ikl,isl)   =(aKdtSV3(ist,ikp)  *eta_SV(ikl,isl) &
+            +bKdtSV3(ist,ikp)) *2.0/dt__SV
+  ! #WR     write(6,6011) ikl,isl,eta_SV(ikl,isl)*1.e3,
+  ! #WR.                  ikp,    aKdtSV3(ist,ikp),bKdtSV3(ist,ikp),
+  ! #WR.                          Khydsv(ikl,isl)
+ 6011   format(2i3,f8.1,i3,3e12.3)
+    END DO
+  END DO
+
+
+  ! +--Additional RunOFF Intensity
+  ! +  ===========================
+
+    DO ikl=1,knonv
+      ist      =          isotSV(ikl)
+      ik0      = nkhy  *  etaaux(ikl,-nsol  ) /etadSV(ist)
+  ! #       FreeDr   =          FreeD0            *  min(ist,1)
+      FreeDr   =          iWaFSV(ikl)       *  min(ist,1)
+      SoRnOF(ikl) =  SoRnOF(ikl) &
+            + (aKdtSV3(ist,ik0)*(etaaux(ikl,-nsol)*Explic &
+            +eta_SV(ikl,-nsol)*Implic) &
+            + bKdtSV3(ist,ik0)                           ) &
+            * FreeDr          *ro_Wat           /dt__SV
+    RuofSV(ikl,3) = RuofSV(ikl,3) &
+          + (aKdtSV3(ist,ik0)*(etaaux(ikl,-nsol)*Explic &
+          +eta_SV(ikl,-nsol)*Implic) &
+          + bKdtSV3(ist,ik0)                           ) &
+          * FreeDr          *ro_Wat           /dt__SV
+
+  ! +--Full Run OFF: Update
+  ! +  ~~~~~~~~~~~~~~~~~~~~
+      RnofSV(ikl)   = RnofSV(ikl)   + SoRnOF(ikl)
+      RuofSV(ikl,4) = RuofSV(ikl,4) + SoRnOF(ikl)
+    END DO
+
+
+  ! +--Temperature Correction due to a changed Soil Energy Content
+  ! +  ===========================================================
+
+  ! +!!!    Mettre en oeuvre le couplage humidit?-?nergie
+
+
+  ! +--Bumps/Asperites Treatment
+  ! +  =========================
+
+  ! +--Average over Bump Depth (z0soil)
+  ! +  --------------------------------
+
+  ! #BP       z_Bump      = 0.
+  ! #BP     DO ikl=1,knonv
+  ! #BP       etBump(ikl) = 0.
+  ! #BP     END DO
+  ! +
+  ! #BP DO     isl=0,-nsol,-1
+  ! #BP       z0Bump      = z_Bump
+  ! #BP       z_Bump      = z_Bump      +  dzAvSV(isl)
+  ! #BP   IF (z_Bump.lt.z0soil)                                       THEN
+  ! #BP     DO ikl=1,knonv
+  ! #BP       etBump(ikl) = etBump(ikl) +  dzAvSV(isl)   *eta_SV(ikl,isl)
+  ! #BP     END DO
+  ! #BP   END IF
+  ! #BP   IF (z_Bump.gt.z0soil.AND.z0Bump.lt.z0soil)                  THEN
+  ! #BP     DO ikl=1,knonv
+  ! #BP       etBump(ikl) = etBump(ikl) + (z0soil-z0Bump)*eta_SV(ikl,isl)
+  ! #BP       etBump(ikl) = etBump(ikl) /  z0soil
+  ! #BP     END DO
+  ! #BP   END IF
+  ! #BP END DO
+
+
+  ! +--Correction
+  ! +  ----------
+
+  ! #BP       z_Bump      = 0.
+  ! #BP DO     isl=0,-nsol,-1
+  ! #BP       z0Bump =  z_Bump
+  ! #BP       z_Bump =  z_Bump +dzAvSV(isl)
+  ! #BP   IF (z_Bump.lt.z0soil)                                       THEN
+  ! #BP     DO ikl=1,knonv
+  ! #BP       eta_SV(ikl,isl) = etBump(ikl)
+  ! #BP     END DO
+  ! #BP   END IF
+  ! #BP   IF (z_Bump.gt.z0soil.AND.z0Bump.lt.z0soil)                  THEN
+  ! #BP       dzBump          =    z_Bump -  z0soil
+  ! #BP     DO ikl=1,knonv
+  ! #BP       eta_SV(ikl,isl) =(etBump(ikl)    *(dzAvSV(isl)-dzBump)
+  ! #BP.                      + eta_SV(ikl,isl)*             dzBump)
+  ! #BP.                      /                  dzAvSV(isl)
+  ! #BP     END DO
+  ! #BP   END IF
+  ! #BP END DO
+
+
+  ! +--Positive Definite
+  ! +  =================
+
+  ! #BP DO   isl= 0,-nsol,-1
+  ! #BP   DO ikl= 1,knonv
+  ! #BP     eta_SV(ikl,isl)   =          max(epsi,eta_SV(ikl,isl))
+  ! #BP   END DO
+  ! #BP END DO
+
+
+  ! +--Water  Budget (OUT)
+  ! +  ===================
+
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_d(ikl) = Wats_d(ikl)                    !
+  ! #m0.                + drr_SV(ikl)     *zero          ! Precipitation is
+  ! +                                      \______________ already included
+  ! #m0.                + HLs_sv(ikl)
+  ! #m0.          *(1-min(isnoSV(ikl),1)) /Lx_H2O(ikl)   ! Evaporation
+  ! #m0.                - SoRnOF(ikl)                    ! Soil RunOFF Contrib.
+  ! #m0     Wats_1(ikl) = 0.                             !
+  ! #mw     Evapor(ikl) = HLs_sv(ikl)     *dt__SV        !
+  ! #mw.          *(1-min(isnoSV(ikl),1)) /Lx_H2O(ikl)   !
+  ! #m0   END DO
+
+  ! #m0 DO   isl= -nsol,0
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_d(ikl) = Wats_d(ikl)                    !
+  ! #m0   END DO
+  ! #m0 END DO
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_d(ikl) = Wats_d(ikl)     *dt__SV        !
+  ! #m0   END DO
+
+  ! #m0      isl= -nsol
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_1(ikl) = Wats_1(ikl)
+  ! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+  ! #m0.                + eta_SV(ikl,isl+1) *dz_8SV(isl) ) *LSdzsv(ikl)
+  ! #m0   END DO
+
+  ! #m0 DO   isl= -nsol+1,-1
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_1(ikl) = Wats_1(ikl)
+  ! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz34SV(isl)
+  ! #m0.                +(eta_SV(ikl,isl-1)
+  ! #m0.                 +eta_SV(ikl,isl+1))*dz_8SV(isl) ) *LSdzsv(ikl)
+  ! #m0   END DO
+  ! #m0 END DO
+
+  ! #m0      isl=  0
+  ! #m0   DO ikl=1,knonv
+  ! #m0     Wats_1(ikl) = Wats_1(ikl)
+  ! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+  ! #m0.                + eta_SV(ikl,isl-1) *dz_8SV(isl) ) *LSdzsv(ikl)
+  ! #m0   END DO
+
+
+  return
+end subroutine sisvat_qso
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_sno_albedo.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_sno_albedo.F	(revision 5084)
+++ 	(revision )
@@ -1,765 +1,0 @@
-      subroutine SnOptP(jjtime)
- 
-C +------------------------------------------------------------------------+
-C | MAR/SISVAT   SnOptP                                    12-08-2019  MAR |
-C |   SubRoutine SnOptP computes the Snow Pack optical Properties          |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  knonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     Grid Boxes       |
-C |                     X       Number of Mosaic Cell per Grid Box         |
-C |                                                                        |
-C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
-C |   ^^^^^    ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
-C |                                                                        |
-C |                                                                        |
-C |   INPUT:   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
-C |   ^^^^^    G2snSV   : Sphericity (>0) or Size            of Snow Layer |
-C |            agsnSV   : Snow       Age                             [day] |
-C |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
-C |            eta_SV   : Water      Content                       [m3/m3] |
-C |            rusnSV   : Surficial  Water   Thickness   [kg/m2] .OR. [mm] |
-C |            SWS_SV   : Surficial  Water   Status                        |
-C |            dzsnSV   : Snow       Layer   Thickness                 [m] |
-C |                                                                        |
-C |            albssv   : Soil       Albedo                            [-] |
-C |            zzsnsv   : Snow       Pack    Thickness                 [m] |
-C |                                                                        |
-C |   OUTPUT:  albisv   : Snow/Ice/Water/Soil Integrated Albedo        [-] |
-C |   ^^^^^^   sEX_sv   : Verticaly Integrated Extinction Coefficient      |
-C |            DOPsnSV   : Snow Optical diameter [m]                       |
-C |                                                                        |
-C |   Internal Variables:                                                  |
-C |   ^^^^^^^^^^^^^^^^^^                                                   |
-C |            SnOpSV   : Snow Grain optical Size                      [m] |
-C |            EX1_sv   : Integrated Snow Extinction (0.3--0.8micr.m)      |
-C |            EX2_sv   : Integrated Snow Extinction (0.8--1.5micr.m)      |
-C |            EX3_sv   : Integrated Snow Extinction (1.5--2.8micr.m)      |
-C |                                                                        |
-C |   METHODE:    Calcul de la taille optique des grains ? partir de       |
-C |   ^^^^^^^    -leur type decrit par les deux variables descriptives     |
-C |                    continues sur la plage -99/+99 passees en appel.    |
-C |              -la taille optique (1/10mm) des etoiles,                  |
-C |                                          des grains fins et            |
-C |                                          des jeunes faces planes       |
-C |                                                                        |
-C |   METHOD:     Computation of the optical diameter of the grains        |
-C |   ^^^^^^      described with the CROCUS formalism G1snSV / G2snSV      |
-C |                                                                        |
-C |   REFERENCE: Brun et al.      1989, J. Glaciol 35 pp. 333--342         |
-C |   ^^^^^^^^^  Brun et al.      1992, J. Glaciol 38 pp.  13-- 22         |
-C |              Eric Martin Sept.1996                                     |
-C |                                                                        |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
- 
-
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VARxSV
-      use VARySV
-      use VARtSV
-      USE surface_data, only: iflag_albcalc,correc_alb
-
-      IMPLICIT NONE
-
- 
-C + -- INPUT
-      integer jjtime
-
-C +--Internal Variables
-C +  ==================
- 
-      real      coalb1(knonv)                      ! weighted Coalbedo, Vis.
-      real      coalb2(knonv)                      ! weighted Coalbedo, nIR 1
-      real      coalb3(knonv)                      ! weighted Coalbedo, nIR 2
-      real      coalbm                             ! weighted Coalbedo, mean
-      real      sExt_1(knonv)                      ! Extinction Coeff., Vis.
-      real      sExt_2(knonv)                      ! Extinction Coeff., nIR 1
-      real      sExt_3(knonv)                      ! Extinction Coeff., nIR 2
-      real      SnOpSV(knonv,      nsno)           ! Snow Grain optical Size
-c #AG real      agesno
- 
-      integer   isn   ,ikl   ,isn1, i  
-      real      sbeta1,sbeta2,sbeta3,sbeta4,sbeta5
-      real      AgeMax,AlbMin,HSnoSV,HIceSV,doptmx,SignG1,Sph_OK
-      real      dalbed,dalbeS,dalbeW
-      real      bsegal,czemax,csegal,csza
-      real      RoFrez,DiffRo,SignRo,SnowOK,OpSqrt
-      real      albSn1,albIc1,a_SnI1,a_SII1
-      real      albSn2,albIc2,a_SnI2,a_SII2
-      real      albSn3,albIc3,a_SnI3,a_SII3
-      real      albSno,albIce,albSnI,albSII,albWIc,albmax
-      real      doptic,Snow_H,SIce_H,SnownH,SIcenH
-      real      exarg1,exarg2,exarg3,sign_0,sExt_0
-      real      albedo_old,albCor
-      real      ro_ave,dz_ave,minalb
-      real      l1min,l1max,l2min,l2max,l3min,l3max
-      real      l6min(6), l6max(6), albSn6(6), a_SII6(6)
-      real      lmintmp,lmaxtmp,albtmp
- 
-C +--Local   DATA
-C +  ============
- 
-C +--For the computation of the solar irradiance extinction in snow
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      data      sbeta1/0.0192/,sbeta2/0.4000/,sbeta3/0.1098/
-      data      sbeta4/1.0000/
-      data      sbeta5/2.00e1/
- 
-C +--Snow Age Maximum (Taiga, e.g. Col de Porte)
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      data      AgeMax  /60.0/
-C +...          AgeMax:  Snow Age Maximum                              [day]
- 
-      data      AlbMin  /0.94/
-C +...          AlbMin:  Albedo   Minimum / visible (0.3--0.8 micrometers)
- 
-      data      HSnoSV  /0.01/
-C +...          HSnoSV:  Snow     Thickness through witch
-C +                      Albedo is interpolated to Ice  Albedo
-      data      HIceSV  /0.10/
-C +...          HIceSV:  Snow/Ice Thickness through witch
-C +                      Albedo is interpolated to Soil Albedo
-      data      doptmx  /2.3e-3/
-C +...          doptmx:  Maximum  optical Diameter    (pi * R**2)        [m]
-C +
-      data      czeMAX  /0.173648178/  ! 80.deg (Segal et al., 1991 JAS)
-
-      data      bsegal  /4.00       /  !
-      data      albmax  /0.99       /  ! Albedo max
-
-C +-- wavelength limits [m] for each broad band
-
-      data      l1min/400.0e-9/,l1max/800.0e-9/
-      data      l2min/800.0e-9/,l2max/1500.0e-9/
-      data      l3min/1500.0e-9/,l3max/2800.0e-9/
-
-      data      l6min/185.0e-9,250.0e-9,400.0e-9,
-     .               690.0e-9,1190.0e-9,2380.0e-9/
-      data      l6max/250.0e-9,400.0e-9,
-     .          690.0e-9,1190.0e-9,2380.0e-9,4000.0e-9/
- 
- 
-C +--Snow Grain optical Size
-C +  =======================
- 
-        DO ikl=1,knonv
-         DO   isn=1,max(1,isnoSV(ikl))
- 
-          G2snSV(ikl,isn) =  max(epsi,G2snSV(ikl,isn))
-C +...    Avoid non physical Values
- 
-          SignG1          = sign(unun,G1snSV(ikl,isn))
-          Sph_OK          =  max(zero,SignG1)
- 
-          SnOpSV(ikl,isn) =   1.e-4 *
-C +...    SI:           (from 1/10 mm to m)
- 
- 
-C +--Contribution of Non Dendritic Snow
-C +  ----------------------------------
- 
-     .    (    Sph_OK *(      G2snSV(ikl,isn)*G1snSV(ikl,isn)/G1_dSV
-     .              +max(demi*G2snSV(ikl,isn),DFcdSV)
-     .                 *(unun-G1snSV(ikl,isn)                /G1_dSV))
- 
- 
-C +--Contribution of     Dendritic Snow
-C +  ----------------------------------
- 
-     .    +(1.-Sph_OK)*(     -G1snSV(ikl,isn)*DDcdSV         /G1_dSV
-     .                 +(unun+G1snSV(ikl,isn)                /G1_dSV)
-     .                  *    (G2snSV(ikl,isn)*DScdSV         /G1_dSV
-     .                 +(unun-G2snSV(ikl,isn)                /G1_dSV)
-     .                                       *DFcdSV                 )))
-          SnOpSV(ikl,isn) =  max(zero,SnOpSV(ikl,isn))
-
-C + --For outputs (Etienne)
-C + ------------------------
-          DOPsnSV(ikl,isn)=SnOpSV(ikl,isn)
-        END DO
-      END DO
- 
-
-
- 
-C +--Snow/Ice Albedo
-C +  ===============
-
- 
- 
-C +--Uppermost effective Snow Layer
-C +  ------------------------------
- 
-        DO ikl=1,knonv
- 
-          isn   =  max(iun,isnoSV(ikl))
- 
-          SignRo = sign(unun, rocdSV - ro__SV(ikl,isn))
-          SnowOK =  max(zero,SignRo) ! Ice Density Threshold
- 
-          OpSqrt = sqrt(SnOpSV(ikl,isn))
- 
-cCA    +--Correction of snow albedo for Antarctica/Greenland
-cCA       --------------------------------------------------
-
-          
-          albCor = correc_alb 
-c #GL     albCor = 1.01
-c #AC    albCor = 1.01
-
-
-          IF (iflag_albcalc .GE. 1) THEN  ! Albedo calculation according to Kokhanovsky and Zege 2004
-
-          dalbed = 0.0
-          doptic=SnOpSV(ikl,isn)
-          csza=coszSV(ikl)
-
-          CALL albedo_kokhanovsky(l1min,l1max,csza,doptic,albSn1)
-          CALL albedo_kokhanovsky(l2min,l2max,csza,doptic,albSn2)
-          CALL albedo_kokhanovsky(l3min,l3max,csza,doptic,albSn3)
-
-          DO i=1,6
-             lmintmp=l6min(i)
-             lmaxtmp=l6max(i)
-             CALL albedo_kokhanovsky(lmintmp,lmaxtmp,csza,doptic,albtmp)
-             albSn6(i)=albtmp
-          ENDDO
-
-
-          ELSE ! Default calculation in SISVAT
-
-!    Zenith Angle Correction (Segal et al.,         1991, JAS 48, p.1025)
-!--------------------------- (Wiscombe & Warren, dec1980, JAS   , p.2723)
-!                            (Warren,               1982,  RG   , p.  81)
-!                            -------------------------------------------------
-          
-          dalbed = 0.0
-
-          csegal = max(czemax                   ,coszSV(ikl))
-c #cz     dalbeS =   ((bsegal+unun)/(unun+2.0*bsegal*csegal)
-c #cz.                -       unun                          )*0.32
-c #cz.              /  bsegal
-c #cz     dalbeS = max(dalbeS,zero)
-c #cz     dalbed =     dalbeS      *       min(1,isnoSV(ikl))
- 
-          dalbeW =(0.64 - csegal  )*0.0625  ! Warren 1982, RevGeo, fig.12b
-                                            ! 0.0625 = 5% * 1/0.8,   p.81
-                                            ! 0.64   = cos(50)
-          dalbed =     dalbeW      *       min(1,isnoSV(ikl))
-!-------------------------------------------------------------------------
-
-          albSn1 =  0.96-1.580*OpSqrt
-          albSn1 =  max(albSn1,AlbMin)
- 
-          albSn1 =  max(albSn1,zero)
-          albSn1 =  min(albSn1*albCor,unun)
- 
-          albSn2 =  0.95-15.40*OpSqrt
-          albSn2 =  max(albSn2,zero)
-          albSn2 =  min(albSn2*albCor,unun)
- 
-          doptic =  min(SnOpSV(ikl,isn),doptmx)
-          albSn3 =  346.3*doptic -32.31*OpSqrt +0.88
-          albSn3 =  max(albSn3,zero)
-          albSn3 =  min(albSn3*albCor,unun)
- 
-          albSn6(1:3)=albSn1
-          albSn6(4:6)=albSn2
-
-          !snow albedo corection if wetsnow
-c #GL     albSn1 =  albSn1*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
-c #GL     albSn2 =  albSn2*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
-c #GL     albSn3 =  albSn3*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
-
-          ENDIF
-
- 
-          albSno =  So1dSV*albSn1
-     .           +  So2dSV*albSn2
-     .           +  So3dSV*albSn3
- 
-cXF
-          minalb =  (aI2dSV + (aI3dSV -aI2dSV)
-     .           *  (ro__SV(ikl,isn)-ro_Ice)/(roSdSV-ro_Ice))
-          minalb =  min(aI3dSV,max(aI2dSV,minalb)) ! pure/firn albedo
- 
-          SnowOK =  SnowOK*max(zero,sign(unun,     albSno-minalb))
-          albSn1 =  SnowOK*albSn1+(1.0-SnowOK)*max(albSno,minalb)
-          albSn2 =  SnowOK*albSn2+(1.0-SnowOK)*max(albSno,minalb)
-          albSn3 =  SnowOK*albSn3+(1.0-SnowOK)*max(albSno,minalb)
-          albSn6(:) =  SnowOK*albSn6(:)+(1.0-SnowOK)*max(albSno,minalb)
-
- 
-c +           ro < roSdSV |          min al > aI3dSV
-c +  roSdSV < ro < rocdSV | aI2dSV < min al < aI3dSV (fct of density)
- 
- 
-C +--Snow/Ice Pack Thickness
-C +  -----------------------
- 
-          isn    =    max(min(isnoSV(ikl) ,ispiSV(ikl)),0)
-          Snow_H =  zzsnsv(ikl,isnoSV(ikl))-zzsnsv(ikl,isn)
-          SIce_H =  zzsnsv(ikl,isnoSV(ikl))
-          SnownH =  Snow_H  /  HSnoSV
-          SnownH =  min(unun,  SnownH)
-          SIcenH =  SIce_H  / (HIceSV)
-          SIcenH =  min(unun,  SIcenH)
- 
-C +       The value of SnownH is set to 1 in case of ice lenses above
-C +       1m of dry snow (ro<600kg/m3) for using CROCUS albedo
- 
-c         ro_ave =  0.
-c         dz_ave =  0.
-c         SnowOK =  1.
-c      do isn    =  isnoSV(ikl),1,-1
-c         ro_ave =  ro_ave + ro__SV(ikl,isn) * dzsnSV(ikl,isn) * SnowOK
-c         dz_ave =  dz_ave +                   dzsnSV(ikl,isn) * SnowOK
-c         SnowOK =  max(zero,sign(unun,1.-dz_ave))
-c      enddo
- 
-c         ro_ave =  ro_ave / max(dz_ave,epsi)
-c         SnowOK =  max(zero,sign(unun,600.-ro_ave))
-c         SnownH =  SnowOK + SnownH * (1. - SnowOK)
- 
-C +--Integrated Snow/Ice Albedo: Case of Water on Bare Ice
-C +  -----------------------------------------------------
- 
-          isn    =  max(min(isnoSV(ikl) ,ispiSV(ikl)),0)
- 
-          albWIc =  aI1dSV-(aI1dSV-aI2dSV)
-     .           *  exp(-(rusnSV(ikl)                      !
-     .           *  (1. -SWS_SV(ikl)                       ! 0 <=> freezing
-     .           *  (1  -min(1,iabs(isn-isnoSV(ikl)))))    ! 1 <=> isn=isnoSV
-     .           /   ru_dSV)**0.50)                        !
-c         albWIc = max(aI1dSV,min(aI2dSV,albWIc+slopSV(ikl)*
-c    .             min(5.,max(1.,dx/10000.))))
- 
-          SignRo = sign(unun,ro_Ice-5.-ro__SV(ikl,isn))    ! RoSN<920kg/m3
-          SnowOK =  max(zero,SignRo)
- 
-          albWIc = (1. - SnowOK) * albWIc + SnowOK
-     .           * (aI2dSV + (aI3dSV -aI2dSV)
-     .           * (ro__SV(ikl,isn)-ro_Ice)/(roSdSV-ro_Ice))
- 
-c +  rocdSV < ro < ro_ice | aI2dSV< al <aI3dSV (fct of density)
-c +           ro > ro_ice | aI1dSV< al <aI2dSV (fct of superficial water content
- 
- 
-C +--Integrated Snow/Ice      Albedo
-C +  -------------------------------
- 
-          a_SII1      =     albWIc      +(albSn1-albWIc)     *SnownH
-          a_SII1      = min(a_SII1       ,albSn1)
- 
-          a_SII2      =     albWIc      +(albSn2-albWIc)     *SnownH
-          a_SII2      = min(a_SII2       ,albSn2)
- 
-          a_SII3      =     albWIc      +(albSn3-albWIc)     *SnownH
-          a_SII3      = min(a_SII3       ,albSn3)
-
-          DO i=1,6
-          a_SII6(i)   = albWIc      +(albSn6(i)-albWIc)     *SnownH
-          a_SII6(i)   = min(a_SII6(i)       ,albSn6(i))
-          ENDDO
-
-cc #AG     agesno =      min(agsnSV(ikl,isn)          ,AgeMax)
-cc #AG     a_SII1      =     a_SII1      -0.175*agesno/AgeMax
-C +...                                   Impurities: Col de Porte Parameter.
- 
-
- 
-C +--Elsewhere    Integrated Snow/Ice Albedo
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-c #cp     ELSE
-            albSII =     So1dSV*a_SII1
-     .                 + So2dSV*a_SII2
-     .                 + So3dSV*a_SII3
-c #cp     END IF
- 
- 
-C +--Integrated Snow/Ice/Soil Albedo
-C +  -------------------------------
- 
-            alb1sv(ikl) =     albssv(ikl) +(a_SII1-albssv(ikl))*SIcenH
-            alb1sv(ikl) = min(alb1sv(ikl)  ,a_SII1)
- 
-            alb2sv(ikl) =     albssv(ikl) +(a_SII2-albssv(ikl))*SIcenH
-            alb2sv(ikl) = min(alb2sv(ikl)  ,a_SII2)
- 
-            alb3sv(ikl) =     albssv(ikl) +(a_SII3-albssv(ikl))*SIcenH
-            alb3sv(ikl) = min(alb3sv(ikl)  ,a_SII3)
-
-            albisv(ikl) =     albssv(ikl) +(albSII-albssv(ikl))*SIcenH
-            albisv(ikl) = min(albisv(ikl)  ,albSII)
-
-            DO i=1,6
-            alb6sv(ikl,i) = albssv(ikl) +(a_SII6(i)-albssv(ikl))*SIcenH
-            alb6sv(ikl,i) = min(alb6sv(ikl,i)  ,a_SII6(i))
-            ENDDO
-
- 
-C +--Integrated Snow/Ice/Soil Albedo: Clouds Correction! Greuell & all., 1994
-C +  --------------------------------------------------! Glob.&t Planet.Change
-                                                       ! (9):91-114
-            alb1sv(ikl) = alb1sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
-     .                  + dalbed      *    (1.-cld_SV(ikl))
-            alb2sv(ikl) = alb2sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
-     .                  + dalbed      *    (1.-cld_SV(ikl))
-            alb3sv(ikl) = alb3sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
-     .                  + dalbed      *    (1.-cld_SV(ikl))
-            alb6sv(ikl,:) =alb6sv(ikl,:)+0.05 *(cld_SV(ikl)-0.5)*SIcenH
-     .                  + dalbed      *    (1.-cld_SV(ikl))
-            albisv(ikl) = albisv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
-     .                  + dalbed      *    (1.-cld_SV(ikl))
- 
-C +--Integrated Snow/Ice/Soil Albedo: Minimum snow albedo = aI1dSV
-C +  -------------------------------------------------------------
- 
-            albedo_old  = albisv(ikl)
-            albisv(ikl) = max(albisv(ikl),aI1dSV   * SIcenH
-     .                  + albssv(ikl) *(1.0        - SIcenH))
-            alb1sv(ikl) = alb1sv(ikl) - 1.0/3.0             ! 33 %
-     .                  * (albedo_old-albisv(ikl)) / So1dSV
-            alb2sv(ikl) = alb2sv(ikl) - 1.0/3.0             ! 33 %
-     .                  * (albedo_old-albisv(ikl)) / So2dSV
-            alb3sv(ikl) = alb3sv(ikl) - 1.0/3.0             ! 33 %
-     .                  * (albedo_old-albisv(ikl)) / So3dSV
-            alb6sv(ikl,1:3) = alb6sv(ikl,1:3) - 1.0/6.0     ! 16 %
-     .                  * (albedo_old-albisv(ikl)) / (So1dSV/3)
-            alb6sv(ikl,4:6) = alb6sv(ikl,4:6) - 1.0/6.0     ! 16 %
-     .                  * (albedo_old-albisv(ikl)) / (So2dSV/3)
-
-
-C +--Integrated Snow/Ice/Soil Albedo: Maximum albedo = 95% 
-C +  -----------------------------------------------------
- 
-            albedo_old  = albisv(ikl)
-            albisv(ikl) = min(albisv(ikl),0.95)
-            alb1sv(ikl) = alb1sv(ikl) - 1.0/3.0             ! 33 %
-     .                  * (albedo_old-albisv(ikl)) / So1dSV
-            alb2sv(ikl) = alb2sv(ikl) - 1.0/3.0             ! 33 %
-     .                  * (albedo_old-albisv(ikl)) / So2dSV
-            alb3sv(ikl) = alb3sv(ikl) - 1.0/3.0             ! 33 %
-     .                  * (albedo_old-albisv(ikl)) / So3dSV
-            alb6sv(ikl,1:3) = alb6sv(ikl,1:3) - 1.0/6.0     ! 16 %
-     .                  * (albedo_old-albisv(ikl)) / (So1dSV/3)
-            alb6sv(ikl,4:6) = alb6sv(ikl,4:6) - 1.0/6.0     ! 16 %
-     .                  * (albedo_old-albisv(ikl)) / (So2dSV/3)
-
-
-	!Sea Ice/snow permanent-interractive prescription from Nemo 
-	!AO_CK 20/02/2020
-
-        ! No check if coupling update since MAR and NEMO albedo are too different
-	! and since MAR albedo is computed on properties that are not in NEMO
-        ! prescription for each time step with NEMO values 
-	
-c #AO      if (LSmask(ikl) .eq. 0 .and. coupling_ao .eq. .true.) then 
-c #AO       if (AOmask(ikl) .eq. 0) then  
-c #AO       albisv(ikl) =  (1.-AOmask(ikl))* albAOsisv(ikl)
-c #AO.                    +(AOmask(ikl)*albisv(ikl))
-c #AO       alb1sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
-c #AO.                    +(AOmask(ikl)*alb1sv(ikl))
-c #AO       alb2sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
-c #AO.                    +(AOmask(ikl)*alb2sv(ikl))
-c #AO       alb3sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
-c #AO.                    +(AOmask(ikl)*alb3sv(ikl))
-c #AO       endif
-c #AO      endif
-
- 
-            alb1sv(ikl) = min(max(zero,alb1sv(ikl)),albmax)
-            alb2sv(ikl) = min(max(zero,alb2sv(ikl)),albmax)
-            alb3sv(ikl) = min(max(zero,alb3sv(ikl)),albmax)
-            
-            DO i=1,6
-                alb6sv(ikl,i) = min(max(zero,alb6sv(ikl,i)),albmax)
-            ENDDO 
-        END DO
- 
- 
-C +--Extinction Coefficient: Exponential Factor
-C +  ==========================================
- 
-        DO ikl=1,knonv
-          sExt_1(ikl)        = 1.
-          sExt_2(ikl)        = 1.
-          sExt_3(ikl)        = 1.
-          sEX_sv(ikl,nsno+1) = 1.
- 
-          coalb1(ikl) = (1.          -alb1sv(ikl))*So1dSV
-          coalb2(ikl) = (1.          -alb2sv(ikl))*So2dSV
-          coalb3(ikl) = (1.          -alb3sv(ikl))*So3dSV
-          coalbm      =  coalb1(ikl) +coalb2(ikl) +coalb3(ikl)
-          coalb1(ikl) =  coalb1(ikl)              /coalbm
-          coalb2(ikl) =  coalb2(ikl)              /coalbm
-          coalb3(ikl) =  coalb3(ikl)              /coalbm
-        END DO
- 
-cXF
- 
-        DO   isn=nsno,1,-1
-          DO ikl=1,knonv
-            sEX_sv(ikl,isn) = 1.0
-           !sEX_sv(ikl,isn) = 0.95 ! if MAR is too warm in summer
-          END DO
-        END DO
- 
-        DO ikl=1,knonv
-         DO isn=max(1,isnoSV(ikl)),1,-1
- 
-          SignRo = sign(unun, rocdSV - ro__SV(ikl,isn))
-          SnowOK =  max(zero,SignRo) ! Ice Density Threshold
- 
-          RoFrez =  1.e-3      * ro__SV(ikl,isn) * (1.0-eta_SV(ikl,isn))
- 
-          OpSqrt = sqrt(max(epsi,SnOpSV(ikl,isn)))
-          exarg1 =      SnowOK  *1.e2 *max(sbeta1*RoFrez/OpSqrt,sbeta2)
-     .            +(1.0-SnowOK)           *sbeta5
-          exarg2 =      SnowOK  *1.e2 *max(sbeta3*RoFrez/OpSqrt,sbeta4)
-     .            +(1.0-SnowOK)           *sbeta5
-          exarg3 =      SnowOK  *1.e2     *sbeta5
-     .            +(1.0-SnowOK)           *sbeta5
- 
- 
-C +--Integrated Extinction of Solar Irradiance (Normalized Value)
-C +  ============================================================
- 
-          sExt_1(ikl) = sExt_1(ikl)
-     .                          * exp(min(0.0,-exarg1 *dzsnSV(ikl,isn)))
-          sign_0      =              sign(unun,eps9   -sExt_1(ikl))
-          sExt_0      =               max(zero,sign_0)*sExt_1(ikl)
-          sExt_1(ikl) = sExt_1(ikl)                   -sExt_0
- 
-          sExt_2(ikl) = sExt_2(ikl)
-     .                          * exp(min(0.0,-exarg2 *dzsnSV(ikl,isn)))
-          sign_0      =              sign(unun,eps9   -sExt_2(ikl))
-          sExt_0      =               max(zero,sign_0)*sExt_2(ikl)
-          sExt_2(ikl) = sExt_2(ikl)                   -sExt_0
- 
-          sExt_3(ikl) = sExt_3(ikl)
-     .                          * exp(min(0.0,-exarg3 *dzsnSV(ikl,isn)))
-          sign_0      =              sign(unun,eps9   -sExt_3(ikl))
-          sExt_0      =               max(zero,sign_0)*sExt_3(ikl)
-          sExt_3(ikl) = sExt_3(ikl)                   -sExt_0
- 
-          sEX_sv(ikl,isn) = coalb1(ikl) * sExt_1(ikl)
-     .                    + coalb2(ikl) * sExt_2(ikl)
-     .                    + coalb3(ikl) * sExt_3(ikl)
-        END DO
-      END DO
- 
-      DO   isn=0,-nsol,-1
-        DO ikl=1,knonv
-          sEX_sv(ikl,isn) = 0.0
-        END DO
-      END DO
- 
- 
-      return
-
-
-      end
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-      SUBROUTINE albedo_kokhanovsky(lambdamin,lambdamax,
-     .                              cossza,dopt,albint)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-! Authors: Hajar El Habchi El Fenniri, Etienne Vignon, Cecile Agosta
-!          Ghislain Picard
-! Routine that calculates the  integrated snow spectral albedo between 
-! lambdamin and lambdamax following Kokhanisky and Zege 2004,
-! Scattering optics of snow, Applied Optics, Vol 43, No7 
-! Code inspired from the snowoptics package of Ghislain Picard:
-! https://github.com/ghislainp/snowoptics
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-       
-      USE VARphy
-
-      IMPLICIT NONE
-
-! Inputs
-!--------
-      REAL lambdamin   ! minimum wavelength for integration [m]
-      REAL lambdamax   ! maximum wavelength for integration [m] 
-      REAL cossza     ! solar zenith angle cosinus
-      REAL dopt        ! optical diameter [m]
-
-!Outputs
-!-------
-      REAL albint
-
-! Local Variables
-!-----------------
-
-      REAL ropt,cosalb,norm,Pas
-      REAL SSA,alpha,gamm,R,cos30,alb30
-      INTEGER i
-
-
-      REAL B_amp                       ! amplification factor
-      PARAMETER (B_amp=1.6)  
-
-      REAL g_asy                       ! asymetry factor 
-      PARAMETER (g_asy=0.845)
-
-      INTEGER nlambda                  ! length of wavelength vector 
-      PARAMETER(nlambda=200)
-
-      REAL lmin
-      PARAMETER(lmin=185.0E-9)
-
-      REAL lmax
-      PARAMETER(lmax=4000.0E-9)
-
-      REAL albmax
-      PARAMETER(albmax=0.99)
-
-      REAL wavelengths(nlambda)
-      REAL ni(nlambda)
-
-      DATA wavelengths / 1.85000000e-07, 2.04170854e-07,
-     . 2.23341709e-07, 2.42512563e-07,
-     . 2.61683417e-07, 2.80854271e-07, 3.00025126e-07, 3.19195980e-07,
-     . 3.38366834e-07, 3.57537688e-07, 3.76708543e-07, 3.95879397e-07,
-     . 4.15050251e-07, 4.34221106e-07, 4.53391960e-07, 4.72562814e-07,
-     . 4.91733668e-07, 5.10904523e-07, 5.30075377e-07, 5.49246231e-07,
-     . 5.68417085e-07, 5.87587940e-07, 6.06758794e-07, 6.25929648e-07,
-     . 6.45100503e-07, 6.64271357e-07, 6.83442211e-07, 7.02613065e-07,
-     . 7.21783920e-07, 7.40954774e-07, 7.60125628e-07, 7.79296482e-07,
-     . 7.98467337e-07, 8.17638191e-07, 8.36809045e-07, 8.55979899e-07,
-     . 8.75150754e-07, 8.94321608e-07, 9.13492462e-07, 9.32663317e-07,
-     . 9.51834171e-07, 9.71005025e-07, 9.90175879e-07, 1.00934673e-06,
-     . 1.02851759e-06, 1.04768844e-06, 1.06685930e-06, 1.08603015e-06,
-     . 1.10520101e-06, 1.12437186e-06, 1.14354271e-06, 1.16271357e-06,
-     . 1.18188442e-06, 1.20105528e-06, 1.22022613e-06, 1.23939698e-06,
-     . 1.25856784e-06, 1.27773869e-06, 1.29690955e-06, 1.31608040e-06,
-     . 1.33525126e-06, 1.35442211e-06, 1.37359296e-06, 1.39276382e-06,
-     . 1.41193467e-06, 1.43110553e-06, 1.45027638e-06, 1.46944724e-06,
-     . 1.48861809e-06, 1.50778894e-06, 1.52695980e-06, 1.54613065e-06,
-     . 1.56530151e-06, 1.58447236e-06, 1.60364322e-06, 1.62281407e-06,
-     . 1.64198492e-06, 1.66115578e-06, 1.68032663e-06, 1.69949749e-06,
-     . 1.71866834e-06, 1.73783920e-06, 1.75701005e-06, 1.77618090e-06,
-     . 1.79535176e-06, 1.81452261e-06, 1.83369347e-06, 1.85286432e-06,
-     . 1.87203518e-06, 1.89120603e-06, 1.91037688e-06, 1.92954774e-06,
-     . 1.94871859e-06, 1.96788945e-06, 1.98706030e-06, 2.00623116e-06,
-     . 2.02540201e-06, 2.04457286e-06, 2.06374372e-06, 2.08291457e-06,
-     . 2.10208543e-06, 2.12125628e-06, 2.14042714e-06, 2.15959799e-06,
-     . 2.17876884e-06, 2.19793970e-06, 2.21711055e-06, 2.23628141e-06,
-     . 2.25545226e-06, 2.27462312e-06, 2.29379397e-06, 2.31296482e-06,
-     . 2.33213568e-06, 2.35130653e-06, 2.37047739e-06, 2.38964824e-06,
-     . 2.40881910e-06, 2.42798995e-06, 2.44716080e-06, 2.46633166e-06,
-     . 2.48550251e-06, 2.50467337e-06, 2.52384422e-06, 2.54301508e-06,
-     . 2.56218593e-06, 2.58135678e-06, 2.60052764e-06, 2.61969849e-06,
-     . 2.63886935e-06, 2.65804020e-06, 2.67721106e-06, 2.69638191e-06,
-     . 2.71555276e-06, 2.73472362e-06, 2.75389447e-06, 2.77306533e-06,
-     . 2.79223618e-06, 2.81140704e-06, 2.83057789e-06, 2.84974874e-06,
-     . 2.86891960e-06, 2.88809045e-06, 2.90726131e-06, 2.92643216e-06,
-     . 2.94560302e-06, 2.96477387e-06, 2.98394472e-06, 3.00311558e-06,
-     . 3.02228643e-06, 3.04145729e-06, 3.06062814e-06, 3.07979899e-06,
-     . 3.09896985e-06, 3.11814070e-06, 3.13731156e-06, 3.15648241e-06,
-     . 3.17565327e-06, 3.19482412e-06, 3.21399497e-06, 3.23316583e-06,
-     . 3.25233668e-06, 3.27150754e-06, 3.29067839e-06, 3.30984925e-06,
-     . 3.32902010e-06, 3.34819095e-06, 3.36736181e-06, 3.38653266e-06,
-     . 3.40570352e-06, 3.42487437e-06, 3.44404523e-06, 3.46321608e-06,
-     . 3.48238693e-06, 3.50155779e-06, 3.52072864e-06, 3.53989950e-06,
-     . 3.55907035e-06, 3.57824121e-06, 3.59741206e-06, 3.61658291e-06,
-     . 3.63575377e-06, 3.65492462e-06, 3.67409548e-06, 3.69326633e-06,
-     . 3.71243719e-06, 3.73160804e-06, 3.75077889e-06, 3.76994975e-06,
-     . 3.78912060e-06, 3.80829146e-06, 3.82746231e-06, 3.84663317e-06,
-     . 3.86580402e-06, 3.88497487e-06, 3.90414573e-06, 3.92331658e-06,
-     . 3.94248744e-06, 3.96165829e-06, 3.98082915e-06, 4.00000000e-06/
-
-
-      DATA ni /7.74508407e-10, 7.74508407e-10, 
-     .  7.74508407e-10, 7.74508407e-10,
-     .  7.74508407e-10, 7.74508407e-10, 7.74508407e-10, 7.74508407e-10,
-     .  6.98381122e-10, 6.23170274e-10, 5.97655992e-10, 5.84106004e-10,
-     .  5.44327597e-10, 5.71923510e-10, 6.59723827e-10, 8.05183870e-10,
-     .  1.03110161e-09, 1.36680386e-09, 1.85161253e-09, 2.56487751e-09,
-     .  3.56462855e-09, 4.89450926e-09, 6.49252022e-09, 9.62029335e-09,
-     .  1.32335015e-08, 1.75502184e-08, 2.19240625e-08, 3.03304156e-08,
-     .  4.07715972e-08, 5.00414911e-08, 7.09722331e-08, 1.00773751e-07,
-     .  1.31427409e-07, 1.42289041e-07, 1.49066787e-07, 2.01558515e-07,
-     .  2.99106105e-07, 4.03902086e-07, 4.54292169e-07, 5.21906983e-07,
-     .  6.27643362e-07, 9.43955678e-07, 1.33464494e-06, 1.97278315e-06,
-     .  2.31801329e-06, 2.20584676e-06, 1.85568138e-06, 1.73395193e-06,
-     .  1.73101406e-06, 1.91333936e-06, 2.26413019e-06, 3.23959718e-06,
-     .  4.94316963e-06, 6.89378896e-06, 1.02237444e-05, 1.21439656e-05,
-     .  1.31567585e-05, 1.33448288e-05, 1.32000000e-05, 1.31608040e-05,
-     .  1.33048369e-05, 1.40321464e-05, 1.51526244e-05, 1.80342858e-05,
-     .  3.82875736e-05, 1.07325259e-04, 2.11961637e-04, 3.82008054e-04,
-     .  5.30897470e-04, 5.29244735e-04, 4.90876605e-04, 4.33905427e-04,
-     .  3.77795349e-04, 3.17633099e-04, 2.81078564e-04, 2.57579485e-04,
-     .  2.42203100e-04, 2.23789060e-04, 2.04306870e-04, 1.87909255e-04,
-     .  1.73117146e-04, 1.61533186e-04, 1.53420328e-04, 1.47578033e-04,
-     .  1.42334776e-04, 1.35691466e-04, 1.30495414e-04, 1.36065123e-04,
-     .  1.70928821e-04, 2.66389730e-04, 4.80957955e-04, 8.25041961e-04,
-     .  1.21654792e-03, 1.50232875e-03, 1.62316078e-03, 1.61649750e-03,
-     .  1.53736801e-03, 1.42343711e-03, 1.24459117e-03, 1.02388611e-03,
-     .  7.89112523e-04, 5.97204264e-04, 4.57152413e-04, 3.62341259e-04,
-     .  2.99128332e-04, 2.57035569e-04, 2.26992203e-04, 2.07110355e-04,
-     .  2.05835688e-04, 2.25108810e-04, 2.64262893e-04, 3.23594011e-04,
-     .  3.93061117e-04, 4.62789970e-04, 5.19664416e-04, 5.59739628e-04,
-     .  5.93476084e-04, 6.22797885e-04, 6.57484833e-04, 6.92849600e-04,
-     .  7.26584901e-04, 7.56604648e-04, 7.68009488e-04, 7.65579073e-04,
-     .  7.50526164e-04, 7.39809972e-04, 7.55622847e-04, 8.05099514e-04,
-     .  9.67279246e-04, 1.16281559e-03, 1.42570247e-03, 2.04986585e-03,
-     .  2.93971170e-03, 4.49827711e-03, 7.32537532e-03, 1.18889734e-02,
-     .  1.85851805e-02, 2.86242532e-02, 4.34131035e-02, 6.37828307e-02,
-     .  9.24145850e-02, 1.35547945e-01, 1.94143245e-01, 2.54542814e-01,
-     .  3.02282024e-01, 3.42214181e-01, 3.85475065e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01,
-     .  4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01/
-
-
-      Pas     =(lmax-lmin)/nlambda
-      ropt    = dopt/2.0
-      SSA     = 3.0/(rhoIce*ropt)
-      cos30   = cos(30.0/180.0*pi)
-
-
-      albint=0.
-      norm=0.
-        
-      DO i = 1,nlambda
-          gamm = 4.0 * pi * ni(i) / wavelengths(i)
-          cosalb = 2.0 / (SSA * rhoice) * B_amp * gamm
-          alpha = 16. / 3 * cosalb / (1.0 - g_asy)
-          R = exp(-(alpha**0.5) * 3.0 / 7.0 * (1.0 + 2.0 * cossza))
-          alb30 = exp(-(alpha**0.5)* 3.0 / 7.0 * (1.0 + 20 * cos30))
-
-          IF ((wavelengths(i).GE.lambdamin).AND.
-     .       (wavelengths(i).LT.lambdamax)) THEN
-          albint=albint+R*Pas  ! rectangle integration -> can be improved with trapezintegration
-          norm=norm+Pas
-          ENDIF
-
-      END DO
-
-      albint=max(0.,min(albint/max(norm,1E-10),albmax))
-
-      END
-  
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_sno_albedo.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_sno_albedo.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_sno_albedo.f90	(revision 5246)
@@ -0,0 +1,765 @@
+subroutine SnOptP(jjtime)
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR/SISVAT   SnOptP                                    12-08-2019  MAR |
+  ! |   SubRoutine SnOptP computes the Snow Pack optical Properties          |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     Grid Boxes       |
+  ! |                     X       Number of Mosaic Cell per Grid Box         |
+  ! |                                                                        |
+  ! |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |   ^^^^^    ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+  ! |                                                                        |
+  ! |                                                                        |
+  ! |   INPUT:   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+  ! |   ^^^^^    G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+  ! |            agsnSV   : Snow       Age                             [day] |
+  ! |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
+  ! |            eta_SV   : Water      Content                       [m3/m3] |
+  ! |            rusnSV   : Surficial  Water   Thickness   [kg/m2] .OR. [mm] |
+  ! |            SWS_SV   : Surficial  Water   Status                        |
+  ! |            dzsnSV   : Snow       Layer   Thickness                 [m] |
+  ! |                                                                        |
+  ! |            albssv   : Soil       Albedo                            [-] |
+  ! |            zzsnsv   : Snow       Pack    Thickness                 [m] |
+  ! |                                                                        |
+  ! |   OUTPUT:  albisv   : Snow/Ice/Water/Soil Integrated Albedo        [-] |
+  ! |   ^^^^^^   sEX_sv   : Verticaly Integrated Extinction Coefficient      |
+  ! |            DOPsnSV   : Snow Optical diameter [m]                       |
+  ! |                                                                        |
+  ! |   Internal Variables:                                                  |
+  ! |   ^^^^^^^^^^^^^^^^^^                                                   |
+  ! |            SnOpSV   : Snow Grain optical Size                      [m] |
+  ! |            EX1_sv   : Integrated Snow Extinction (0.3--0.8micr.m)      |
+  ! |            EX2_sv   : Integrated Snow Extinction (0.8--1.5micr.m)      |
+  ! |            EX3_sv   : Integrated Snow Extinction (1.5--2.8micr.m)      |
+  ! |                                                                        |
+  ! |   METHODE:    Calcul de la taille optique des grains ? partir de       |
+  ! |   ^^^^^^^    -leur type decrit par les deux variables descriptives     |
+  ! |                    continues sur la plage -99/+99 passees en appel.    |
+  ! |              -la taille optique (1/10mm) des etoiles,                  |
+  ! |                                          des grains fins et            |
+  ! |                                          des jeunes faces planes       |
+  ! |                                                                        |
+  ! |   METHOD:     Computation of the optical diameter of the grains        |
+  ! |   ^^^^^^      described with the CROCUS formalism G1snSV / G2snSV      |
+  ! |                                                                        |
+  ! |   REFERENCE: Brun et al.      1989, J. Glaciol 35 pp. 333--342         |
+  ! |   ^^^^^^^^^  Brun et al.      1992, J. Glaciol 38 pp.  13-- 22         |
+  ! |              Eric Martin Sept.1996                                     |
+  ! |                                                                        |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VARxSV
+  use VARySV
+  use VARtSV
+  USE surface_data, only: iflag_albcalc,correc_alb
+
+  IMPLICIT NONE
+
+
+  ! + -- INPUT
+  integer :: jjtime
+
+  ! +--Internal Variables
+  ! +  ==================
+
+  real :: coalb1(knonv)                      ! weighted Coalbedo, Vis.
+  real :: coalb2(knonv)                      ! weighted Coalbedo, nIR 1
+  real :: coalb3(knonv)                      ! weighted Coalbedo, nIR 2
+  real :: coalbm                             ! weighted Coalbedo, mean
+  real :: sExt_1(knonv)                      ! Extinction Coeff., Vis.
+  real :: sExt_2(knonv)                      ! Extinction Coeff., nIR 1
+  real :: sExt_3(knonv)                      ! Extinction Coeff., nIR 2
+  real :: SnOpSV(knonv,      nsno)           ! Snow Grain optical Size
+  ! #AG real      agesno
+
+  integer :: isn   ,ikl   ,isn1, i
+  real :: sbeta1,sbeta2,sbeta3,sbeta4,sbeta5
+  real :: AgeMax,AlbMin,HSnoSV,HIceSV,doptmx,SignG1,Sph_OK
+  real :: dalbed,dalbeS,dalbeW
+  real :: bsegal,czemax,csegal,csza
+  real :: RoFrez,DiffRo,SignRo,SnowOK,OpSqrt
+  real :: albSn1,albIc1,a_SnI1,a_SII1
+  real :: albSn2,albIc2,a_SnI2,a_SII2
+  real :: albSn3,albIc3,a_SnI3,a_SII3
+  real :: albSno,albIce,albSnI,albSII,albWIc,albmax
+  real :: doptic,Snow_H,SIce_H,SnownH,SIcenH
+  real :: exarg1,exarg2,exarg3,sign_0,sExt_0
+  real :: albedo_old,albCor
+  real :: ro_ave,dz_ave,minalb
+  real :: l1min,l1max,l2min,l2max,l3min,l3max
+  real :: l6min(6), l6max(6), albSn6(6), a_SII6(6)
+  real :: lmintmp,lmaxtmp,albtmp
+
+  ! +--Local   DATA
+  ! +  ============
+
+  ! +--For the computation of the solar irradiance extinction in snow
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  data      sbeta1/0.0192/,sbeta2/0.4000/,sbeta3/0.1098/
+  data      sbeta4/1.0000/
+  data      sbeta5/2.00e1/
+
+  ! +--Snow Age Maximum (Taiga, e.g. Col de Porte)
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  data      AgeMax  /60.0/
+  ! +...          AgeMax:  Snow Age Maximum                              [day]
+
+  data      AlbMin  /0.94/
+  ! +...          AlbMin:  Albedo   Minimum / visible (0.3--0.8 micrometers)
+
+  data      HSnoSV  /0.01/
+  ! +...          HSnoSV:  Snow     Thickness through witch
+  ! +                      Albedo is interpolated to Ice  Albedo
+  data      HIceSV  /0.10/
+  ! +...          HIceSV:  Snow/Ice Thickness through witch
+  ! +                      Albedo is interpolated to Soil Albedo
+  data      doptmx  /2.3e-3/
+  ! +...          doptmx:  Maximum  optical Diameter    (pi * R**2)        [m]
+  ! +
+  data      czeMAX  /0.173648178/  ! 80.deg (Segal et al., 1991 JAS)
+
+  data      bsegal  /4.00       /  !
+  data      albmax  /0.99       /  ! Albedo max
+
+  ! +-- wavelength limits [m] for each broad band
+
+  data      l1min/400.0e-9/,l1max/800.0e-9/
+  data      l2min/800.0e-9/,l2max/1500.0e-9/
+  data      l3min/1500.0e-9/,l3max/2800.0e-9/
+
+  data      l6min/185.0e-9,250.0e-9,400.0e-9, &
+        690.0e-9,1190.0e-9,2380.0e-9/
+  data      l6max/250.0e-9,400.0e-9, &
+        690.0e-9,1190.0e-9,2380.0e-9,4000.0e-9/
+
+
+  ! +--Snow Grain optical Size
+  ! +  =======================
+
+    DO ikl=1,knonv
+     DO   isn=1,max(1,isnoSV(ikl))
+
+      G2snSV(ikl,isn) =  max(epsi,G2snSV(ikl,isn))
+  ! +...    Avoid non physical Values
+
+      SignG1          = sign(unun,G1snSV(ikl,isn))
+      Sph_OK          =  max(zero,SignG1)
+
+      SnOpSV(ikl,isn) =   1.e-4 * &
+  ! +...    SI:           (from 1/10 mm to m)
+
+
+  ! +--Contribution of Non Dendritic Snow
+  ! +  ----------------------------------
+
+            (    Sph_OK *(      G2snSV(ikl,isn)*G1snSV(ikl,isn)/G1_dSV &
+            +max(demi*G2snSV(ikl,isn),DFcdSV) &
+            *(unun-G1snSV(ikl,isn)                /G1_dSV)) &
+
+
+  ! +--Contribution of     Dendritic Snow
+  ! +  ----------------------------------
+
+            +(1.-Sph_OK)*(     -G1snSV(ikl,isn)*DDcdSV         /G1_dSV &
+            +(unun+G1snSV(ikl,isn)                /G1_dSV) &
+            *    (G2snSV(ikl,isn)*DScdSV         /G1_dSV &
+            +(unun-G2snSV(ikl,isn)                /G1_dSV) &
+            *DFcdSV                 )))
+      SnOpSV(ikl,isn) =  max(zero,SnOpSV(ikl,isn))
+
+  ! + --For outputs (Etienne)
+  ! + ------------------------
+      DOPsnSV(ikl,isn)=SnOpSV(ikl,isn)
+    END DO
+  END DO
+
+
+
+
+  ! +--Snow/Ice Albedo
+  ! +  ===============
+
+
+
+  ! +--Uppermost effective Snow Layer
+  ! +  ------------------------------
+
+    DO ikl=1,knonv
+
+      isn   =  max(iun,isnoSV(ikl))
+
+      SignRo = sign(unun, rocdSV - ro__SV(ikl,isn))
+      SnowOK =  max(zero,SignRo) ! Ice Density Threshold
+
+      OpSqrt = sqrt(SnOpSV(ikl,isn))
+
+  !CA    +--Correction of snow albedo for Antarctica/Greenland
+  !CA       --------------------------------------------------
+
+
+      albCor = correc_alb
+  ! #GL     albCor = 1.01
+  ! #AC    albCor = 1.01
+
+
+      IF (iflag_albcalc .GE. 1) THEN  ! Albedo calculation according to Kokhanovsky and Zege 2004
+
+      dalbed = 0.0
+      doptic=SnOpSV(ikl,isn)
+      csza=coszSV(ikl)
+
+      CALL albedo_kokhanovsky(l1min,l1max,csza,doptic,albSn1)
+      CALL albedo_kokhanovsky(l2min,l2max,csza,doptic,albSn2)
+      CALL albedo_kokhanovsky(l3min,l3max,csza,doptic,albSn3)
+
+      DO i=1,6
+         lmintmp=l6min(i)
+         lmaxtmp=l6max(i)
+         CALL albedo_kokhanovsky(lmintmp,lmaxtmp,csza,doptic,albtmp)
+         albSn6(i)=albtmp
+      ENDDO
+
+
+      ELSE ! Default calculation in SISVAT
+
+  !    Zenith Angle Correction (Segal et al.,         1991, JAS 48, p.1025)
+  !--------------------------- (Wiscombe & Warren, dec1980, JAS   , p.2723)
+  !                            (Warren,               1982,  RG   , p.  81)
+                         ! -------------------------------------------------
+
+      dalbed = 0.0
+
+      csegal = max(czemax                   ,coszSV(ikl))
+  ! #cz     dalbeS =   ((bsegal+unun)/(unun+2.0*bsegal*csegal)
+  ! #cz.                -       unun                          )*0.32
+  ! #cz.              /  bsegal
+  ! #cz     dalbeS = max(dalbeS,zero)
+  ! #cz     dalbed =     dalbeS      *       min(1,isnoSV(ikl))
+
+      dalbeW =(0.64 - csegal  )*0.0625  ! Warren 1982, RevGeo, fig.12b
+                                        ! ! 0.0625 = 5% * 1/0.8,   p.81
+                                        ! ! 0.64   = cos(50)
+      dalbed =     dalbeW      *       min(1,isnoSV(ikl))
+  !-------------------------------------------------------------------------
+
+      albSn1 =  0.96-1.580*OpSqrt
+      albSn1 =  max(albSn1,AlbMin)
+
+      albSn1 =  max(albSn1,zero)
+      albSn1 =  min(albSn1*albCor,unun)
+
+      albSn2 =  0.95-15.40*OpSqrt
+      albSn2 =  max(albSn2,zero)
+      albSn2 =  min(albSn2*albCor,unun)
+
+      doptic =  min(SnOpSV(ikl,isn),doptmx)
+      albSn3 =  346.3*doptic -32.31*OpSqrt +0.88
+      albSn3 =  max(albSn3,zero)
+      albSn3 =  min(albSn3*albCor,unun)
+
+      albSn6(1:3)=albSn1
+      albSn6(4:6)=albSn2
+
+      ! !snow albedo corection if wetsnow
+  ! #GL     albSn1 =  albSn1*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
+  ! #GL     albSn2 =  albSn2*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
+  ! #GL     albSn3 =  albSn3*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
+
+      ENDIF
+
+
+      albSno =  So1dSV*albSn1 &
+            +  So2dSV*albSn2 &
+            +  So3dSV*albSn3
+
+  !XF
+      minalb =  (aI2dSV + (aI3dSV -aI2dSV) &
+            *  (ro__SV(ikl,isn)-ro_Ice)/(roSdSV-ro_Ice))
+      minalb =  min(aI3dSV,max(aI2dSV,minalb)) ! pure/firn albedo
+
+      SnowOK =  SnowOK*max(zero,sign(unun,     albSno-minalb))
+      albSn1 =  SnowOK*albSn1+(1.0-SnowOK)*max(albSno,minalb)
+      albSn2 =  SnowOK*albSn2+(1.0-SnowOK)*max(albSno,minalb)
+      albSn3 =  SnowOK*albSn3+(1.0-SnowOK)*max(albSno,minalb)
+      albSn6(:) =  SnowOK*albSn6(:)+(1.0-SnowOK)*max(albSno,minalb)
+
+
+  ! +           ro < roSdSV |          min al > aI3dSV
+  ! +  roSdSV < ro < rocdSV | aI2dSV < min al < aI3dSV (fct of density)
+
+
+  ! +--Snow/Ice Pack Thickness
+  ! +  -----------------------
+
+      isn    =    max(min(isnoSV(ikl) ,ispiSV(ikl)),0)
+      Snow_H =  zzsnsv(ikl,isnoSV(ikl))-zzsnsv(ikl,isn)
+      SIce_H =  zzsnsv(ikl,isnoSV(ikl))
+      SnownH =  Snow_H  /  HSnoSV
+      SnownH =  min(unun,  SnownH)
+      SIcenH =  SIce_H  / (HIceSV)
+      SIcenH =  min(unun,  SIcenH)
+
+  ! +       The value of SnownH is set to 1 in case of ice lenses above
+  ! +       1m of dry snow (ro<600kg/m3) for using CROCUS albedo
+
+      ! ro_ave =  0.
+      ! dz_ave =  0.
+      ! SnowOK =  1.
+   ! do isn    =  isnoSV(ikl),1,-1
+   !    ro_ave =  ro_ave + ro__SV(ikl,isn) * dzsnSV(ikl,isn) * SnowOK
+   !    dz_ave =  dz_ave +                   dzsnSV(ikl,isn) * SnowOK
+   !    SnowOK =  max(zero,sign(unun,1.-dz_ave))
+   ! enddo
+
+   !    ro_ave =  ro_ave / max(dz_ave,epsi)
+   !    SnowOK =  max(zero,sign(unun,600.-ro_ave))
+   !    SnownH =  SnowOK + SnownH * (1. - SnowOK)
+
+  ! +--Integrated Snow/Ice Albedo: Case of Water on Bare Ice
+  ! +  -----------------------------------------------------
+
+      isn    =  max(min(isnoSV(ikl) ,ispiSV(ikl)),0)
+
+      albWIc =  aI1dSV-(aI1dSV-aI2dSV) &
+            *  exp(-(rusnSV(ikl) & !
+            *  (1. -SWS_SV(ikl) & ! 0 <=> freezing
+            *  (1  -min(1,iabs(isn-isnoSV(ikl))))) & ! 1 <=> isn=isnoSV
+            /   ru_dSV)**0.50)                        !
+      ! albWIc = max(aI1dSV,min(aI2dSV,albWIc+slopSV(ikl)*
+  !    .             min(5.,max(1.,dx/10000.))))
+
+      SignRo = sign(unun,ro_Ice-5.-ro__SV(ikl,isn))    ! RoSN<920kg/m3
+      SnowOK =  max(zero,SignRo)
+
+      albWIc = (1. - SnowOK) * albWIc + SnowOK &
+            * (aI2dSV + (aI3dSV -aI2dSV) &
+            * (ro__SV(ikl,isn)-ro_Ice)/(roSdSV-ro_Ice))
+
+  ! +  rocdSV < ro < ro_ice | aI2dSV< al <aI3dSV (fct of density)
+  ! +           ro > ro_ice | aI1dSV< al <aI2dSV (fct of superficial water content
+
+
+  ! +--Integrated Snow/Ice      Albedo
+  ! +  -------------------------------
+
+      a_SII1      =     albWIc      +(albSn1-albWIc)     *SnownH
+      a_SII1      = min(a_SII1       ,albSn1)
+
+      a_SII2      =     albWIc      +(albSn2-albWIc)     *SnownH
+      a_SII2      = min(a_SII2       ,albSn2)
+
+      a_SII3      =     albWIc      +(albSn3-albWIc)     *SnownH
+      a_SII3      = min(a_SII3       ,albSn3)
+
+      DO i=1,6
+      a_SII6(i)   = albWIc      +(albSn6(i)-albWIc)     *SnownH
+      a_SII6(i)   = min(a_SII6(i)       ,albSn6(i))
+      ENDDO
+
+  !c #AG     agesno =      min(agsnSV(ikl,isn)          ,AgeMax)
+  !c #AG     a_SII1      =     a_SII1      -0.175*agesno/AgeMax
+  ! +...                                   Impurities: Col de Porte Parameter.
+
+
+
+  ! +--Elsewhere    Integrated Snow/Ice Albedo
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  ! #cp     ELSE
+        albSII =     So1dSV*a_SII1 &
+              + So2dSV*a_SII2 &
+              + So3dSV*a_SII3
+  ! #cp     END IF
+
+
+  ! +--Integrated Snow/Ice/Soil Albedo
+  ! +  -------------------------------
+
+        alb1sv(ikl) =     albssv(ikl) +(a_SII1-albssv(ikl))*SIcenH
+        alb1sv(ikl) = min(alb1sv(ikl)  ,a_SII1)
+
+        alb2sv(ikl) =     albssv(ikl) +(a_SII2-albssv(ikl))*SIcenH
+        alb2sv(ikl) = min(alb2sv(ikl)  ,a_SII2)
+
+        alb3sv(ikl) =     albssv(ikl) +(a_SII3-albssv(ikl))*SIcenH
+        alb3sv(ikl) = min(alb3sv(ikl)  ,a_SII3)
+
+        albisv(ikl) =     albssv(ikl) +(albSII-albssv(ikl))*SIcenH
+        albisv(ikl) = min(albisv(ikl)  ,albSII)
+
+        DO i=1,6
+        alb6sv(ikl,i) = albssv(ikl) +(a_SII6(i)-albssv(ikl))*SIcenH
+        alb6sv(ikl,i) = min(alb6sv(ikl,i)  ,a_SII6(i))
+        ENDDO
+
+
+  ! +--Integrated Snow/Ice/Soil Albedo: Clouds Correction! Greuell & all., 1994
+  ! +  --------------------------------------------------! Glob.&t Planet.Change
+                                                   ! ! (9):91-114
+        alb1sv(ikl) = alb1sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH &
+              + dalbed      *    (1.-cld_SV(ikl))
+        alb2sv(ikl) = alb2sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH &
+              + dalbed      *    (1.-cld_SV(ikl))
+        alb3sv(ikl) = alb3sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH &
+              + dalbed      *    (1.-cld_SV(ikl))
+        alb6sv(ikl,:) =alb6sv(ikl,:)+0.05 *(cld_SV(ikl)-0.5)*SIcenH &
+              + dalbed      *    (1.-cld_SV(ikl))
+        albisv(ikl) = albisv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH &
+              + dalbed      *    (1.-cld_SV(ikl))
+
+  ! +--Integrated Snow/Ice/Soil Albedo: Minimum snow albedo = aI1dSV
+  ! +  -------------------------------------------------------------
+
+        albedo_old  = albisv(ikl)
+        albisv(ikl) = max(albisv(ikl),aI1dSV   * SIcenH &
+              + albssv(ikl) *(1.0        - SIcenH))
+        alb1sv(ikl) = alb1sv(ikl) - 1.0/3.0 & ! 33 %
+              * (albedo_old-albisv(ikl)) / So1dSV
+        alb2sv(ikl) = alb2sv(ikl) - 1.0/3.0 & ! 33 %
+              * (albedo_old-albisv(ikl)) / So2dSV
+        alb3sv(ikl) = alb3sv(ikl) - 1.0/3.0 & ! 33 %
+              * (albedo_old-albisv(ikl)) / So3dSV
+        alb6sv(ikl,1:3) = alb6sv(ikl,1:3) - 1.0/6.0 & ! 16 %
+              * (albedo_old-albisv(ikl)) / (So1dSV/3)
+        alb6sv(ikl,4:6) = alb6sv(ikl,4:6) - 1.0/6.0 & ! 16 %
+              * (albedo_old-albisv(ikl)) / (So2dSV/3)
+
+
+  ! +--Integrated Snow/Ice/Soil Albedo: Maximum albedo = 95%
+  ! +  -----------------------------------------------------
+
+        albedo_old  = albisv(ikl)
+        albisv(ikl) = min(albisv(ikl),0.95)
+        alb1sv(ikl) = alb1sv(ikl) - 1.0/3.0 & ! 33 %
+              * (albedo_old-albisv(ikl)) / So1dSV
+        alb2sv(ikl) = alb2sv(ikl) - 1.0/3.0 & ! 33 %
+              * (albedo_old-albisv(ikl)) / So2dSV
+        alb3sv(ikl) = alb3sv(ikl) - 1.0/3.0 & ! 33 %
+              * (albedo_old-albisv(ikl)) / So3dSV
+        alb6sv(ikl,1:3) = alb6sv(ikl,1:3) - 1.0/6.0 & ! 16 %
+              * (albedo_old-albisv(ikl)) / (So1dSV/3)
+        alb6sv(ikl,4:6) = alb6sv(ikl,4:6) - 1.0/6.0 & ! 16 %
+              * (albedo_old-albisv(ikl)) / (So2dSV/3)
+
+
+    !Sea Ice/snow permanent-interractive prescription from Nemo
+    !AO_CK 20/02/2020
+
+    ! ! No check if coupling update since MAR and NEMO albedo are too different
+    ! and since MAR albedo is computed on properties that are not in NEMO
+    ! ! prescription for each time step with NEMO values
+
+  ! #AO      if (LSmask(ikl) .eq. 0 .and. coupling_ao .eq. .true.) then
+  ! #AO       if (AOmask(ikl) .eq. 0) then
+  ! #AO       albisv(ikl) =  (1.-AOmask(ikl))* albAOsisv(ikl)
+  ! #AO.                    +(AOmask(ikl)*albisv(ikl))
+  ! #AO       alb1sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
+  ! #AO.                    +(AOmask(ikl)*alb1sv(ikl))
+  ! #AO       alb2sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
+  ! #AO.                    +(AOmask(ikl)*alb2sv(ikl))
+  ! #AO       alb3sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
+  ! #AO.                    +(AOmask(ikl)*alb3sv(ikl))
+  ! #AO       endif
+  ! #AO      endif
+
+
+        alb1sv(ikl) = min(max(zero,alb1sv(ikl)),albmax)
+        alb2sv(ikl) = min(max(zero,alb2sv(ikl)),albmax)
+        alb3sv(ikl) = min(max(zero,alb3sv(ikl)),albmax)
+
+        DO i=1,6
+            alb6sv(ikl,i) = min(max(zero,alb6sv(ikl,i)),albmax)
+        ENDDO
+    END DO
+
+
+  ! +--Extinction Coefficient: Exponential Factor
+  ! +  ==========================================
+
+    DO ikl=1,knonv
+      sExt_1(ikl)        = 1.
+      sExt_2(ikl)        = 1.
+      sExt_3(ikl)        = 1.
+      sEX_sv(ikl,nsno+1) = 1.
+
+      coalb1(ikl) = (1.          -alb1sv(ikl))*So1dSV
+      coalb2(ikl) = (1.          -alb2sv(ikl))*So2dSV
+      coalb3(ikl) = (1.          -alb3sv(ikl))*So3dSV
+      coalbm      =  coalb1(ikl) +coalb2(ikl) +coalb3(ikl)
+      coalb1(ikl) =  coalb1(ikl)              /coalbm
+      coalb2(ikl) =  coalb2(ikl)              /coalbm
+      coalb3(ikl) =  coalb3(ikl)              /coalbm
+    END DO
+
+  !XF
+
+    DO   isn=nsno,1,-1
+      DO ikl=1,knonv
+        sEX_sv(ikl,isn) = 1.0
+       ! !sEX_sv(ikl,isn) = 0.95 ! if MAR is too warm in summer
+      END DO
+    END DO
+
+    DO ikl=1,knonv
+     DO isn=max(1,isnoSV(ikl)),1,-1
+
+      SignRo = sign(unun, rocdSV - ro__SV(ikl,isn))
+      SnowOK =  max(zero,SignRo) ! Ice Density Threshold
+
+      RoFrez =  1.e-3      * ro__SV(ikl,isn) * (1.0-eta_SV(ikl,isn))
+
+      OpSqrt = sqrt(max(epsi,SnOpSV(ikl,isn)))
+      exarg1 =      SnowOK  *1.e2 *max(sbeta1*RoFrez/OpSqrt,sbeta2) &
+            +(1.0-SnowOK)           *sbeta5
+      exarg2 =      SnowOK  *1.e2 *max(sbeta3*RoFrez/OpSqrt,sbeta4) &
+            +(1.0-SnowOK)           *sbeta5
+      exarg3 =      SnowOK  *1.e2     *sbeta5 &
+            +(1.0-SnowOK)           *sbeta5
+
+
+  ! +--Integrated Extinction of Solar Irradiance (Normalized Value)
+  ! +  ============================================================
+
+      sExt_1(ikl) = sExt_1(ikl) &
+            * exp(min(0.0,-exarg1 *dzsnSV(ikl,isn)))
+      sign_0      =              sign(unun,eps9   -sExt_1(ikl))
+      sExt_0      =               max(zero,sign_0)*sExt_1(ikl)
+      sExt_1(ikl) = sExt_1(ikl)                   -sExt_0
+
+      sExt_2(ikl) = sExt_2(ikl) &
+            * exp(min(0.0,-exarg2 *dzsnSV(ikl,isn)))
+      sign_0      =              sign(unun,eps9   -sExt_2(ikl))
+      sExt_0      =               max(zero,sign_0)*sExt_2(ikl)
+      sExt_2(ikl) = sExt_2(ikl)                   -sExt_0
+
+      sExt_3(ikl) = sExt_3(ikl) &
+            * exp(min(0.0,-exarg3 *dzsnSV(ikl,isn)))
+      sign_0      =              sign(unun,eps9   -sExt_3(ikl))
+      sExt_0      =               max(zero,sign_0)*sExt_3(ikl)
+      sExt_3(ikl) = sExt_3(ikl)                   -sExt_0
+
+      sEX_sv(ikl,isn) = coalb1(ikl) * sExt_1(ikl) &
+            + coalb2(ikl) * sExt_2(ikl) &
+            + coalb3(ikl) * sExt_3(ikl)
+    END DO
+  END DO
+
+  DO   isn=0,-nsol,-1
+    DO ikl=1,knonv
+      sEX_sv(ikl,isn) = 0.0
+    END DO
+  END DO
+
+
+  return
+
+
+end subroutine snoptp
+
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE albedo_kokhanovsky(lambdamin,lambdamax, &
+        cossza,dopt,albint)
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! Authors: Hajar El Habchi El Fenniri, Etienne Vignon, Cecile Agosta
+       ! Ghislain Picard
+  ! Routine that calculates the  integrated snow spectral albedo between
+  ! lambdamin and lambdamax following Kokhanisky and Zege 2004,
+  ! Scattering optics of snow, Applied Optics, Vol 43, No7
+  ! Code inspired from the snowoptics package of Ghislain Picard:
+  ! https://github.com/ghislainp/snowoptics
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+  USE VARphy
+
+  IMPLICIT NONE
+
+  ! Inputs
+  !--------
+  REAL :: lambdamin   ! minimum wavelength for integration [m]
+  REAL :: lambdamax   ! maximum wavelength for integration [m]
+  REAL :: cossza     ! solar zenith angle cosinus
+  REAL :: dopt        ! optical diameter [m]
+
+  !Outputs
+  !-------
+  REAL :: albint
+
+  ! Local Variables
+  !-----------------
+
+  REAL :: ropt,cosalb,norm,Pas
+  REAL :: SSA,alpha,gamm,R,cos30,alb30
+  INTEGER :: i
+
+
+  REAL :: B_amp                       ! amplification factor
+  PARAMETER (B_amp=1.6)
+
+  REAL :: g_asy                       ! asymetry factor
+  PARAMETER (g_asy=0.845)
+
+  INTEGER :: nlambda                  ! length of wavelength vector
+  PARAMETER(nlambda=200)
+
+  REAL :: lmin
+  PARAMETER(lmin=185.0E-9)
+
+  REAL :: lmax
+  PARAMETER(lmax=4000.0E-9)
+
+  REAL :: albmax
+  PARAMETER(albmax=0.99)
+
+  REAL :: wavelengths(nlambda)
+  REAL :: ni(nlambda)
+
+  DATA wavelengths / 1.85000000e-07, 2.04170854e-07, &
+        2.23341709e-07, 2.42512563e-07, &
+        2.61683417e-07, 2.80854271e-07, 3.00025126e-07, 3.19195980e-07, &
+        3.38366834e-07, 3.57537688e-07, 3.76708543e-07, 3.95879397e-07, &
+        4.15050251e-07, 4.34221106e-07, 4.53391960e-07, 4.72562814e-07, &
+        4.91733668e-07, 5.10904523e-07, 5.30075377e-07, 5.49246231e-07, &
+        5.68417085e-07, 5.87587940e-07, 6.06758794e-07, 6.25929648e-07, &
+        6.45100503e-07, 6.64271357e-07, 6.83442211e-07, 7.02613065e-07, &
+        7.21783920e-07, 7.40954774e-07, 7.60125628e-07, 7.79296482e-07, &
+        7.98467337e-07, 8.17638191e-07, 8.36809045e-07, 8.55979899e-07, &
+        8.75150754e-07, 8.94321608e-07, 9.13492462e-07, 9.32663317e-07, &
+        9.51834171e-07, 9.71005025e-07, 9.90175879e-07, 1.00934673e-06, &
+        1.02851759e-06, 1.04768844e-06, 1.06685930e-06, 1.08603015e-06, &
+        1.10520101e-06, 1.12437186e-06, 1.14354271e-06, 1.16271357e-06, &
+        1.18188442e-06, 1.20105528e-06, 1.22022613e-06, 1.23939698e-06, &
+        1.25856784e-06, 1.27773869e-06, 1.29690955e-06, 1.31608040e-06, &
+        1.33525126e-06, 1.35442211e-06, 1.37359296e-06, 1.39276382e-06, &
+        1.41193467e-06, 1.43110553e-06, 1.45027638e-06, 1.46944724e-06, &
+        1.48861809e-06, 1.50778894e-06, 1.52695980e-06, 1.54613065e-06, &
+        1.56530151e-06, 1.58447236e-06, 1.60364322e-06, 1.62281407e-06, &
+        1.64198492e-06, 1.66115578e-06, 1.68032663e-06, 1.69949749e-06, &
+        1.71866834e-06, 1.73783920e-06, 1.75701005e-06, 1.77618090e-06, &
+        1.79535176e-06, 1.81452261e-06, 1.83369347e-06, 1.85286432e-06, &
+        1.87203518e-06, 1.89120603e-06, 1.91037688e-06, 1.92954774e-06, &
+        1.94871859e-06, 1.96788945e-06, 1.98706030e-06, 2.00623116e-06, &
+        2.02540201e-06, 2.04457286e-06, 2.06374372e-06, 2.08291457e-06, &
+        2.10208543e-06, 2.12125628e-06, 2.14042714e-06, 2.15959799e-06, &
+        2.17876884e-06, 2.19793970e-06, 2.21711055e-06, 2.23628141e-06, &
+        2.25545226e-06, 2.27462312e-06, 2.29379397e-06, 2.31296482e-06, &
+        2.33213568e-06, 2.35130653e-06, 2.37047739e-06, 2.38964824e-06, &
+        2.40881910e-06, 2.42798995e-06, 2.44716080e-06, 2.46633166e-06, &
+        2.48550251e-06, 2.50467337e-06, 2.52384422e-06, 2.54301508e-06, &
+        2.56218593e-06, 2.58135678e-06, 2.60052764e-06, 2.61969849e-06, &
+        2.63886935e-06, 2.65804020e-06, 2.67721106e-06, 2.69638191e-06, &
+        2.71555276e-06, 2.73472362e-06, 2.75389447e-06, 2.77306533e-06, &
+        2.79223618e-06, 2.81140704e-06, 2.83057789e-06, 2.84974874e-06, &
+        2.86891960e-06, 2.88809045e-06, 2.90726131e-06, 2.92643216e-06, &
+        2.94560302e-06, 2.96477387e-06, 2.98394472e-06, 3.00311558e-06, &
+        3.02228643e-06, 3.04145729e-06, 3.06062814e-06, 3.07979899e-06, &
+        3.09896985e-06, 3.11814070e-06, 3.13731156e-06, 3.15648241e-06, &
+        3.17565327e-06, 3.19482412e-06, 3.21399497e-06, 3.23316583e-06, &
+        3.25233668e-06, 3.27150754e-06, 3.29067839e-06, 3.30984925e-06, &
+        3.32902010e-06, 3.34819095e-06, 3.36736181e-06, 3.38653266e-06, &
+        3.40570352e-06, 3.42487437e-06, 3.44404523e-06, 3.46321608e-06, &
+        3.48238693e-06, 3.50155779e-06, 3.52072864e-06, 3.53989950e-06, &
+        3.55907035e-06, 3.57824121e-06, 3.59741206e-06, 3.61658291e-06, &
+        3.63575377e-06, 3.65492462e-06, 3.67409548e-06, 3.69326633e-06, &
+        3.71243719e-06, 3.73160804e-06, 3.75077889e-06, 3.76994975e-06, &
+        3.78912060e-06, 3.80829146e-06, 3.82746231e-06, 3.84663317e-06, &
+        3.86580402e-06, 3.88497487e-06, 3.90414573e-06, 3.92331658e-06, &
+        3.94248744e-06, 3.96165829e-06, 3.98082915e-06, 4.00000000e-06/
+
+
+  DATA ni /7.74508407e-10, 7.74508407e-10, &
+        7.74508407e-10, 7.74508407e-10, &
+        7.74508407e-10, 7.74508407e-10, 7.74508407e-10, 7.74508407e-10, &
+        6.98381122e-10, 6.23170274e-10, 5.97655992e-10, 5.84106004e-10, &
+        5.44327597e-10, 5.71923510e-10, 6.59723827e-10, 8.05183870e-10, &
+        1.03110161e-09, 1.36680386e-09, 1.85161253e-09, 2.56487751e-09, &
+        3.56462855e-09, 4.89450926e-09, 6.49252022e-09, 9.62029335e-09, &
+        1.32335015e-08, 1.75502184e-08, 2.19240625e-08, 3.03304156e-08, &
+        4.07715972e-08, 5.00414911e-08, 7.09722331e-08, 1.00773751e-07, &
+        1.31427409e-07, 1.42289041e-07, 1.49066787e-07, 2.01558515e-07, &
+        2.99106105e-07, 4.03902086e-07, 4.54292169e-07, 5.21906983e-07, &
+        6.27643362e-07, 9.43955678e-07, 1.33464494e-06, 1.97278315e-06, &
+        2.31801329e-06, 2.20584676e-06, 1.85568138e-06, 1.73395193e-06, &
+        1.73101406e-06, 1.91333936e-06, 2.26413019e-06, 3.23959718e-06, &
+        4.94316963e-06, 6.89378896e-06, 1.02237444e-05, 1.21439656e-05, &
+        1.31567585e-05, 1.33448288e-05, 1.32000000e-05, 1.31608040e-05, &
+        1.33048369e-05, 1.40321464e-05, 1.51526244e-05, 1.80342858e-05, &
+        3.82875736e-05, 1.07325259e-04, 2.11961637e-04, 3.82008054e-04, &
+        5.30897470e-04, 5.29244735e-04, 4.90876605e-04, 4.33905427e-04, &
+        3.77795349e-04, 3.17633099e-04, 2.81078564e-04, 2.57579485e-04, &
+        2.42203100e-04, 2.23789060e-04, 2.04306870e-04, 1.87909255e-04, &
+        1.73117146e-04, 1.61533186e-04, 1.53420328e-04, 1.47578033e-04, &
+        1.42334776e-04, 1.35691466e-04, 1.30495414e-04, 1.36065123e-04, &
+        1.70928821e-04, 2.66389730e-04, 4.80957955e-04, 8.25041961e-04, &
+        1.21654792e-03, 1.50232875e-03, 1.62316078e-03, 1.61649750e-03, &
+        1.53736801e-03, 1.42343711e-03, 1.24459117e-03, 1.02388611e-03, &
+        7.89112523e-04, 5.97204264e-04, 4.57152413e-04, 3.62341259e-04, &
+        2.99128332e-04, 2.57035569e-04, 2.26992203e-04, 2.07110355e-04, &
+        2.05835688e-04, 2.25108810e-04, 2.64262893e-04, 3.23594011e-04, &
+        3.93061117e-04, 4.62789970e-04, 5.19664416e-04, 5.59739628e-04, &
+        5.93476084e-04, 6.22797885e-04, 6.57484833e-04, 6.92849600e-04, &
+        7.26584901e-04, 7.56604648e-04, 7.68009488e-04, 7.65579073e-04, &
+        7.50526164e-04, 7.39809972e-04, 7.55622847e-04, 8.05099514e-04, &
+        9.67279246e-04, 1.16281559e-03, 1.42570247e-03, 2.04986585e-03, &
+        2.93971170e-03, 4.49827711e-03, 7.32537532e-03, 1.18889734e-02, &
+        1.85851805e-02, 2.86242532e-02, 4.34131035e-02, 6.37828307e-02, &
+        9.24145850e-02, 1.35547945e-01, 1.94143245e-01, 2.54542814e-01, &
+        3.02282024e-01, 3.42214181e-01, 3.85475065e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01, &
+        4.38000000e-01, 4.38000000e-01, 4.38000000e-01, 4.38000000e-01/
+
+
+  Pas     =(lmax-lmin)/nlambda
+  ropt    = dopt/2.0
+  SSA     = 3.0/(rhoIce*ropt)
+  cos30   = cos(30.0/180.0*pi)
+
+
+  albint=0.
+  norm=0.
+
+  DO i = 1,nlambda
+      gamm = 4.0 * pi * ni(i) / wavelengths(i)
+      cosalb = 2.0 / (SSA * rhoice) * B_amp * gamm
+      alpha = 16. / 3 * cosalb / (1.0 - g_asy)
+      R = exp(-(alpha**0.5) * 3.0 / 7.0 * (1.0 + 2.0 * cossza))
+      alb30 = exp(-(alpha**0.5)* 3.0 / 7.0 * (1.0 + 20 * cos30))
+
+      IF ((wavelengths(i).GE.lambdamin).AND. &
+            (wavelengths(i).LT.lambdamax)) THEN
+      albint=albint+R*Pas  ! rectangle integration -> can be improved with trapezintegration
+      norm=norm+Pas
+      ENDIF
+
+  END DO
+
+  albint=max(0.,min(albint/max(norm,1E-10),albmax))
+
+END SUBROUTINE albedo_kokhanovsky
+
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_ts2.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_ts2.F	(revision 5084)
+++ 	(revision )
@@ -1,477 +1,0 @@
-      subroutine SISVAT_TS2                                                     
-c #ES.                     (ETSo_0,ETSo_1,ETSo_d)                               
-                                                                                
-C +------------------------------------------------------------------------+    
-C | MAR          SISVAT_TS2                            Mon 16-08-2009  MAR |    
-C |   SubRoutine SISVAT_TS2 computes the Soil/Snow temperature and fluxes  |
-C |   using the same method as in LMDZ for consistency.                    |
-C |   The corresponding LMDZ routines are soil (soil.F90) and calcul_fluxs |
-C |   (calcul_fluxs_mod.F90).                                              |   
-C +------------------------------------------------------------------------+    
-C |                                                                        |    
-C |                                                                        |    
-C |   PARAMETERS:  klonv: Total Number of columns =                        |    
-C |   ^^^^^^^^^^        = Total Number of grid boxes of surface type       |    
-C |                       (land ice for now)                               |    
-C |                                                                        |    
-C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |    
-C |   ^^^^^    sol_SV   : Downward Solar Radiation                  [W/m2] |    
-C |            IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |       
-C |            VV__SV   : SBL Top    Wind Speed                      [m/s] |    
-C |            TaT_SV   : SBL Top    Temperature                       [K] |     
-C |            QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |      
-C |            dzsnSV   : Snow Layer Thickness                         [m] |        
-C |            dt__SV   : Time Step                                    [s] |    
-C |                                                                        |    
-C |            SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |    
-C |            Eso_sv   : Soil+Snow       Emissivity                   [-] |    
-C |   ?        rah_sv   : Aerodynamic Resistance for Heat            [s/m] |    
-C |                                                                        | 
-C |            dz1_SV    : "inverse" layer thickness (centered)      [1/m] |
-C |            dz2_SV    : layer thickness (layer above (?))           [m] |
-C |            AcoHSV    : coefficient for Enthalpy evolution, from atm.   |
-C |            AcoHSV    : coefficient for Enthalpy evolution, from atm.   |
-C |            AcoQSV    : coefficient for Humidity evolution, from atm.   | 
-C |            BcoQSV    : coefficient for Humidity evolution, from atm.   |
-C |            ps__SV    : surface pressure                           [Pa] |
-C |            p1l_SV    : 1st atmospheric layer pressure             [Pa] |     
-C |            cdH_SV    : drag coeff Energy (?)                           |
-C |            rsolSV    : Radiation balance surface                [W/m2] |
-C |            lambSV    : Coefficient for soil layer geometry         [-] |
-C |                                                                        |    
-C |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|    
-C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |    
-C |   ^^^^^^   rsolSV   : Radiation balance surface                 [W/m2] |     
-C |                                                                        |    
-C |   OUTPUT:  IRs_SV   : Soil      IR Radiation                    [W/m2] |    
-C |   ^^^^^^   HSs_sv   : Sensible  Heat Flux                       [W/m2] |    
-C |            HLs_sv   : Latent    Heat Flux                       [W/m2] |  
-C |            TsfnSV   : new surface temperature                      [K] |
-C |            Evp_sv   : Evaporation                              [kg/m2] |
-C |            dSdTSV   : Sensible Heat Flux temp. derivative     [W/m2/K] |
-C |            dLdTSV   : Latent Heat Flux temp. derivative       [W/m2/K] |
-C |                                                                        | 
-C |   ?        ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |    
-C |   ?        ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |    
-C |   ?        ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |    
-C |                                                                        | 
-C |________________________________________________________________________|
-
-      USE VAR_SV
-      USE VARdSV
- 
-      USE VARySV                      
-      USE VARtSV                      
-      USE VARxSV 
-      USE VARphy
-      USE indice_sol_mod
-
-
-      IMPLICIT NONE                                                                    
-                                                                                
-                                                                                
-C +--Global Variables                                                           
-C +  ================                                                          
-
-      INCLUDE "YOMCST.h"
-      INCLUDE "YOETHF.h"
-      INCLUDE "FCTTRE.h"
-!      INCLUDE "indicesol.h"
-      INCLUDE "comsoil.h"
-!      include  "LMDZphy.inc"   
-                                                                        
-C +--OUTPUT for Stand Alone NetCDF File                                         
-C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                                         
-c #NC      real*8        SOsoKL(klonv)             ! Absorbed Solar Radiation        
-c #NC      real*8        IRsoKL(klonv)             ! Absorbed IR    Radiation        
-c #NC      real*8        HSsoKL(klonv)             ! Absorbed Sensible Heat Flux     
-c #NC      real*8        HLsoKL(klonv)             ! Absorbed Latent   Heat Flux     
-c #NC      real*8        HLs_KL(klonv)             ! Evaporation                     
-c #NC      real*8        HLv_KL(klonv)             ! Transpiration                   
-c #NC      common/DumpNC/SOsoKL,IRsoKL                                               
-c #NC     .             ,HSsoKL,HLsoKL                                               
-c #NC     .             ,HLs_KL,HLv_KL          
-
-C +--Internal Variables                                                         
-C +  ==================    
-
-      integer ig,jk,isl
-      real mu     
-      real Tsrf(klonv)               ! surface temperature as extrapolated from soil
-      real mug(klonv)                 !hj coef top layers 
-      real ztherm_i(klonv),zdz2(klonv,-nsol:nsno),z1s
-      real pfluxgrd(klonv), pcapcal(klonv), cal(klonv)
-      real beta(klonv), dif_grnd(klonv)
-      real C_coef(klonv,-nsol:nsno),D_coef(klonv,-nsol:nsno)
-
-      REAL, DIMENSION(klonv)   :: zx_mh, zx_nh, zx_oh
-      REAL, DIMENSION(klonv)   :: zx_mq, zx_nq, zx_oq
-      REAL, DIMENSION(klonv)   :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef
-      REAL, DIMENSION(klonv)   :: zx_sl, zx_k1
-      REAL, DIMENSION(klonv)   :: d_ts
-      REAL                     :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh
-      REAL                     :: qsat_new, q1_new
-C      REAL, PARAMETER          :: t_grnd = 271.35, t_coup = 273.15
-C      REAL, PARAMETER          :: max_eau_sol = 150.0
-      REAL, DIMENSION(klonv)   :: IRs__D, dIRsdT
-
-
-      REAL t_grnd                      ! not used
-      parameter(t_grnd = 271.35)       !
-      REAL t_coup                      ! distinguish evap/sublimation
-      parameter(t_coup = 273.15)       !
-      REAL max_eau_sol
-      parameter(max_eau_sol = 150.0)
-
-
-!        write(*,*)'T check'
-!     
-!        DO  ig = 1,knonv  
-!            DO  jk = 1,isnoSV(ig) !nsno       
-!              IF (TsisSV(ig,jk) <= 1.) THEN          !hj check
-!                TsisSV(ig,jk) = TsisSV(ig,isnoSV(ig))
-!              ENDIF  
-!
-!              IF (TsisSV(ig,jk) <= 1.) THEN          !hj check
-!                TsisSV(ig,jk) = 273.15
-!              ENDIF   
-!            END DO
-!        END DO     
-
-C!=======================================================================
-C! I. First part: corresponds to soil.F90 in LMDZ
-C!=======================================================================
-
-      DO ig = 1,knonv      
-        DO jk =1,isnoSV(ig)
-          dz2_SV(ig,jk)=dzsnSV(ig,jk)
-C! use arithmetic center between layers to derive dz1 for snow layers for simplicity: 
-          dz1_SV(ig,jk)=2./(dzsnSV(ig,jk)+dzsnSV(ig,jk-1)) 
-        ENDDO
-      ENDDO
-
-      DO ig = 1,knonv
-        ztherm_i(ig)   = inertie_lic
-        IF (isnoSV(ig) > 0) ztherm_i(ig)   = inertie_sno
-      ENDDO
-
-C!-----------------------------------------------------------------------
-C! 1)
-C! Calculation of Cgrf and Dgrd coefficients using soil temperature from 
-C! previous time step.
-C!
-C! These variables are recalculated on the local compressed grid instead 
-C! of saved in restart file.
-C!-----------------------------------------------------------------------
-      DO ig=1,knonv
-        DO jk=-nsol,nsno
-          zdz2(ig,jk)=dz2_SV(ig,jk)/dt__SV                                !ptimestep
-        ENDDO
-      ENDDO
- 
-      DO ig=1,knonv
-        z1s = zdz2(ig,-nsol)+dz1_SV(ig,-nsol+1)
-        C_coef(ig,-nsol+1)=zdz2(ig,-nsol)*TsisSV(ig,-nsol)/z1s
-        D_coef(ig,-nsol+1)=dz1_SV(ig,-nsol+1)/z1s
-      ENDDO
-
-      DO ig=1,knonv
-        DO jk=-nsol+1,isnoSV(ig)-1,1
-          z1s = 1./(zdz2(ig,jk)+dz1_SV(ig,jk+1)+dz1_SV(ig,jk)           &
-     &          *(1.-D_coef(ig,jk)))
-          C_coef(ig,jk+1)=                                              &
-     &          (TsisSV(ig,jk)*zdz2(ig,jk)                              &
-     &          +dz1_SV(ig,jk)*C_coef(ig,jk)) * z1s
-          D_coef(ig,jk+1)=dz1_SV(ig,jk+1)*z1s
-        ENDDO
-      ENDDO
-
-C!-----------------------------------------------------------------------
-C! 2)
-C! Computation of the soil temperatures using the Cgrd and Dgrd
-C! coefficient computed above
-C!
-C!-----------------------------------------------------------------------
-C! Extrapolate surface Temperature                   !hj check
-      mu=1./((2.**1.5-1.)/(2.**(0.5)-1.)-1.)
-
-!     IF (knonv>0) THEN 
-!      DO ig=1,8 
-!        write(*,*)ig,'sisvat: Tsis ',TsisSV(ig,isnoSV(ig))
-!        write(*,*)'max-1            ',TsisSV(ig,isnoSV(ig)-1)
-!        write(*,*)'max-2            ',TsisSV(ig,isnoSV(ig)-2)
-!        write(*,*)'0                ',TsisSV(ig,0)
-!!        write(*,*)min(max(isnoSV(ig),0),1),max(1-isnoSV(ig),0)
-!      ENDDO
-!     END IF
-
-      DO ig=1,knonv    
-        IF (isnoSV(ig).GT.0) THEN
-          IF (isnoSV(ig).GT.1) THEN
-           mug(ig)=1./(1.+dzsnSV(ig,isnoSV(ig)-1)/dzsnSV(ig,isnoSV(ig))) !mu
-          ELSE
-           mug(ig) = 1./(1.+dzsnSV(ig,isnoSV(ig)-1)/dz_dSV(0)) !mu
-          ENDIF
-        ELSE
-          mug(ig) = lambSV
-        ENDIF
-
-        IF (mug(ig)  .LE. 0.05) THEN
-         write(*,*)'Attention mu low', mug(ig)
-        ENDIF
-        IF (mug(ig)  .GE. 0.98) THEN
-         write(*,*)'Attention mu high', mug(ig)
-        ENDIF
-
-        Tsrf(ig)=(1.5*TsisSV(ig,isnoSV(ig))-0.5*TsisSV(ig,isnoSV(ig)-1))&
-     &           *min(max(isnoSV(ig),0),1)+                             &
-     &           ((mug(ig)+1)*TsisSV(ig,0)-mug(ig)*TsisSV(ig,-1))       &
-     &           *max(1-isnoSV(ig),0)  
-      ENDDO
-
-  
-
-C! Surface temperature
-      DO ig=1,knonv
-      TsisSV(ig,isnoSV(ig))=(mug(ig)*C_coef(ig,isnoSV(ig))+Tsf_SV(ig))/ &
-     &        (mug(ig)*(1.-D_coef(ig,isnoSV(ig)))+1.)
-      ENDDO
-  
-C! Other temperatures
-      DO ig=1,knonv
-        DO jk=isnoSV(ig),-nsol+1,-1
-          TsisSV(ig,jk-1)=C_coef(ig,jk)+D_coef(ig,jk)                   &
-     &          *TsisSV(ig,jk)
-        ENDDO
-      ENDDO
-C      write(*,*)ig,'Tsis',TsisSV(ig,0)
-
-C      IF (indice == is_sic) THEN
-C        DO ig = 1,knonv
-C          TsisSV(ig,-nsol) = RTT - 1.8
-C        END DO
-C      ENDIF
-
-CC      !hj new 11 03 2010
-        DO ig=1,knonv                                                          
-          isl         = isnoSV(ig)                                             
-C          dIRsdT(ig) = Eso_sv(ig)* SteBo   * 4.                        & ! - d(IR)/d(T)   
-C     &                             * Tsf_SV(ig)                         & !T TsisSV(ig,isl)           !                
-C     &                             * Tsf_SV(ig)                         & !TsisSV(ig,isl)           !                
-C     &                             * Tsf_SV(ig) !TsisSV(ig,isl)           !                
-C          IRs__D(ig) = dIRsdT(ig)* Tsf_SV(ig) * 0.75 !TsisSV(ig,isl) * 0.75    !: 
-          dIRsdT(ig) = Eso_sv(ig)* StefBo   * 4.                        & ! - d(IR)/d(T)   
-     &                             * TsisSV(ig,isl)                     & !
-     &                             * TsisSV(ig,isl)                     & !
-     &                             * TsisSV(ig,isl)                     & !
-          IRs__D(ig) = dIRsdT(ig)* TsisSV(ig,isl) * 0.75                  !: 
-         END DO
-       !hj
-C!-----------------------------------------------------------------------
-C! 3)
-C! Calculate the Cgrd and Dgrd coefficient corresponding to actual soil 
-C! temperature
-C!-----------------------------------------------------------------------
-      DO ig=1,knonv
-        z1s = zdz2(ig,-nsol)+dz1_SV(ig,-nsol+1)
-        C_coef(ig,-nsol+1) = zdz2(ig,-nsol)*TsisSV(ig,-nsol)/z1s
-        D_coef(ig,-nsol+1) = dz1_SV(ig,-nsol+1)/z1s
-      ENDDO
-
-      DO ig=1,knonv  
-        DO jk=-nsol+1,isnoSV(ig)-1,1
-          z1s = 1./(zdz2(ig,jk)+dz1_SV(ig,jk+1)+dz1_SV(ig,jk)           &
-     &          *(1.-D_coef(ig,jk)))
-          C_coef(ig,jk+1) = (TsisSV(ig,jk)*zdz2(ig,jk)+                 &
-     &          dz1_SV(ig,jk)*C_coef(ig,jk)) * z1s
-          D_coef(ig,jk+1) = dz1_SV(ig,jk+1)*z1s
-        ENDDO
-      ENDDO
-
-C!-----------------------------------------------------------------------
-C! 4)
-C! Computation of the surface diffusive flux from ground and
-C! calorific capacity of the ground
-C!-----------------------------------------------------------------------
-      DO ig=1,knonv
-C! (pfluxgrd)
-        pfluxgrd(ig) = ztherm_i(ig)*dz1_SV(ig,isnoSV(ig))*              &
-     &      (C_coef(ig,isnoSV(ig))+(D_coef(ig,isnoSV(ig))-1.)           &
-     &      *TsisSV(ig,isnoSV(ig)))
-C! (pcapcal)
-        pcapcal(ig)  = ztherm_i(ig)*                                    &
-     &      (dz2_SV(ig,isnoSV(ig))+dt__SV*(1.-D_coef(ig,isnoSV(ig)))    &
-     &      *dz1_SV(ig,isnoSV(ig)))
-        z1s = mug(ig)*(1.-D_coef(ig,isnoSV(ig)))+1.
-        pcapcal(ig)  = pcapcal(ig)/z1s
-        pfluxgrd(ig) = ( pfluxgrd(ig)                                   &
-     &       + pcapcal(ig) * (TsisSV(ig,isnoSV(ig)) * z1s               &
-     &       - mug(ig)* C_coef(ig,isnoSV(ig))                           &
-     &       - Tsf_SV(ig))       /dt__SV )
-      ENDDO
-        
-      
-      cal(1:knonv) = RCPD / pcapcal(1:knonv)
-      rsolSV(1:knonv)  = rsolSV(1:knonv) + pfluxgrd(1:knonv)
-C!=======================================================================
-C! II. Second part: corresponds to calcul_fluxs_mod.F90 in LMDZ
-C!=======================================================================
-
-      Evp_sv = 0.
-c #NC HSsoKL=0.
-c #NC HLsoKL=0.
-      dSdTSV = 0.
-      dLdTSV = 0.
-	
-      beta(:) = 1.0
-      dif_grnd(:) = 0.0
-
-C! zx_qs = qsat en kg/kg
-C!**********************************************************************x***************
-
-      DO ig = 1,knonv
-        IF (ps__SV(ig).LT.1.) THEN
-!          write(*,*)'ig',ig,'ps',ps__SV(ig)
-          ps__SV(ig)=max(ps__SV(ig),1.e-8)
-        ENDIF
-        IF (p1l_SV(ig).LT.1.) THEN
-!          write(*,*)'ig',ig,'p1l',p1l_SV(ig)
-          p1l_SV(ig)=max(p1l_SV(ig),1.e-8)
-        ENDIF
-        IF (TaT_SV(ig).LT.180.) THEN
-!          write(*,*)'ig',ig,'TaT',TaT_SV(ig)
-          TaT_SV(ig)=max(TaT_SV(ig),180.)
-        ENDIF
-        IF (QaT_SV(ig).LT.1.e-8) THEN
-!          write(*,*)'ig',ig,'QaT',QaT_SV(ig)
-          QaT_SV(ig)=max(QaT_SV(ig),1.e-8)
-        ENDIF
-        IF (Tsf_SV(ig).LT.100.) THEN
-!          write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
-          Tsf_SV(ig)=max(Tsf_SV(ig),180.)
-        ENDIF
-        IF (Tsf_SV(ig).GT.500.) THEN
-!          write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
-          Tsf_SV(ig)=min(Tsf_SV(ig),400.)
-        ENDIF
-!         IF (Tsrf(ig).LT.1.) THEN
-!!          write(*,*)'ig',ig,'Tsrf',Tsrf(ig)  
-!           Tsrf(ig)=max(Tsrf(ig),TaT_SV(ig)-20.)
-!         ENDIF
-         IF (cdH_SV(ig).LT.1.e-10) THEN
-!           IF (ig.le.3)   write(*,*)'ig',ig,'cdH',cdH_SV(ig)
-           cdH_SV(ig)=.5
-         ENDIF
-      ENDDO  
-
-
-      DO ig = 1,knonv
-        zx_pkh(ig) = 1. ! (ps__SV(ig)/ps__SV(ig))**RKAPPA
-        IF (thermcep) THEN
-          zdelta=MAX(0.,SIGN(1.,rtt-Tsf_SV(ig)))
-          zcvm5 = R5LES*LhvH2O*(1.-zdelta) + R5IES*LhsH2O*zdelta
-          zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*QaT_SV(ig))
-          zx_qs= r2es * FOEEW(Tsf_SV(ig),zdelta)/ps__SV(ig)
-          zx_qs=MIN(0.5,zx_qs)
-          !write(*,*)'zcor',retv*zx_qs
-          zcor=1./(1.-retv*zx_qs)
-          zx_qs=zx_qs*zcor
-          zx_dq_s_dh = FOEDE(Tsf_SV(ig),zdelta,zcvm5,zx_qs,zcor)        &
-     &          /LhvH2O / zx_pkh(ig)
-        ELSE
-          IF (Tsf_SV(ig).LT.t_coup) THEN
-             zx_qs = qsats(Tsf_SV(ig)) / ps__SV(ig)
-             zx_dq_s_dh = dqsats(Tsf_SV(ig),zx_qs)/LhvH2O               &
-     &             / zx_pkh(ig)
-          ELSE
-             zx_qs = qsatl(Tsf_SV(ig)) / ps__SV(ig)
-             zx_dq_s_dh = dqsatl(Tsf_SV(ig),zx_qs)/LhvH2O               &
-     &             / zx_pkh(ig)
-          ENDIF
-        ENDIF
-        zx_dq_s_dt(ig) = RCPD * zx_pkh(ig) * zx_dq_s_dh
-        zx_qsat(ig) = zx_qs
-C        zx_coef(ig) = cdH_SV(ig) *                                     &
-C     &       (1.0+SQRT(u1lay(ig)**2+v1lay(ig)**2)) *                   &
-C     &       p1l_SV(ig)/(RD*t1lay(ig))
-        zx_coef(ig) = cdH_SV(ig) *                                      &
-     &       (1.0+VV__SV(ig)) *                                         &
-     &       p1l_SV(ig)/(RD*TaT_SV(ig))
-       
-      ENDDO
-
-
-C! === Calcul de la temperature de surface ===
-C! zx_sl = chaleur latente d'evaporation ou de sublimation
-C!****************************************************************************************
-
-      DO ig = 1,knonv
-        zx_sl(ig) = LhvH2O
-        IF (Tsf_SV(ig) .LT. RTT) zx_sl(ig) = LhsH2O
-        zx_k1(ig) = zx_coef(ig)
-      ENDDO
-    
-
-      DO ig = 1,knonv
-C! Q
-        zx_oq(ig) = 1. - (beta(ig) * zx_k1(ig) * BcoQSV(ig) * dt__SV)
-        zx_mq(ig) = beta(ig) * zx_k1(ig) *                              &
-     &       (AcoQSV(ig) - zx_qsat(ig) +                                &
-     &       zx_dq_s_dt(ig) * Tsf_SV(ig))                               &
-     &       / zx_oq(ig)
-        zx_nq(ig) = beta(ig) * zx_k1(ig) * (-1. * zx_dq_s_dt(ig))       &
-     &       / zx_oq(ig)
-       
-C! H
-        zx_oh(ig) = 1. - (zx_k1(ig) * BcoHSV(ig) * dt__SV)
-        zx_mh(ig) = zx_k1(ig) * AcoHSV(ig) / zx_oh(ig)
-        zx_nh(ig) = - (zx_k1(ig) * RCPD * zx_pkh(ig))/ zx_oh(ig)
-     
-C! surface temperature
-        TsfnSV(ig) = (Tsf_SV(ig) + cal(ig)/RCPD * zx_pkh(ig) * dt__SV * &
-     &       (rsolSV(ig) + zx_mh(ig) + zx_sl(ig) * zx_mq(ig))           & 
-     &       + dif_grnd(ig) * t_grnd * dt__SV)/                         &
-     &       ( 1. - dt__SV * cal(ig)/(RCPD * zx_pkh(ig)) *              &
-     &       (zx_nh(ig) + zx_sl(ig) * zx_nq(ig))                        &  
-     &       + dt__SV * dif_grnd(ig))
-
-!hj rajoute 22 11 2010 tuning...
-        TsfnSV(ig) = min(RTT+0.02,TsfnSV(ig))
-       
-        d_ts(ig) = TsfnSV(ig) - Tsf_SV(ig)
-
-
-C!== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
-C!== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
-        Evp_sv(ig) = - zx_mq(ig) - zx_nq(ig) * TsfnSV(ig) 
-        HLs_sv(ig) = - Evp_sv(ig) * zx_sl(ig)
-        HSs_sv(ig) = zx_mh(ig) + zx_nh(ig) * TsfnSV(ig)
-       
-C! Derives des flux dF/dTs (W m-2 K-1):
-        dSdTSV(ig) = zx_nh(ig)
-        dLdTSV(ig) = zx_sl(ig) * zx_nq(ig)
-
-
-!hj  new 11 03 2010                                      
-        isl         = isnoSV(ig)
-!        TsisSV(ig,isl) = TsfnSV(ig)                                         
-        IRs_SV(ig) = IRs__D(ig)                                         &!     
-     &                - dIRsdT(ig) * TsfnSV(ig) !TsisSV(ig,isl)?      !  
-
-! hj
-c #NC   SOsoKL(ig) = sol_SV(ig) * SoSosv(ig)              ! Absorbed Sol.    
-c #NC   IRsoKL(ig) =               IRs_SV(ig)                           & !Up Surf. IR
-c #NC&        +     tau_sv(ig)      *IRd_SV(ig)*Eso_sv(ig)              & !Down Atm IR
-c #NC&        -(1.0-tau_sv(ig)) *0.5*IRv_sv(ig)            ! Down Veg IR  
-c #NC   HLsoKL(ig) = HLs_sv(ig) 
-c #NC   HSsoKL(ig) = HSs_sv(ig) 
-c #NC   HLs_KL(ig) = Evp_sv(ig)
-
-C! Nouvelle valeure de l'humidite au dessus du sol
-        qsat_new=zx_qsat(ig) + zx_dq_s_dt(ig) * d_ts(ig)
-        q1_new = AcoQSV(ig) - BcoQSV(ig)* Evp_sv(ig)*dt__SV
-        QaT_SV(ig)=q1_new*(1.-beta(ig)) + beta(ig)*qsat_new 
-
-      ENDDO
-
-      end ! subroutine SISVAT_TS2  
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_ts2.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_ts2.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_ts2.f90	(revision 5246)
@@ -0,0 +1,477 @@
+subroutine SISVAT_TS2
+  ! #ES.                     (ETSo_0,ETSo_1,ETSo_d)
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_TS2                            Mon 16-08-2009  MAR |
+  ! |   SubRoutine SISVAT_TS2 computes the Soil/Snow temperature and fluxes  |
+  ! |   using the same method as in LMDZ for consistency.                    |
+  ! |   The corresponding LMDZ routines are soil (soil.F90) and calcul_fluxs |
+  ! |   (calcul_fluxs_mod.F90).                                              |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |                                                                        |
+  ! |   PARAMETERS:  klonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of grid boxes of surface type       |
+  ! |                       (land ice for now)                               |
+  ! |                                                                        |
+  ! |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |   ^^^^^    sol_SV   : Downward Solar Radiation                  [W/m2] |
+  ! |            IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |
+  ! |            VV__SV   : SBL Top    Wind Speed                      [m/s] |
+  ! |            TaT_SV   : SBL Top    Temperature                       [K] |
+  ! |            QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
+  ! |            dzsnSV   : Snow Layer Thickness                         [m] |
+  ! |            dt__SV   : Time Step                                    [s] |
+  ! |                                                                        |
+  ! |            SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
+  ! |            Eso_sv   : Soil+Snow       Emissivity                   [-] |
+  ! |   ?        rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+  ! |                                                                        |
+  ! |            dz1_SV    : "inverse" layer thickness (centered)      [1/m] |
+  ! |            dz2_SV    : layer thickness (layer above (?))           [m] |
+  ! |            AcoHSV    : coefficient for Enthalpy evolution, from atm.   |
+  ! |            AcoHSV    : coefficient for Enthalpy evolution, from atm.   |
+  ! |            AcoQSV    : coefficient for Humidity evolution, from atm.   |
+  ! |            BcoQSV    : coefficient for Humidity evolution, from atm.   |
+  ! |            ps__SV    : surface pressure                           [Pa] |
+  ! |            p1l_SV    : 1st atmospheric layer pressure             [Pa] |
+  ! |            cdH_SV    : drag coeff Energy (?)                           |
+  ! |            rsolSV    : Radiation balance surface                [W/m2] |
+  ! |            lambSV    : Coefficient for soil layer geometry         [-] |
+  ! |                                                                        |
+  ! |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+  ! |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+  ! |   ^^^^^^   rsolSV   : Radiation balance surface                 [W/m2] |
+  ! |                                                                        |
+  ! |   OUTPUT:  IRs_SV   : Soil      IR Radiation                    [W/m2] |
+  ! |   ^^^^^^   HSs_sv   : Sensible  Heat Flux                       [W/m2] |
+  ! |            HLs_sv   : Latent    Heat Flux                       [W/m2] |
+  ! |            TsfnSV   : new surface temperature                      [K] |
+  ! |            Evp_sv   : Evaporation                              [kg/m2] |
+  ! |            dSdTSV   : Sensible Heat Flux temp. derivative     [W/m2/K] |
+  ! |            dLdTSV   : Latent Heat Flux temp. derivative       [W/m2/K] |
+  ! |                                                                        |
+  ! |   ?        ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |
+  ! |   ?        ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |
+  ! |   ?        ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |
+  ! |                                                                        |
+  ! |________________________________________________________________________|
+
+  USE VAR_SV
+  USE VARdSV
+
+  USE VARySV
+  USE VARtSV
+  USE VARxSV
+  USE VARphy
+  USE indice_sol_mod
+
+
+  IMPLICIT NONE
+
+
+  ! +--Global Variables
+  ! +  ================
+
+  INCLUDE "YOMCST.h"
+  INCLUDE "YOETHF.h"
+  INCLUDE "FCTTRE.h"
+   ! INCLUDE "indicesol.h"
+  INCLUDE "comsoil.h"
+   ! include  "LMDZphy.inc"
+
+  ! +--OUTPUT for Stand Alone NetCDF File
+  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  ! #NC      real*8        SOsoKL(klonv)             ! Absorbed Solar Radiation
+  ! #NC      real*8        IRsoKL(klonv)             ! Absorbed IR    Radiation
+  ! #NC      real*8        HSsoKL(klonv)             ! Absorbed Sensible Heat Flux
+  ! #NC      real*8        HLsoKL(klonv)             ! Absorbed Latent   Heat Flux
+  ! #NC      real*8        HLs_KL(klonv)             ! Evaporation
+  ! #NC      real*8        HLv_KL(klonv)             ! Transpiration
+  ! #NC      common/DumpNC/SOsoKL,IRsoKL
+  ! #NC     .             ,HSsoKL,HLsoKL
+  ! #NC     .             ,HLs_KL,HLv_KL
+
+  ! +--Internal Variables
+  ! +  ==================
+
+  integer :: ig,jk,isl
+  real :: mu
+  real :: Tsrf(klonv)               ! surface temperature as extrapolated from soil
+  real :: mug(klonv)                 !hj coef top layers
+  real :: ztherm_i(klonv),zdz2(klonv,-nsol:nsno),z1s
+  real :: pfluxgrd(klonv), pcapcal(klonv), cal(klonv)
+  real :: beta(klonv), dif_grnd(klonv)
+  real :: C_coef(klonv,-nsol:nsno),D_coef(klonv,-nsol:nsno)
+
+  REAL, DIMENSION(klonv)   :: zx_mh, zx_nh, zx_oh
+  REAL, DIMENSION(klonv)   :: zx_mq, zx_nq, zx_oq
+  REAL, DIMENSION(klonv)   :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef
+  REAL, DIMENSION(klonv)   :: zx_sl, zx_k1
+  REAL, DIMENSION(klonv)   :: 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
+  REAL, DIMENSION(klonv)   :: IRs__D, dIRsdT
+
+
+  REAL :: t_grnd                      ! not used
+  parameter(t_grnd = 271.35)       !
+  REAL :: t_coup                      ! distinguish evap/sublimation
+  parameter(t_coup = 273.15)       !
+  REAL :: max_eau_sol
+  parameter(max_eau_sol = 150.0)
+
+
+     ! write(*,*)'T check'
+  !
+  !    DO  ig = 1,knonv
+  !        DO  jk = 1,isnoSV(ig) !nsno
+  !          IF (TsisSV(ig,jk) <= 1.) THEN          !hj check
+  !            TsisSV(ig,jk) = TsisSV(ig,isnoSV(ig))
+  !          ENDIF
+  !
+  !          IF (TsisSV(ig,jk) <= 1.) THEN          !hj check
+  !            TsisSV(ig,jk) = 273.15
+  !          ENDIF
+  !        END DO
+  !        END DO
+
+  !!=======================================================================
+  !! I. First part: corresponds to soil.F90 in LMDZ
+  !!=======================================================================
+
+  DO ig = 1,knonv
+    DO jk =1,isnoSV(ig)
+      dz2_SV(ig,jk)=dzsnSV(ig,jk)
+  !! use arithmetic center between layers to derive dz1 for snow layers for simplicity:
+      dz1_SV(ig,jk)=2./(dzsnSV(ig,jk)+dzsnSV(ig,jk-1))
+    ENDDO
+  ENDDO
+
+  DO ig = 1,knonv
+    ztherm_i(ig)   = inertie_lic
+    IF (isnoSV(ig) > 0) ztherm_i(ig)   = inertie_sno
+  ENDDO
+
+  !!-----------------------------------------------------------------------
+  !! 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 ig=1,knonv
+    DO jk=-nsol,nsno
+      zdz2(ig,jk)=dz2_SV(ig,jk)/dt__SV                                !ptimestep
+    ENDDO
+  ENDDO
+
+  DO ig=1,knonv
+    z1s = zdz2(ig,-nsol)+dz1_SV(ig,-nsol+1)
+    C_coef(ig,-nsol+1)=zdz2(ig,-nsol)*TsisSV(ig,-nsol)/z1s
+    D_coef(ig,-nsol+1)=dz1_SV(ig,-nsol+1)/z1s
+  ENDDO
+
+  DO ig=1,knonv
+    DO jk=-nsol+1,isnoSV(ig)-1,1
+      z1s = 1./(zdz2(ig,jk)+dz1_SV(ig,jk+1)+dz1_SV(ig,jk)           &
+            *(1.-D_coef(ig,jk)))
+      C_coef(ig,jk+1)=                                              &
+            (TsisSV(ig,jk)*zdz2(ig,jk)                              &
+            +dz1_SV(ig,jk)*C_coef(ig,jk)) * z1s
+      D_coef(ig,jk+1)=dz1_SV(ig,jk+1)*z1s
+    ENDDO
+  ENDDO
+
+  !!-----------------------------------------------------------------------
+  !! 2)
+  !! Computation of the soil temperatures using the Cgrd and Dgrd
+  !! coefficient computed above
+  !!
+  !!-----------------------------------------------------------------------
+  !! Extrapolate surface Temperature                   !hj check
+  mu=1./((2.**1.5-1.)/(2.**(0.5)-1.)-1.)
+
+  ! IF (knonv>0) THEN
+  !  DO ig=1,8
+  !    write(*,*)ig,'sisvat: Tsis ',TsisSV(ig,isnoSV(ig))
+  !    write(*,*)'max-1            ',TsisSV(ig,isnoSV(ig)-1)
+  !    write(*,*)'max-2            ',TsisSV(ig,isnoSV(ig)-2)
+  !    write(*,*)'0                ',TsisSV(ig,0)
+  !!        write(*,*)min(max(isnoSV(ig),0),1),max(1-isnoSV(ig),0)
+  !  ENDDO
+  ! END IF
+
+  DO ig=1,knonv
+    IF (isnoSV(ig).GT.0) THEN
+      IF (isnoSV(ig).GT.1) THEN
+       mug(ig)=1./(1.+dzsnSV(ig,isnoSV(ig)-1)/dzsnSV(ig,isnoSV(ig))) !mu
+      ELSE
+       mug(ig) = 1./(1.+dzsnSV(ig,isnoSV(ig)-1)/dz_dSV(0)) !mu
+      ENDIF
+    ELSE
+      mug(ig) = lambSV
+    ENDIF
+
+    IF (mug(ig)  .LE. 0.05) THEN
+     write(*,*)'Attention mu low', mug(ig)
+    ENDIF
+    IF (mug(ig)  .GE. 0.98) THEN
+     write(*,*)'Attention mu high', mug(ig)
+    ENDIF
+
+    Tsrf(ig)=(1.5*TsisSV(ig,isnoSV(ig))-0.5*TsisSV(ig,isnoSV(ig)-1))&
+          *min(max(isnoSV(ig),0),1)+                             &
+          ((mug(ig)+1)*TsisSV(ig,0)-mug(ig)*TsisSV(ig,-1))       &
+          *max(1-isnoSV(ig),0)
+  ENDDO
+
+
+
+  !! Surface temperature
+  DO ig=1,knonv
+  TsisSV(ig,isnoSV(ig))=(mug(ig)*C_coef(ig,isnoSV(ig))+Tsf_SV(ig))/ &
+        (mug(ig)*(1.-D_coef(ig,isnoSV(ig)))+1.)
+  ENDDO
+
+  !! Other temperatures
+  DO ig=1,knonv
+    DO jk=isnoSV(ig),-nsol+1,-1
+      TsisSV(ig,jk-1)=C_coef(ig,jk)+D_coef(ig,jk)                   &
+            *TsisSV(ig,jk)
+    ENDDO
+  ENDDO
+   ! write(*,*)ig,'Tsis',TsisSV(ig,0)
+
+   ! IF (indice == is_sic) THEN
+   !   DO ig = 1,knonv
+   !     TsisSV(ig,-nsol) = RTT - 1.8
+   !   END DO
+   ! ENDIF
+
+  !C      !hj new 11 03 2010
+    DO ig=1,knonv
+      isl         = isnoSV(ig)
+       ! dIRsdT(ig) = Eso_sv(ig)* SteBo   * 4.                        & ! - d(IR)/d(T)
+  ! &                             * Tsf_SV(ig)                         & !T TsisSV(ig,isl)           !
+  ! &                             * Tsf_SV(ig)                         & !TsisSV(ig,isl)           !
+  ! &                             * Tsf_SV(ig) !TsisSV(ig,isl)           !
+  !      IRs__D(ig) = dIRsdT(ig)* Tsf_SV(ig) * 0.75 !TsisSV(ig,isl) * 0.75    !:
+      dIRsdT(ig) = Eso_sv(ig)* StefBo   * 4.                        & ! - d(IR)/d(T)
+            * TsisSV(ig,isl)                     & !
+            * TsisSV(ig,isl)                     & !
+            * TsisSV(ig,isl)                     & !
+      IRs__D(ig) = dIRsdT(ig)* TsisSV(ig,isl) * 0.75                  !:
+     END DO
+   ! !hj
+  !!-----------------------------------------------------------------------
+  !! 3)
+  !! Calculate the Cgrd and Dgrd coefficient corresponding to actual soil
+  !! temperature
+  !!-----------------------------------------------------------------------
+  DO ig=1,knonv
+    z1s = zdz2(ig,-nsol)+dz1_SV(ig,-nsol+1)
+    C_coef(ig,-nsol+1) = zdz2(ig,-nsol)*TsisSV(ig,-nsol)/z1s
+    D_coef(ig,-nsol+1) = dz1_SV(ig,-nsol+1)/z1s
+  ENDDO
+
+  DO ig=1,knonv
+    DO jk=-nsol+1,isnoSV(ig)-1,1
+      z1s = 1./(zdz2(ig,jk)+dz1_SV(ig,jk+1)+dz1_SV(ig,jk)           &
+            *(1.-D_coef(ig,jk)))
+      C_coef(ig,jk+1) = (TsisSV(ig,jk)*zdz2(ig,jk)+                 &
+            dz1_SV(ig,jk)*C_coef(ig,jk)) * z1s
+      D_coef(ig,jk+1) = dz1_SV(ig,jk+1)*z1s
+    ENDDO
+  ENDDO
+
+  !!-----------------------------------------------------------------------
+  !! 4)
+  !! Computation of the surface diffusive flux from ground and
+  !! calorific capacity of the ground
+  !!-----------------------------------------------------------------------
+  DO ig=1,knonv
+  !! (pfluxgrd)
+    pfluxgrd(ig) = ztherm_i(ig)*dz1_SV(ig,isnoSV(ig))*              &
+          (C_coef(ig,isnoSV(ig))+(D_coef(ig,isnoSV(ig))-1.)           &
+          *TsisSV(ig,isnoSV(ig)))
+  !! (pcapcal)
+    pcapcal(ig)  = ztherm_i(ig)*                                    &
+          (dz2_SV(ig,isnoSV(ig))+dt__SV*(1.-D_coef(ig,isnoSV(ig)))    &
+          *dz1_SV(ig,isnoSV(ig)))
+    z1s = mug(ig)*(1.-D_coef(ig,isnoSV(ig)))+1.
+    pcapcal(ig)  = pcapcal(ig)/z1s
+    pfluxgrd(ig) = ( pfluxgrd(ig)                                   &
+          + pcapcal(ig) * (TsisSV(ig,isnoSV(ig)) * z1s               &
+          - mug(ig)* C_coef(ig,isnoSV(ig))                           &
+          - Tsf_SV(ig))       /dt__SV )
+  ENDDO
+
+
+  cal(1:knonv) = RCPD / pcapcal(1:knonv)
+  rsolSV(1:knonv)  = rsolSV(1:knonv) + pfluxgrd(1:knonv)
+  !!=======================================================================
+  !! II. Second part: corresponds to calcul_fluxs_mod.F90 in LMDZ
+  !!=======================================================================
+
+  Evp_sv = 0.
+  ! #NC HSsoKL=0.
+  ! #NC HLsoKL=0.
+  dSdTSV = 0.
+  dLdTSV = 0.
+
+  beta(:) = 1.0
+  dif_grnd(:) = 0.0
+
+  !! zx_qs = qsat en kg/kg
+  !!**********************************************************************x***************
+
+  DO ig = 1,knonv
+    IF (ps__SV(ig).LT.1.) THEN
+       ! write(*,*)'ig',ig,'ps',ps__SV(ig)
+      ps__SV(ig)=max(ps__SV(ig),1.e-8)
+    ENDIF
+    IF (p1l_SV(ig).LT.1.) THEN
+       ! write(*,*)'ig',ig,'p1l',p1l_SV(ig)
+      p1l_SV(ig)=max(p1l_SV(ig),1.e-8)
+    ENDIF
+    IF (TaT_SV(ig).LT.180.) THEN
+       ! write(*,*)'ig',ig,'TaT',TaT_SV(ig)
+      TaT_SV(ig)=max(TaT_SV(ig),180.)
+    ENDIF
+    IF (QaT_SV(ig).LT.1.e-8) THEN
+       ! write(*,*)'ig',ig,'QaT',QaT_SV(ig)
+      QaT_SV(ig)=max(QaT_SV(ig),1.e-8)
+    ENDIF
+    IF (Tsf_SV(ig).LT.100.) THEN
+       ! write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
+      Tsf_SV(ig)=max(Tsf_SV(ig),180.)
+    ENDIF
+    IF (Tsf_SV(ig).GT.500.) THEN
+       ! write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
+      Tsf_SV(ig)=min(Tsf_SV(ig),400.)
+    ENDIF
+      ! IF (Tsrf(ig).LT.1.) THEN
+  !!          write(*,*)'ig',ig,'Tsrf',Tsrf(ig)
+      !   Tsrf(ig)=max(Tsrf(ig),TaT_SV(ig)-20.)
+      ! ENDIF
+     IF (cdH_SV(ig).LT.1.e-10) THEN
+        ! IF (ig.le.3)   write(*,*)'ig',ig,'cdH',cdH_SV(ig)
+       cdH_SV(ig)=.5
+     ENDIF
+  ENDDO
+
+
+  DO ig = 1,knonv
+    zx_pkh(ig) = 1. ! (ps__SV(ig)/ps__SV(ig))**RKAPPA
+    IF (thermcep) THEN
+      zdelta=MAX(0.,SIGN(1.,rtt-Tsf_SV(ig)))
+      zcvm5 = R5LES*LhvH2O*(1.-zdelta) + R5IES*LhsH2O*zdelta
+      zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*QaT_SV(ig))
+      zx_qs= r2es * FOEEW(Tsf_SV(ig),zdelta)/ps__SV(ig)
+      zx_qs=MIN(0.5,zx_qs)
+      ! !write(*,*)'zcor',retv*zx_qs
+      zcor=1./(1.-retv*zx_qs)
+      zx_qs=zx_qs*zcor
+      zx_dq_s_dh = FOEDE(Tsf_SV(ig),zdelta,zcvm5,zx_qs,zcor)        &
+            /LhvH2O / zx_pkh(ig)
+    ELSE
+      IF (Tsf_SV(ig).LT.t_coup) THEN
+         zx_qs = qsats(Tsf_SV(ig)) / ps__SV(ig)
+         zx_dq_s_dh = dqsats(Tsf_SV(ig),zx_qs)/LhvH2O               &
+               / zx_pkh(ig)
+      ELSE
+         zx_qs = qsatl(Tsf_SV(ig)) / ps__SV(ig)
+         zx_dq_s_dh = dqsatl(Tsf_SV(ig),zx_qs)/LhvH2O               &
+               / zx_pkh(ig)
+      ENDIF
+    ENDIF
+    zx_dq_s_dt(ig) = RCPD * zx_pkh(ig) * zx_dq_s_dh
+    zx_qsat(ig) = zx_qs
+     ! zx_coef(ig) = cdH_SV(ig) *                                     &
+  ! &       (1.0+SQRT(u1lay(ig)**2+v1lay(ig)**2)) *                   &
+  ! &       p1l_SV(ig)/(RD*t1lay(ig))
+    zx_coef(ig) = cdH_SV(ig) *                                      &
+          (1.0+VV__SV(ig)) *                                         &
+          p1l_SV(ig)/(RD*TaT_SV(ig))
+
+  ENDDO
+
+
+  !! === Calcul de la temperature de surface ===
+  !! zx_sl = chaleur latente d'evaporation ou de sublimation
+  !!****************************************************************************
+
+  DO ig = 1,knonv
+    zx_sl(ig) = LhvH2O
+    IF (Tsf_SV(ig) .LT. RTT) zx_sl(ig) = LhsH2O
+    zx_k1(ig) = zx_coef(ig)
+  ENDDO
+
+
+  DO ig = 1,knonv
+  !! Q
+    zx_oq(ig) = 1. - (beta(ig) * zx_k1(ig) * BcoQSV(ig) * dt__SV)
+    zx_mq(ig) = beta(ig) * zx_k1(ig) *                              &
+          (AcoQSV(ig) - zx_qsat(ig) +                                &
+          zx_dq_s_dt(ig) * Tsf_SV(ig))                               &
+          / zx_oq(ig)
+    zx_nq(ig) = beta(ig) * zx_k1(ig) * (-1. * zx_dq_s_dt(ig))       &
+          / zx_oq(ig)
+
+  !! H
+    zx_oh(ig) = 1. - (zx_k1(ig) * BcoHSV(ig) * dt__SV)
+    zx_mh(ig) = zx_k1(ig) * AcoHSV(ig) / zx_oh(ig)
+    zx_nh(ig) = - (zx_k1(ig) * RCPD * zx_pkh(ig))/ zx_oh(ig)
+
+  !! surface temperature
+    TsfnSV(ig) = (Tsf_SV(ig) + cal(ig)/RCPD * zx_pkh(ig) * dt__SV * &
+          (rsolSV(ig) + zx_mh(ig) + zx_sl(ig) * zx_mq(ig))           &
+          + dif_grnd(ig) * t_grnd * dt__SV)/                         &
+          ( 1. - dt__SV * cal(ig)/(RCPD * zx_pkh(ig)) *              &
+          (zx_nh(ig) + zx_sl(ig) * zx_nq(ig))                        &
+          + dt__SV * dif_grnd(ig))
+
+  !hj rajoute 22 11 2010 tuning...
+    TsfnSV(ig) = min(RTT+0.02,TsfnSV(ig))
+
+    d_ts(ig) = TsfnSV(ig) - Tsf_SV(ig)
+
+
+  !!== 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)
+    Evp_sv(ig) = - zx_mq(ig) - zx_nq(ig) * TsfnSV(ig)
+    HLs_sv(ig) = - Evp_sv(ig) * zx_sl(ig)
+    HSs_sv(ig) = zx_mh(ig) + zx_nh(ig) * TsfnSV(ig)
+
+  !! Derives des flux dF/dTs (W m-2 K-1):
+    dSdTSV(ig) = zx_nh(ig)
+    dLdTSV(ig) = zx_sl(ig) * zx_nq(ig)
+
+
+  !hj  new 11 03 2010
+    isl         = isnoSV(ig)
+     ! TsisSV(ig,isl) = TsfnSV(ig)
+    IRs_SV(ig) = IRs__D(ig)                                         & !
+          - dIRsdT(ig) * TsfnSV(ig) !TsisSV(ig,isl)?      !
+
+  ! hj
+  ! #NC   SOsoKL(ig) = sol_SV(ig) * SoSosv(ig)              ! Absorbed Sol.
+  ! #NC   IRsoKL(ig) =               IRs_SV(ig)                           & !Up Surf. IR
+  ! #NC&        +     tau_sv(ig)      *IRd_SV(ig)*Eso_sv(ig)              & !Down Atm IR
+  ! #NC&        -(1.0-tau_sv(ig)) *0.5*IRv_sv(ig)            ! Down Veg IR
+  ! #NC   HLsoKL(ig) = HLs_sv(ig)
+  ! #NC   HSsoKL(ig) = HSs_sv(ig)
+  ! #NC   HLs_KL(ig) = Evp_sv(ig)
+
+  !! Nouvelle valeure de l'humidite au dessus du sol
+    qsat_new=zx_qsat(ig) + zx_dq_s_dt(ig) * d_ts(ig)
+    q1_new = AcoQSV(ig) - BcoQSV(ig)* Evp_sv(ig)*dt__SV
+    QaT_SV(ig)=q1_new*(1.-beta(ig)) + beta(ig)*qsat_new
+
+  ENDDO
+
+end subroutine sisvat_ts2
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_tso.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_tso.F	(revision 5084)
+++ 	(revision )
@@ -1,675 +1,0 @@
- 
- 
- 
- 
-      subroutine SISVAT_TSo
-! #e1.                     (ETSo_0,ETSo_1,ETSo_d)
- 
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_TSo                                06-10-2020  MAR |
-C |   SubRoutine SISVAT_TSo computes the Soil/Snow Energy Balance          |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  knonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-C |                     X       Number of Mosaic Cell per grid box         |
-C |                                                                        |
-C |   INPUT:   isotSV   = 0,...,11:   Soil       Type                      |
-C |   ^^^^^               0:          Water, Solid or Liquid               |
-C |            isnoSV   = total Nb of Ice/Snow Layers                      |
-C |            dQa_SV   = Limitation of  Water Vapor  Turbulent Flux       |
-C |                                                                        |
-C |   INPUT:   sol_SV   : Downward Solar Radiation                  [W/m2] |
-C |   ^^^^^    IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |
-C |            za__SV   : SBL Top    Height                            [m] |
-C |            VV__SV   : SBL Top    Wind Speed                      [m/s] |
-C |            TaT_SV   : SBL Top    Temperature                       [K] |
-C |            rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
-C |            QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
-C |            LSdzsv   : Vertical   Discretization Factor             [-] |
-C |                     =    1. Soil                                       |
-C |                     = 1000. Ocean                                      |
-C |            dzsnSV   : Snow Layer Thickness                         [m] |
-C |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
-C |            eta_SV   : Soil Water Content                       [m3/m3] |
-C |            dt__SV   : Time Step                                    [s] |
-C |                                                                        |
-C |            SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
-C |            Eso_sv   : Soil+Snow       Emissivity                   [-] |
-C |            rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
-C |            Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
-C |            sEX_sv   : Verticaly Integrated Extinction Coefficient  [-] |
-C |                                                                        |
-C |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
-C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
-C |   ^^^^^^                                                               |
-C |                                                                        |
-C |   OUTPUT:  IRs_SV   : Soil      IR Radiation                    [W/m2] |
-C |   ^^^^^^   HSs_sv   : Sensible  Heat Flux                       [W/m2] |
-C |            HLs_sv   : Latent    Heat Flux                       [W/m2] |
-C |            ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |
-C |            ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |
-C |            ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |
-C |                                                                        |
-C |   Internal Variables:                                                  |
-C |   ^^^^^^^^^^^^^^^^^^                                                   |
-C |                                                                        |
-C |   METHOD: NO   Skin Surface Temperature                                |
-C |   ^^^^^^  Semi-Implicit Crank Nicholson Scheme                         |
-C |                                                                        |
-C | # OPTIONS: #E0: Energy Budget Verification                             |
-C | # ^^^^^^^  #kd: KDsvat Option:NO Flux  Limitor     on HL               |
-C | #          #KD: KDsvat Option:Explicit Formulation of HL               |
-C | #          #NC: OUTPUT for Stand Alone NetCDF File                     |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
- 
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VARxSV
-      use VARySV
-      use VARtSV
-      use VAR0SV
-      
-
-      IMPLICIT NONE
-
- 
-C +--OUTPUT
-C +  ------
- 
-! #e1 real      ETSo_0(knonv)                 ! Soil/Snow Power, before Forcing
-! #e1 real      ETSo_1(knonv)                 ! Soil/Snow Power, after  Forcing
-! #e1 real      ETSo_d(knonv)                 ! Soil/Snow Power, Forcing
- 
- 
-C +--Internal Variables
-C +  ==================
- 
-      integer   ikl   ,isl   ,jsl   ,ist      !
-      integer   ist__s,ist__w                 ! Soil/Water  Body Identifier
-      integer   islsgn                        ! Soil/Snow Surfac.Identifier
-      real      eps__3                        ! Arbitrary    Low Number
-      real      etaMid,psiMid                 ! Layer Interface's Humidity
-      real      mu_eta                        !     Soil thermal Conductivity
-      real      mu_exp                        ! arg Soil thermal Conductivity
-      real      mu_min                        ! Min Soil thermal Conductivity
-      real      mu_max                        ! Max Soil thermal Conductivity
-      real      mu_sno(knonv),mu_aux          !     Snow thermal Conductivity
-      real      mu__dz(knonv,-nsol:nsno+1)    ! mu_(eta,sno)   / dz
-      real      dtC_sv(knonv,-nsol:nsno)      ! dt      / C
-      real      IRs__D(knonv)                 ! UpwardIR Previous Iter.Contr.
-      real      dIRsdT(knonv)                 ! UpwardIR           T Derivat.
-      real      f_HSHL(knonv)                 ! Factor common to HS and HL
-      real      dRidTs(knonv)                 ! d(Rib)/d(Ts)
-      real      HS___D(knonv)                 ! Sensible Heat Flux Atm.Contr.
-      real      f___HL(knonv)                 !
-      real      HL___D(knonv)                 ! Latent   Heat Flux Atm.Contr.
-      REAL      TSurf0(knonv),dTSurf          ! Previous Surface Temperature
-      real      qsatsg(knonv) !,den_qs,arg_qs ! Soil   Saturat. Spec. Humidity
-      real      dqs_dT(knonv)                 ! d(qsatsg)/dTv
-      real      Psi(   knonv)                 ! 1st Soil Layer Water Potential
-      real      RHuSol(knonv)                 ! Soil Surface Relative Humidity
-      real      etaSol                        ! Soil Surface          Humidity
-      real      d__eta                        ! Soil Surface Humidity Increm.
-      real      Elem_A,Elem_C                 !   Diagonal Coefficients
-      real      Diag_A(knonv,-nsol:nsno)      ! A Diagonal
-      real      Diag_B(knonv,-nsol:nsno)      ! B Diagonal
-      real      Diag_C(knonv,-nsol:nsno)      ! C Diagonal
-      real      Term_D(knonv,-nsol:nsno)      !   Independant Term
-      real      Aux__P(knonv,-nsol:nsno)      ! P Auxiliary Variable
-      real      Aux__Q(knonv,-nsol:nsno)      ! Q Auxiliary Variable
-      real      Ts_Min,Ts_Max                 ! Temperature Limits
-! #e1 real      Exist0                        ! Existing Layer Switch
-      real      psat_wat, psat_ice, sp        ! computation of qsat
-
-      integer   nt_srf,it_srf,itEuBk          ! HL: Surface Scheme
-      parameter(nt_srf=10)                     ! 10 before
-      real      agpsrf,xgpsrf,dt_srf,dt_ver   !
-      real      etaBAK(knonv)                 !
-      real      etaNEW(knonv)                 !
-      real      etEuBk(knonv)                 !
-      real      fac_dt(knonv),faceta(knonv)   !
-      real      PsiArg(knonv),SHuSol(knonv)   !
- 
-
- 
-C +--Internal DATA
-C +  =============
- 
-      data      eps__3 /   1.e-3   /          ! Arbitrary    Low Number
-      data      mu_exp /  -0.4343  /          ! Soil Thermal Conductivity
-      data      mu_min /   0.172   /          ! Min Soil Thermal Conductivity
-      data      mu_max /   2.000   /          ! Max Soil Thermal Conductivity
-      data      Ts_Min / 175.      /          ! Temperature            Minimum
-      data      Ts_Max / 300.      /          ! Temperature Acceptable Maximum
-C +                                           ! including   Snow Melt  Energy
- 
-C +-- Initilialisation of local arrays
-C +   ================================
-        DO ikl=1,knonv
-
-          mu_sno(ikl)=0.
-          mu__dz(ikl,:)=0.    
-          dtC_sv(ikl,:)=0.      
-          IRs__D(ikl)=0.                 
-          dIRsdT(ikl)=0.                 
-          f_HSHL(ikl)=0.                 
-          dRidTs(ikl)=0.                 
-          HS___D(ikl)=0.                
-          f___HL(ikl)=0.             
-          HL___D(ikl)=0.            
-          TSurf0(ikl)=0.      
-          qsatsg(ikl)=0. 
-          dqs_dT(ikl)=0.                 
-          Psi(ikl)=0.               
-          RHuSol(ikl)=0.                 
-          Diag_A(ikl,:)=0.      
-          Diag_B(ikl,:)=0.      
-          Diag_C(ikl,:)=0.      
-          Term_D(ikl,:)=0.      
-          Aux__P(ikl,:)=0.      
-          Aux__Q(ikl,:)=0.      
-          etaBAK(ikl)=0.                
-          etaNEW(ikl)=0.               
-          etEuBk(ikl)=0.                 
-          fac_dt(ikl)=0. 
-          faceta(ikl)=0.  
-          PsiArg(ikl)=0. 
-          SHuSol(ikl)=0.  
-
-        END DO
-
-        
-
-C +--Heat Conduction Coefficient (zero in the Layers over the highest one)
-C +  ===========================
-C +                             ---------------- isl    eta_SV, rho C (isl)
-C +
-C +--Soil                       ++++++++++++++++        etaMid,    mu (isl)
-C +  ----
-C +                             ---------------- isl-1  eta_SV, rho C (isl-1)
-           isl=-nsol
-        DO ikl=1,knonv
-
-          mu__dz(ikl,isl) = 0.
- 
-          dtC_sv(ikl,isl) = dtz_SV2(isl)  * dt__SV        ! dt / (dz X rho C)
-     .                   /((rocsSV(isotSV(ikl))           ! [s / (m.J/m3/K)]
-     .                     +rcwdSV*eta_SV(ikl,isl))       !
-     .                     *LSdzsv(ikl)            )      !
-        END DO
-      DO   isl=-nsol+1,0
-        DO ikl=1,knonv
-          ist    =      isotSV(ikl)                       ! Soil Type
-          ist__s =  min(ist, 1)                           ! 1 => Soil
-          ist__w =  1 - ist__s                            ! 1 => Water Body
- 
-          etaMid = 0.5*(dz_dSV(isl-1)*eta_SV(ikl,isl-1)   ! eta at layers
-     .                 +dz_dSV(isl)  *eta_SV(ikl,isl)  )  !     interface
-     .                 /dzmiSV(isl)                       ! LSdzsv implicit !
-          etaMid =  max(etaMid,epsi)
-          psiMid =      psidSV(ist)
-     .                *(etadSV(ist)/etaMid)**bCHdSV(ist)
-          mu_eta =      3.82      *(psiMid)**mu_exp       ! Soil Thermal
-          mu_eta =  min(max(mu_eta, mu_min), mu_max)      ! Conductivity
-C +                                                       ! DR97 eq.3.31
-          mu_eta =  ist__s *mu_eta +ist__w * vK_dSV       ! Water Bodies
-C +                                                       ! Correction
-          mu__dz(ikl,isl) = mu_eta/(dzmiSV(isl)           !
-     .                             *LSdzsv(ikl))          !
- 
-          dtC_sv(ikl,isl) = dtz_SV2(isl)* dt__SV          ! dt / (dz X rho C)
-     .                   /((rocsSV(isotSV(ikl))           !
-     .                     +rcwdSV*eta_SV(ikl,isl))       !
-     .                     *LSdzsv(ikl)            )      !
-        END DO
-      END DO
- 
- 
-C +--Soil/Snow Interface
-C +  -------------------
- 
-C +--Soil Contribution
-C +  ^^^^^^^^^^^^^^^^^
-           isl=1
-        DO ikl=1,knonv
-          ist    =      isotSV(ikl)                       ! Soil Type
-          ist__s =  min(ist, 1)                           ! 1 => Soil
-          ist__w =  1 - ist__s                            ! 1 => Water Body
-          psiMid =      psidSV(ist)                       ! Snow => Saturation
-          mu_eta =      3.82      *(psiMid)**mu_exp       ! Soil Thermal
-          mu_eta =  min(max(mu_eta, mu_min), mu_max)      ! Conductivity
-C +                                                       ! DR97 eq.3.31
-          mu_eta =  ist__s *mu_eta +ist__w * vK_dSV       ! Water Bodies
- 
-C +--Snow Contribution
-C +  ^^^^^^^^^^^^^^^^^
-          mu_sno(ikl) =  CdidSV                           !
-     .                 *(ro__SV(ikl,isl) /ro_Wat) ** 1.88 !
-          mu_sno(ikl) =          max(epsi,mu_sno(ikl))    !
-C +...    mu_sno :  Snow Heat Conductivity Coefficient [Wm/K]
-C +                 (Yen 1981, CRREL Rep., 81-10)
- 
-C +--Combined Heat Conductivity
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-          mu__dz(ikl,isl) = 2./(dzsnSV(ikl,isl  )         ! Combined Heat
-     .                         /mu_sno(ikl)               ! Conductivity
-     .                         +LSdzsv(ikl)               !
-     .                         *dz_dSV(    isl-1)/mu_eta) ! Coefficient
- 
-C +--Inverted Heat Capacity
-C +  ^^^^^^^^^^^^^^^^^^^^^^
-          dtC_sv(ikl,isl) = dt__SV/max(epsi,              ! dt / (dz X rho C)
-     .    dzsnSV(ikl,isl) * ro__SV(ikl,isl) *Cn_dSV)      !
-        END DO
- 
- 
-C +--Snow
-C +  ----
- 
-      DO ikl=1,knonv
-      DO   isl=1,min(nsno,isnoSV(ikl)+1)
-          ro__SV(ikl,isl) =                               !
-     .                   ro__SV(ikl ,isl)                 !
-     .       * max(0,min(isnoSV(ikl)-isl+1,1))            !
-
-        END DO
-      END DO
- 
-      DO ikl=1,knonv
-      DO   isl=1,min(nsno,isnoSV(ikl)+1)
- 
-C +--Combined Heat Conductivity
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-          mu_aux      =  CdidSV                           !
-     .                 *(ro__SV(ikl,isl) /ro_Wat) ** 1.88 !
-          mu__dz(ikl,isl) =                               !
-     .      2.                        *mu_aux*mu_sno(ikl) ! Combined Heat
-     .     /max(epsi,dzsnSV(ikl,isl  )*mu_sno(ikl)        ! Conductivity
-     .              +dzsnSV(ikl,isl-1)*mu_aux     )       ! For upper Layer
-          mu_sno(ikl)     =            mu_aux             !
- 
-C +--Inverted Heat Capacity
-C +  ^^^^^^^^^^^^^^^^^^^^^^
-          dtC_sv(ikl,isl) = dt__SV/max(eps__3,            ! dt / (dz X rho C)
-     .    dzsnSV(ikl,isl) * ro__SV(ikl,isl) *Cn_dSV)      !
-        END DO
-      END DO
- 
- 
-C +--Uppermost Effective Layer: NO conduction
-C +  ----------------------------------------
- 
-        DO ikl=1,knonv
-          mu__dz(ikl,isnoSV(ikl)+1) = 0.0
-        END DO
- 
- 
-C +--Energy Budget (IN)
-C +  ==================
- 
-! #e1   DO ikl=1,knonv
-! #e1     ETSo_0(ikl) = 0.
-! #e1   END DO
-! #e1 DO   isl= -nsol,nsno
-! #e1   DO ikl=1,knonv
-! #e1     Exist0      = isl -           isnoSV(ikl)
-! #e1     Exist0      = 1.  - max(zero,min(unun,Exist0))
-! #e1     ETSo_0(ikl) = ETSo_0(ikl)
-! #e1.                +(TsisSV(ikl,isl)-TfSnow)*Exist0
-! #e1.                                 /dtC_sv(ikl,isl)
-! #e1   END DO
-! #e1 END DO
- 
- 
-C +--Tridiagonal Elimination: Set Up
-C +  ===============================
- 
-C +--Soil/Snow Interior
-C +  ^^^^^^^^^^^^^^^^^^
-      DO ikl=1,knonv
-      DO   isl=-nsol+1,min(nsno-1,isnoSV(ikl)+1)
-
-          Elem_A          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl)
-          Elem_C          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl+1)
-          Diag_A(ikl,isl) = -Elem_A  *Implic
-          Diag_C(ikl,isl) = -Elem_C  *Implic
-          Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)-Diag_C(ikl,isl)
-          Term_D(ikl,isl) =  Explic *(Elem_A         *TsisSV(ikl,isl-1)
-     .                               +Elem_C         *TsisSV(ikl,isl+1))
-     .             +(1.0d+0 -Explic *(Elem_A+Elem_C))*TsisSV(ikl,isl)
-     .  + dtC_sv(ikl,isl)           * sol_SV(ikl)    *SoSosv(ikl)
-     .                                               *(sEX_sv(ikl,isl+1)
-     .                                               -sEX_sv(ikl,isl  ))
-        END DO
-      END DO
- 
-C +--Soil  lowest Layer
-C +  ^^^^^^^^^^^^^^^^^^
-           isl= -nsol
-        DO ikl=1,knonv
-          Elem_A          =  0.
-          Elem_C          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl+1)
-          Diag_A(ikl,isl) =  0.
-          Diag_C(ikl,isl) = -Elem_C  *Implic
-          Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)-Diag_C(ikl,isl)
-          Term_D(ikl,isl) =  Explic * Elem_C         *TsisSV(ikl,isl+1)
-     .             +(1.0d+0 -Explic * Elem_C)        *TsisSV(ikl,isl)
-     .  + dtC_sv(ikl,isl)           * sol_SV(ikl)    *SoSosv(ikl)
-     .                                              *(sEX_sv(ikl,isl+1)
-     .                                               -sEX_sv(ikl,isl  ))
-        END DO
- 
-C +--Snow highest Layer (dummy!)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-        !EV!isl=  min(isnoSV(1)+1,nsno)
-
-        DO ikl=1,knonv
-! EV try to calculate isl at the ikl grid point
-          isl=  min(isnoSV(ikl)+1,nsno)
-
-          Elem_A          =  dtC_sv(ikl,isl)  *mu__dz(ikl,isl)
-          Elem_C          =  0.
-          Diag_A(ikl,isl) = -Elem_A  *Implic
-          Diag_C(ikl,isl) =  0.
-          Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)
-          Term_D(ikl,isl) =  Explic * Elem_A  *TsisSV(ikl,isl-1)
-     .             +(1.0d+0 -Explic * Elem_A) *TsisSV(ikl,isl)
-     .  + dtC_sv(ikl,isl) * (sol_SV(ikl)      *SoSosv(ikl)
-     .                                       *(sEX_sv(ikl,isl+1)
-     .                                        -sEX_sv(ikl,isl  )))
-        END DO
- 
-C +--Surface: UPwardIR Heat Flux
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-        DO ikl=1,knonv
-          isl         = isnoSV(ikl)
-          dIRsdT(ikl) = Eso_sv(ikl)* StefBo          * 4.      ! - d(IR)/d(T)
-     .                             * TsisSV(ikl,isl)           !
-     .                             * TsisSV(ikl,isl)           !
-     .                             * TsisSV(ikl,isl)           !
-          IRs__D(ikl) = dIRsdT(ikl)* TsisSV(ikl,isl) * 0.75    !
- 
-C +--Surface: Richardson Number:   T Derivative
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-c #RC     dRidTs(ikl) =-gravit      *    za__SV(ikl)
-c #RC.                /(TaT_SV(ikl) *    VV__SV(ikl)
-c #RC.                              *    VV__SV(ikl))
- 
-C +--Surface: Turbulent Heat Flux: Factors
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          f_HSHL(ikl) = rhT_SV(ikl)  /    rah_sv(ikl)           ! to  HS, HL
-          f___HL(ikl) = f_HSHL(ikl) *    Lx_H2O(ikl)
- 
-C +--Surface: Sensible  Heat Flux: T Derivative
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          dSdTSV(ikl) = f_HSHL(ikl) *    Cp                    !#- d(HS)/d(T)
-c #RC.         *(1.0  -(TsisSV(ikl,isl) -TaT_SV(ikl))          !#Richardson
-c #RC.         * dRidTs(ikl)*dFh_sv(ikl)/rah_sv(ikl))          ! Nb. Correct.
-          HS___D(ikl) = dSdTSV(ikl) *    TaT_SV(ikl)           !
- 
-C +--Surface: Latent    Heat Flux: Saturation Specific Humidity
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-c         den_qs      =         TsisSV(ikl,isl)- 35.8          !
-c         arg_qs      = 17.27 *(TsisSV(ikl,isl)-273.16)        !
-c    .                                   / den_qs              !
-c         qsatsg(ikl) = .0038 *        exp(arg_qs)             !
-!          sp = (pst_SV(ikl) + ptopSV) * 10.
-
-          !sp=ps__SV(ikl)
-          ! Etienne: in the formula herebelow sp should be in hPa, not
-          ! in Pa so I divide by 100.
-          sp=ps__SV(ikl)/100.
-          psat_ice = 6.1070 * exp(6150. *(1./273.16 -
-     .                                              1./TsisSV(ikl,isl)))
-
-          psat_wat = 6.1078 * exp (5.138*log(273.16   /TsisSV(ikl,isl)))
-     .             * exp (6827.*(1.         /273.16-1./TsisSV(ikl,isl)))
-
-          if(TsisSV(ikl,isl)<=273.16) then
-            qsatsg(ikl) = 0.622 * psat_ice / (sp - 0.378 * psat_ice)
-          else
-            qsatsg(ikl) = 0.622 * psat_wat / (sp - 0.378 * psat_wat)
-          endif
-          QsT_SV(ikl)=qsatsg(ikl)
-
-c         dqs_dT(ikl) = qsatsg(ikl)* 4099.2   /(den_qs *den_qs)!
-          fac_dt(ikl) = f_HSHL(ikl)/(ro_Wat   * dz_dSV(0))     !
-        END DO
-
-
- 
-C +--Surface: Latent    Heat Flux: Surface    Relative Humidity
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-              xgpsrf       =   1.05                            !
-              agpsrf       = dt__SV*(   1.0-xgpsrf        )    !
-     .                             /(   1.0-xgpsrf**nt_srf)    !
-              dt_srf       = agpsrf                            !
-              dt_ver       = 0.                
-
-            DO ikl=1,knonv
-              isl          =          isnoSV(ikl)              
-              ist          = max(0,isotSV(ikl)-100*isnoSV(ikl))! 0 if    H2O                          
-              ist__s       = min(1,ist)                                                                             
-              etaBAK(ikl)  = max(epsi,eta_SV(ikl ,isl))        !
-              etaNEW(ikl)  =          etaBAK(ikl)              !
-              etEuBk(ikl)  =          etaNEW(ikl)              !
-            END DO      
-
-        if(ist__s==1) then ! to reduce computer time                                                  
-                                          !
-        DO it_srf=1,nt_srf                                     !
-              dt_ver       = dt_ver     +dt_srf                !
-            DO ikl=1,knonv                                     !
-              faceta(ikl)  = fac_dt(ikl)*dt_srf                !
-c #VX         faceta(ikl)  = faceta(ikl)                       !
-c #VX.                  /(1.+faceta(ikl)*dQa_SV(ikl))          !    Limitation
-                                                               ! by Atm.Conten
-c #??.        *max(0,sign(1.,qsatsg(ikl)-QaT_SV(ikl))))        ! NO Limitation
-                                                               ! of Downw.Flux
-            END DO                                             !
-          DO itEuBk=1,2                                        !
-            DO ikl=1,knonv
-              ist    = max(0,isotSV(ikl)-100*isnoSV(ikl))      ! 0 if    H2O
-                                                               !
-              Psi(ikl) =                                       !
-     .                psidSV(ist)                              ! DR97, Eqn 3.34
-     .              *(etadSV(ist)                              !
-     .           /max(etEuBk(ikl),epsi))                       !
-     .              **bCHdSV(ist)                              !
-              PsiArg(ikl) = 7.2E-5*Psi(ikl)                    !
-              RHuSol(ikl) =   exp(-min(0.,PsiArg(ikl)))    !
-              SHuSol(ikl) =     qsatsg(ikl)  *RHuSol(ikl)      ! DR97, Eqn 3.15
-              etEuBk(ikl) =                                    !
-     .       (etaNEW(ikl) + faceta(ikl)*(QaT_SV(ikl)           !
-     .                                  -SHuSol(ikl)           !
-     .                    *(1.          -bCHdSV(ist)           !
-     .                                  *PsiArg(ikl))       )) !
-     .      /(1.          + faceta(ikl)* SHuSol(ikl)           !
-     .                                  *bCHdSV(ist)           !
-     .                                  *PsiArg(ikl)           !
-     .                                  /etaNEW(ikl))          !
-              etEuBk(ikl) = etEuBk(ikl)          !
-c    .                                 /(Ro_Wat*dz_dSV(0))     !
-     .                    * dt_srf     /(Ro_Wat*dz_dSV(0))     !
-cXF 15/05/2017 BUG
-            END DO                                             !
-          END DO                                               !
-            DO ikl=1,knonv                                     !
-              etaNEW(ikl) =  max(etEuBk(ikl),epsi)             !
-            END DO                                             !
-              dt_srf      =      dt_srf         * xgpsrf       !
-        END DO          
-
-
-        endif                                       !
- 
-C +--Surface: Latent    Heat Flux: Soil/Water Surface Contributions
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-        DO ikl=1,knonv                                         !
-          isl        =  isnoSV(ikl)                            !
-          ist   = max(0,isotSV(ikl)-100*isnoSV(ikl))           ! 0 if    H2O
-          ist__s= min(1,ist)                                   ! 1 if no H2O
-          ist__w=     1-ist__s                                 ! 1 if    H2O
-          d__eta     =  eta_SV(ikl,isl)-etaNEW(ikl)            !
-          ! latent heat flux computation
-          HL___D(ikl)=( ist__s *ro_Wat *dz_dSV(0)              ! Soil Contrib.
-     .                *(etaNEW(ikl)    -etaBAK(ikl)) / dt__SV  !
-     .                 +ist__w         *f_HSHL(ikl)            ! H2O  Contrib.
-     .                *(QaT_SV(ikl)    - qsatsg(ikl))        ) !
-     .                * Lx_H2O(ikl)                            ! common factor
- 
-c #DL     RHuSol(ikl) =(QaT_SV(ikl)                            !
-c #DL.                 -HL___D(ikl)    / f___HL(ikl))          !
-c #DL.                / qsatsg(ikl)                            !
- 
-C +--Surface: Latent    Heat Flux: T Derivative
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          dLdTSV(ikl) = 0.
-c #DL     dLdTSV(ikl) = f___HL(ikl) * RHuSol(ikl) *dqs_dT(ikl) ! - d(HL)/d(T)
-c #DL     HL___D(ikl) = HL___D(ikl)                            !
-c #DL.                 +dLdTSV(ikl) * TsisSV(ikl,isl)          !
-        END DO                                                 !
- 
-C +--Surface: Tridiagonal Matrix Set Up
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-        DO ikl=1,knonv
-          isl             =  isnoSV(ikl)
-          TSurf0(ikl)     =  TsisSV(ikl,isl)
-
-          Elem_A          =  dtC_sv(ikl,isl)*mu__dz(ikl,isl)
-          Elem_C          =  0.
-          Diag_A(ikl,isl) = -Elem_A *Implic
-          Diag_C(ikl,isl) =  0.
-          Diag_B(ikl,isl) =  1.0d+0 -Diag_A(ikl,isl)
-          Diag_B(ikl,isl) =  Diag_B(ikl,isl)
-     .  + dtC_sv(ikl,isl) * (dIRsdT(ikl)                       ! Upw. Sol IR
-     .                      +dSdTSV(ikl)                       ! HS/Surf.Contr.
-     .                      +dLdTSV(ikl))                      ! HL/Surf.Contr.
-
-          Term_D(ikl,isl) =  Explic *Elem_A *TsisSV(ikl,isl-1)
-     .             +(1.0d+0 -Explic *Elem_A)*TsisSV(ikl,isl)
-
-
-
-          Term_D(ikl,isl) =  Term_D(ikl,isl)
-     .  + dtC_sv(ikl,isl) * (sol_SV(ikl)    *SoSosv(ikl)       ! Absorbed
-     .                                     *(sEX_sv(ikl,isl+1) ! Solar
-     .                                      -sEX_sv(ikl,isl  ))!
-     .                              +   IRd_SV(ikl)*Eso_sv(ikl) ! Down Atm IR
-     .                                +IRs__D(ikl)             ! Upw. Sol IR
-     .                                +HS___D(ikl)             ! HS/Atmo.Contr.
-     .                                +HL___D(ikl)            )! HL/Atmo.Contr.
-     
-        END DO
- 
- 
-C +--Tridiagonal Elimination
-C +  =======================
- 
-C +--Forward  Sweep
-C +  ^^^^^^^^^^^^^^
-        DO ikl=  1,knonv
-          Aux__P(ikl,-nsol) = Diag_B(ikl,-nsol)
-          Aux__Q(ikl,-nsol) =-Diag_C(ikl,-nsol)/Aux__P(ikl,-nsol)
-        END DO
- 
-        DO ikl=      1,knonv
-
-        DO   isl=-nsol+1,min(nsno,isnoSV(ikl)+1)
-          Aux__P(ikl,isl)   = Diag_A(ikl,isl)  *Aux__Q(ikl,isl-1)
-     .                       +Diag_B(ikl,isl)
-          Aux__Q(ikl,isl)   =-Diag_C(ikl,isl)  /Aux__P(ikl,isl)
-        END DO
-        END DO
- 
-        DO ikl=      1,knonv
-          TsisSV(ikl,-nsol) = Term_D(ikl,-nsol)/Aux__P(ikl,-nsol)
-        END DO
- 
-        DO ikl=      1,knonv
-        DO   isl=-nsol+1,min(nsno,isnoSV(ikl)+1)
-          TsisSV(ikl,isl)   =(Term_D(ikl,isl)
-     .                       -Diag_A(ikl,isl)  *TsisSV(ikl,isl-1))
-     .                                         /Aux__P(ikl,isl)
-
-  
-        END DO
-        END DO
- 
-C +--Backward Sweep
-C +  ^^^^^^^^^^^^^^
-        DO ikl=     1,knonv
-        DO   isl=min(nsno-1,isnoSV(ikl)+1),-nsol,-1
-           
-
-          TsisSV(ikl,isl)   = Aux__Q(ikl,isl)  *TsisSV(ikl,isl+1)
-     .                                         +TsisSV(ikl,isl)
-          if(isl==0.and.isnoSV(ikl)==0) then
- 
-           TsisSV(ikl,isl)  = min(TaT_SV(ikl)+30,TsisSV(ikl,isl))
-           TsisSV(ikl,isl)  = max(TaT_SV(ikl)-30,TsisSV(ikl,isl))
-
-
-c #EU      TsisSV(ikl,isl)  = max(TaT_SV(ikl)-15.,TsisSV(ikl,isl))
-
-          !XF 18/11/2018 to avoid ST reaching 70�C!!
-          !It is an error compensation but does not work over tundra
- 
-          endif
-
-   
-
-        END DO
-       
-      END DO
-
-
- 
-C +--Temperature Limits (avoids problems in case of no Snow Layers)
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-        DO ikl=     1,knonv
-           isl              = isnoSV(ikl)
-
-           dTSurf            = TsisSV(ikl,isl) -     TSurf0(ikl)
-          TsisSV(ikl,isl)   = TSurf0(ikl) + sign(1.,dTSurf) ! 180.0 dgC/hr
-     .              * min(abs(dTSurf),5.e-2*dt__SV)         ! =0.05 dgC/s
-
-
-
-        END DO
-
-        DO ikl=     1,knonv
-        DO   isl=min(nsno,isnoSV(ikl)+1),1      ,-1
-          TsisSV(ikl,isl)   = max(Ts_Min,       TsisSV(ikl,isl))
-          TsisSV(ikl,isl)   = min(Ts_Max,       TsisSV(ikl,isl))
-        END DO
-
-        END DO
- 
-C +--Update Surface    Fluxes
-C +  ========================
-        
-
-
-        DO ikl=      1,knonv
-          isl         = isnoSV(ikl)
-          IRs_SV(ikl) = IRs__D(ikl)                          !
-     .                - dIRsdT(ikl) * TsisSV(ikl,isl)        !
-          HSs_sv(ikl) = HS___D(ikl)                          ! Sensible Heat
-     .                - dSdTSV(ikl) * TsisSV(ikl,isl)        ! Downward > 0
-          HLs_sv(ikl) = HL___D(ikl)                          ! Latent   Heat
-     .                - dLdTSV(ikl) * TsisSV(ikl,isl)        ! Downward > 0
-        END DO
-
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_tso.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_tso.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_tso.f90	(revision 5246)
@@ -0,0 +1,675 @@
+
+
+
+
+subroutine SISVAT_TSo
+  ! #e1.                     (ETSo_0,ETSo_1,ETSo_d)
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_TSo                                06-10-2020  MAR |
+  ! |   SubRoutine SISVAT_TSo computes the Soil/Snow Energy Balance          |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  ! |                     X       Number of Mosaic Cell per grid box         |
+  ! |                                                                        |
+  ! |   INPUT:   isotSV   = 0,...,11:   Soil       Type                      |
+  ! |   ^^^^^               0:          Water, Solid or Liquid               |
+  ! |            isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |            dQa_SV   = Limitation of  Water Vapor  Turbulent Flux       |
+  ! |                                                                        |
+  ! |   INPUT:   sol_SV   : Downward Solar Radiation                  [W/m2] |
+  ! |   ^^^^^    IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |
+  ! |            za__SV   : SBL Top    Height                            [m] |
+  ! |            VV__SV   : SBL Top    Wind Speed                      [m/s] |
+  ! |            TaT_SV   : SBL Top    Temperature                       [K] |
+  ! |            rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
+  ! |            QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
+  ! |            LSdzsv   : Vertical   Discretization Factor             [-] |
+  ! |                     =    1. Soil                                       |
+  ! |                     = 1000. Ocean                                      |
+  ! |            dzsnSV   : Snow Layer Thickness                         [m] |
+  ! |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
+  ! |            eta_SV   : Soil Water Content                       [m3/m3] |
+  ! |            dt__SV   : Time Step                                    [s] |
+  ! |                                                                        |
+  ! |            SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
+  ! |            Eso_sv   : Soil+Snow       Emissivity                   [-] |
+  ! |            rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+  ! |            Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
+  ! |            sEX_sv   : Verticaly Integrated Extinction Coefficient  [-] |
+  ! |                                                                        |
+  ! |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+  ! |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+  ! |   ^^^^^^                                                               |
+  ! |                                                                        |
+  ! |   OUTPUT:  IRs_SV   : Soil      IR Radiation                    [W/m2] |
+  ! |   ^^^^^^   HSs_sv   : Sensible  Heat Flux                       [W/m2] |
+  ! |            HLs_sv   : Latent    Heat Flux                       [W/m2] |
+  ! |            ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |
+  ! |            ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |
+  ! |            ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |
+  ! |                                                                        |
+  ! |   Internal Variables:                                                  |
+  ! |   ^^^^^^^^^^^^^^^^^^                                                   |
+  ! |                                                                        |
+  ! |   METHOD: NO   Skin Surface Temperature                                |
+  ! |   ^^^^^^  Semi-Implicit Crank Nicholson Scheme                         |
+  ! |                                                                        |
+  ! | # OPTIONS: #E0: Energy Budget Verification                             |
+  ! | # ^^^^^^^  #kd: KDsvat Option:NO Flux  Limitor     on HL               |
+  ! | #          #KD: KDsvat Option:Explicit Formulation of HL               |
+  ! | #          #NC: OUTPUT for Stand Alone NetCDF File                     |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VARxSV
+  use VARySV
+  use VARtSV
+  use VAR0SV
+
+
+  IMPLICIT NONE
+
+
+  ! +--OUTPUT
+  ! +  ------
+
+  ! #e1 real      ETSo_0(knonv)                 ! Soil/Snow Power, before Forcing
+  ! #e1 real      ETSo_1(knonv)                 ! Soil/Snow Power, after  Forcing
+  ! #e1 real      ETSo_d(knonv)                 ! Soil/Snow Power, Forcing
+
+
+  ! +--Internal Variables
+  ! +  ==================
+
+  integer :: ikl   ,isl   ,jsl   ,ist      !
+  integer :: ist__s,ist__w                 ! Soil/Water  Body Identifier
+  integer :: islsgn                        ! Soil/Snow Surfac.Identifier
+  real :: eps__3                        ! Arbitrary    Low Number
+  real :: etaMid,psiMid                 ! Layer Interface's Humidity
+  real :: mu_eta                        !     Soil thermal Conductivity
+  real :: mu_exp                        ! arg Soil thermal Conductivity
+  real :: mu_min                        ! Min Soil thermal Conductivity
+  real :: mu_max                        ! Max Soil thermal Conductivity
+  real :: mu_sno(knonv),mu_aux          !     Snow thermal Conductivity
+  real :: mu__dz(knonv,-nsol:nsno+1)    ! mu_(eta,sno)   / dz
+  real :: dtC_sv(knonv,-nsol:nsno)      ! dt      / C
+  real :: IRs__D(knonv)                 ! UpwardIR Previous Iter.Contr.
+  real :: dIRsdT(knonv)                 ! UpwardIR           T Derivat.
+  real :: f_HSHL(knonv)                 ! Factor common to HS and HL
+  real :: dRidTs(knonv)                 ! d(Rib)/d(Ts)
+  real :: HS___D(knonv)                 ! Sensible Heat Flux Atm.Contr.
+  real :: f___HL(knonv)                 !
+  real :: HL___D(knonv)                 ! Latent   Heat Flux Atm.Contr.
+  REAL :: TSurf0(knonv),dTSurf          ! Previous Surface Temperature
+  real :: qsatsg(knonv) !,den_qs,arg_qs ! Soil   Saturat. Spec. Humidity
+  real :: dqs_dT(knonv)                 ! d(qsatsg)/dTv
+  real :: Psi(   knonv)                 ! 1st Soil Layer Water Potential
+  real :: RHuSol(knonv)                 ! Soil Surface Relative Humidity
+  real :: etaSol                        ! Soil Surface          Humidity
+  real :: d__eta                        ! Soil Surface Humidity Increm.
+  real :: Elem_A,Elem_C                 !   Diagonal Coefficients
+  real :: Diag_A(knonv,-nsol:nsno)      ! A Diagonal
+  real :: Diag_B(knonv,-nsol:nsno)      ! B Diagonal
+  real :: Diag_C(knonv,-nsol:nsno)      ! C Diagonal
+  real :: Term_D(knonv,-nsol:nsno)      !   Independant Term
+  real :: Aux__P(knonv,-nsol:nsno)      ! P Auxiliary Variable
+  real :: Aux__Q(knonv,-nsol:nsno)      ! Q Auxiliary Variable
+  real :: Ts_Min,Ts_Max                 ! Temperature Limits
+  ! #e1 real      Exist0                        ! Existing Layer Switch
+  real :: psat_wat, psat_ice, sp        ! computation of qsat
+
+  integer :: nt_srf,it_srf,itEuBk          ! HL: Surface Scheme
+  parameter(nt_srf=10)                     ! 10 before
+  real :: agpsrf,xgpsrf,dt_srf,dt_ver   !
+  real :: etaBAK(knonv)                 !
+  real :: etaNEW(knonv)                 !
+  real :: etEuBk(knonv)                 !
+  real :: fac_dt(knonv),faceta(knonv)   !
+  real :: PsiArg(knonv),SHuSol(knonv)   !
+
+
+
+  ! +--Internal DATA
+  ! +  =============
+
+  data      eps__3 /   1.e-3   /          ! Arbitrary    Low Number
+  data      mu_exp /  -0.4343  /          ! Soil Thermal Conductivity
+  data      mu_min /   0.172   /          ! Min Soil Thermal Conductivity
+  data      mu_max /   2.000   /          ! Max Soil Thermal Conductivity
+  data      Ts_Min / 175.      /          ! Temperature            Minimum
+  data      Ts_Max / 300.      /          ! Temperature Acceptable Maximum
+  ! +                                           ! including   Snow Melt  Energy
+
+  ! +-- Initilialisation of local arrays
+  ! +   ================================
+    DO ikl=1,knonv
+
+      mu_sno(ikl)=0.
+      mu__dz(ikl,:)=0.
+      dtC_sv(ikl,:)=0.
+      IRs__D(ikl)=0.
+      dIRsdT(ikl)=0.
+      f_HSHL(ikl)=0.
+      dRidTs(ikl)=0.
+      HS___D(ikl)=0.
+      f___HL(ikl)=0.
+      HL___D(ikl)=0.
+      TSurf0(ikl)=0.
+      qsatsg(ikl)=0.
+      dqs_dT(ikl)=0.
+      Psi(ikl)=0.
+      RHuSol(ikl)=0.
+      Diag_A(ikl,:)=0.
+      Diag_B(ikl,:)=0.
+      Diag_C(ikl,:)=0.
+      Term_D(ikl,:)=0.
+      Aux__P(ikl,:)=0.
+      Aux__Q(ikl,:)=0.
+      etaBAK(ikl)=0.
+      etaNEW(ikl)=0.
+      etEuBk(ikl)=0.
+      fac_dt(ikl)=0.
+      faceta(ikl)=0.
+      PsiArg(ikl)=0.
+      SHuSol(ikl)=0.
+
+    END DO
+
+
+
+  ! +--Heat Conduction Coefficient (zero in the Layers over the highest one)
+  ! +  ===========================
+  ! +                             ---------------- isl    eta_SV, rho C (isl)
+  ! +
+  ! +--Soil                       ++++++++++++++++        etaMid,    mu (isl)
+  ! +  ----
+  ! +                             ---------------- isl-1  eta_SV, rho C (isl-1)
+       isl=-nsol
+    DO ikl=1,knonv
+
+      mu__dz(ikl,isl) = 0.
+
+      dtC_sv(ikl,isl) = dtz_SV2(isl)  * dt__SV & ! dt / (dz X rho C)
+            /((rocsSV(isotSV(ikl)) & ! [s / (m.J/m3/K)]
+            +rcwdSV*eta_SV(ikl,isl)) & !
+            *LSdzsv(ikl)            )      !
+    END DO
+  DO   isl=-nsol+1,0
+    DO ikl=1,knonv
+      ist    =      isotSV(ikl)                       ! Soil Type
+      ist__s =  min(ist, 1)                           ! 1 => Soil
+      ist__w =  1 - ist__s                            ! 1 => Water Body
+
+      etaMid = 0.5*(dz_dSV(isl-1)*eta_SV(ikl,isl-1) & ! eta at layers
+            +dz_dSV(isl)  *eta_SV(ikl,isl)  ) & !     interface
+            /dzmiSV(isl)                       ! LSdzsv implicit !
+      etaMid =  max(etaMid,epsi)
+      psiMid =      psidSV(ist) &
+            *(etadSV(ist)/etaMid)**bCHdSV(ist)
+      mu_eta =      3.82      *(psiMid)**mu_exp       ! Soil Thermal
+      mu_eta =  min(max(mu_eta, mu_min), mu_max)      ! Conductivity
+  ! +                                                       ! DR97 eq.3.31
+      mu_eta =  ist__s *mu_eta +ist__w * vK_dSV       ! Water Bodies
+  ! +                                                       ! Correction
+      mu__dz(ikl,isl) = mu_eta/(dzmiSV(isl) & !
+            *LSdzsv(ikl))          !
+
+      dtC_sv(ikl,isl) = dtz_SV2(isl)* dt__SV & ! dt / (dz X rho C)
+            /((rocsSV(isotSV(ikl)) & !
+            +rcwdSV*eta_SV(ikl,isl)) & !
+            *LSdzsv(ikl)            )      !
+    END DO
+  END DO
+
+
+  ! +--Soil/Snow Interface
+  ! +  -------------------
+
+  ! +--Soil Contribution
+  ! +  ^^^^^^^^^^^^^^^^^
+       isl=1
+    DO ikl=1,knonv
+      ist    =      isotSV(ikl)                       ! Soil Type
+      ist__s =  min(ist, 1)                           ! 1 => Soil
+      ist__w =  1 - ist__s                            ! 1 => Water Body
+      psiMid =      psidSV(ist)                       ! Snow => Saturation
+      mu_eta =      3.82      *(psiMid)**mu_exp       ! Soil Thermal
+      mu_eta =  min(max(mu_eta, mu_min), mu_max)      ! Conductivity
+  ! +                                                       ! DR97 eq.3.31
+      mu_eta =  ist__s *mu_eta +ist__w * vK_dSV       ! Water Bodies
+
+  ! +--Snow Contribution
+  ! +  ^^^^^^^^^^^^^^^^^
+      mu_sno(ikl) =  CdidSV & !
+            *(ro__SV(ikl,isl) /ro_Wat) ** 1.88 !
+      mu_sno(ikl) =          max(epsi,mu_sno(ikl))    !
+  ! +...    mu_sno :  Snow Heat Conductivity Coefficient [Wm/K]
+  ! +                 (Yen 1981, CRREL Rep., 81-10)
+
+  ! +--Combined Heat Conductivity
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+      mu__dz(ikl,isl) = 2./(dzsnSV(ikl,isl  ) & ! Combined Heat
+            /mu_sno(ikl) & ! Conductivity
+            +LSdzsv(ikl) & !
+            *dz_dSV(    isl-1)/mu_eta) ! Coefficient
+
+  ! +--Inverted Heat Capacity
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^
+      dtC_sv(ikl,isl) = dt__SV/max(epsi, & ! dt / (dz X rho C)
+            dzsnSV(ikl,isl) * ro__SV(ikl,isl) *Cn_dSV)      !
+    END DO
+
+
+  ! +--Snow
+  ! +  ----
+
+  DO ikl=1,knonv
+  DO   isl=1,min(nsno,isnoSV(ikl)+1)
+      ro__SV(ikl,isl) = & !
+            ro__SV(ikl ,isl) & !
+            * max(0,min(isnoSV(ikl)-isl+1,1))            !
+
+    END DO
+  END DO
+
+  DO ikl=1,knonv
+  DO   isl=1,min(nsno,isnoSV(ikl)+1)
+
+  ! +--Combined Heat Conductivity
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+      mu_aux      =  CdidSV & !
+            *(ro__SV(ikl,isl) /ro_Wat) ** 1.88 !
+      mu__dz(ikl,isl) = & !
+            2.                        *mu_aux*mu_sno(ikl) & ! Combined Heat
+            /max(epsi,dzsnSV(ikl,isl  )*mu_sno(ikl) & ! Conductivity
+            +dzsnSV(ikl,isl-1)*mu_aux     )       ! For upper Layer
+      mu_sno(ikl)     =            mu_aux             !
+
+  ! +--Inverted Heat Capacity
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^
+      dtC_sv(ikl,isl) = dt__SV/max(eps__3, & ! dt / (dz X rho C)
+            dzsnSV(ikl,isl) * ro__SV(ikl,isl) *Cn_dSV)      !
+    END DO
+  END DO
+
+
+  ! +--Uppermost Effective Layer: NO conduction
+  ! +  ----------------------------------------
+
+    DO ikl=1,knonv
+      mu__dz(ikl,isnoSV(ikl)+1) = 0.0
+    END DO
+
+
+  ! +--Energy Budget (IN)
+  ! +  ==================
+
+  ! #e1   DO ikl=1,knonv
+  ! #e1     ETSo_0(ikl) = 0.
+  ! #e1   END DO
+  ! #e1 DO   isl= -nsol,nsno
+  ! #e1   DO ikl=1,knonv
+  ! #e1     Exist0      = isl -           isnoSV(ikl)
+  ! #e1     Exist0      = 1.  - max(zero,min(unun,Exist0))
+  ! #e1     ETSo_0(ikl) = ETSo_0(ikl)
+  ! #e1.                +(TsisSV(ikl,isl)-TfSnow)*Exist0
+  ! #e1.                                 /dtC_sv(ikl,isl)
+  ! #e1   END DO
+  ! #e1 END DO
+
+
+  ! +--Tridiagonal Elimination: Set Up
+  ! +  ===============================
+
+  ! +--Soil/Snow Interior
+  ! +  ^^^^^^^^^^^^^^^^^^
+  DO ikl=1,knonv
+  DO   isl=-nsol+1,min(nsno-1,isnoSV(ikl)+1)
+
+      Elem_A          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl)
+      Elem_C          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl+1)
+      Diag_A(ikl,isl) = -Elem_A  *Implic
+      Diag_C(ikl,isl) = -Elem_C  *Implic
+      Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)-Diag_C(ikl,isl)
+      Term_D(ikl,isl) =  Explic *(Elem_A         *TsisSV(ikl,isl-1) &
+            +Elem_C         *TsisSV(ikl,isl+1)) &
+            +(1.0d+0 -Explic *(Elem_A+Elem_C))*TsisSV(ikl,isl) &
+            + dtC_sv(ikl,isl)           * sol_SV(ikl)    *SoSosv(ikl) &
+            *(sEX_sv(ikl,isl+1) &
+            -sEX_sv(ikl,isl  ))
+    END DO
+  END DO
+
+  ! +--Soil  lowest Layer
+  ! +  ^^^^^^^^^^^^^^^^^^
+       isl= -nsol
+    DO ikl=1,knonv
+      Elem_A          =  0.
+      Elem_C          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl+1)
+      Diag_A(ikl,isl) =  0.
+      Diag_C(ikl,isl) = -Elem_C  *Implic
+      Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)-Diag_C(ikl,isl)
+      Term_D(ikl,isl) =  Explic * Elem_C         *TsisSV(ikl,isl+1) &
+            +(1.0d+0 -Explic * Elem_C)        *TsisSV(ikl,isl) &
+            + dtC_sv(ikl,isl)           * sol_SV(ikl)    *SoSosv(ikl) &
+            *(sEX_sv(ikl,isl+1) &
+            -sEX_sv(ikl,isl  ))
+    END DO
+
+  ! +--Snow highest Layer (dummy!)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+    ! !EV!isl=  min(isnoSV(1)+1,nsno)
+
+    DO ikl=1,knonv
+  ! EV try to calculate isl at the ikl grid point
+      isl=  min(isnoSV(ikl)+1,nsno)
+
+      Elem_A          =  dtC_sv(ikl,isl)  *mu__dz(ikl,isl)
+      Elem_C          =  0.
+      Diag_A(ikl,isl) = -Elem_A  *Implic
+      Diag_C(ikl,isl) =  0.
+      Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)
+      Term_D(ikl,isl) =  Explic * Elem_A  *TsisSV(ikl,isl-1) &
+            +(1.0d+0 -Explic * Elem_A) *TsisSV(ikl,isl) &
+            + dtC_sv(ikl,isl) * (sol_SV(ikl)      *SoSosv(ikl) &
+            *(sEX_sv(ikl,isl+1) &
+            -sEX_sv(ikl,isl  )))
+    END DO
+
+  ! +--Surface: UPwardIR Heat Flux
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    DO ikl=1,knonv
+      isl         = isnoSV(ikl)
+      dIRsdT(ikl) = Eso_sv(ikl)* StefBo          * 4. & ! - d(IR)/d(T)
+            * TsisSV(ikl,isl) & !
+            * TsisSV(ikl,isl) & !
+            * TsisSV(ikl,isl)           !
+      IRs__D(ikl) = dIRsdT(ikl)* TsisSV(ikl,isl) * 0.75    !
+
+  ! +--Surface: Richardson Number:   T Derivative
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  ! #RC     dRidTs(ikl) =-gravit      *    za__SV(ikl)
+  ! #RC.                /(TaT_SV(ikl) *    VV__SV(ikl)
+  ! #RC.                              *    VV__SV(ikl))
+
+  ! +--Surface: Turbulent Heat Flux: Factors
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      f_HSHL(ikl) = rhT_SV(ikl)  /    rah_sv(ikl)           ! to  HS, HL
+      f___HL(ikl) = f_HSHL(ikl) *    Lx_H2O(ikl)
+
+  ! +--Surface: Sensible  Heat Flux: T Derivative
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      dSdTSV(ikl) = f_HSHL(ikl) *    Cp                    !#- d(HS)/d(T)
+  ! #RC.         *(1.0  -(TsisSV(ikl,isl) -TaT_SV(ikl))          !#Richardson
+  ! #RC.         * dRidTs(ikl)*dFh_sv(ikl)/rah_sv(ikl))          ! Nb. Correct.
+      HS___D(ikl) = dSdTSV(ikl) *    TaT_SV(ikl)           !
+
+  ! +--Surface: Latent    Heat Flux: Saturation Specific Humidity
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      ! den_qs      =         TsisSV(ikl,isl)- 35.8          !
+      ! arg_qs      = 17.27 *(TsisSV(ikl,isl)-273.16)        !
+  !    .                                   / den_qs              !
+  !         qsatsg(ikl) = .0038 *        exp(arg_qs)             !
+      !  sp = (pst_SV(ikl) + ptopSV) * 10.
+
+      ! !sp=ps__SV(ikl)
+      ! ! Etienne: in the formula herebelow sp should be in hPa, not
+      ! ! in Pa so I divide by 100.
+      sp=ps__SV(ikl)/100.
+      psat_ice = 6.1070 * exp(6150. *(1./273.16 - &
+            1./TsisSV(ikl,isl)))
+
+      psat_wat = 6.1078 * exp (5.138*log(273.16   /TsisSV(ikl,isl))) &
+            * exp (6827.*(1.         /273.16-1./TsisSV(ikl,isl)))
+
+      if(TsisSV(ikl,isl)<=273.16) then
+        qsatsg(ikl) = 0.622 * psat_ice / (sp - 0.378 * psat_ice)
+      else
+        qsatsg(ikl) = 0.622 * psat_wat / (sp - 0.378 * psat_wat)
+      endif
+      QsT_SV(ikl)=qsatsg(ikl)
+
+      ! dqs_dT(ikl) = qsatsg(ikl)* 4099.2   /(den_qs *den_qs)!
+      fac_dt(ikl) = f_HSHL(ikl)/(ro_Wat   * dz_dSV(0))     !
+    END DO
+
+
+
+  ! +--Surface: Latent    Heat Flux: Surface    Relative Humidity
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          xgpsrf       =   1.05                            !
+          agpsrf       = dt__SV*(   1.0-xgpsrf        ) & !
+                /(   1.0-xgpsrf**nt_srf)    !
+          dt_srf       = agpsrf                            !
+          dt_ver       = 0.
+
+        DO ikl=1,knonv
+          isl          =          isnoSV(ikl)
+          ist          = max(0,isotSV(ikl)-100*isnoSV(ikl))! 0 if    H2O
+          ist__s       = min(1,ist)
+          etaBAK(ikl)  = max(epsi,eta_SV(ikl ,isl))        !
+          etaNEW(ikl)  =          etaBAK(ikl)              !
+          etEuBk(ikl)  =          etaNEW(ikl)              !
+        END DO
+
+    if(ist__s==1) then ! to reduce computer time
+                                      ! !
+    DO it_srf=1,nt_srf                                     !
+          dt_ver       = dt_ver     +dt_srf                !
+        DO ikl=1,knonv                                     !
+          faceta(ikl)  = fac_dt(ikl)*dt_srf                !
+  ! #VX         faceta(ikl)  = faceta(ikl)                       !
+  ! #VX.                  /(1.+faceta(ikl)*dQa_SV(ikl))          !    Limitation
+  !                                                              ! by Atm.Conten
+  ! #??.        *max(0,sign(1.,qsatsg(ikl)-QaT_SV(ikl))))        ! NO Limitation
+                                                           ! ! of Downw.Flux
+        END DO                                             !
+      DO itEuBk=1,2                                        !
+        DO ikl=1,knonv
+          ist    = max(0,isotSV(ikl)-100*isnoSV(ikl))      ! 0 if    H2O
+                                                           ! !
+          Psi(ikl) = & !
+                psidSV(ist) & ! DR97, Eqn 3.34
+                *(etadSV(ist) & !
+                /max(etEuBk(ikl),epsi)) & !
+                **bCHdSV(ist)                              !
+          PsiArg(ikl) = 7.2E-5*Psi(ikl)                    !
+          RHuSol(ikl) =   exp(-min(0.,PsiArg(ikl)))    !
+          SHuSol(ikl) =     qsatsg(ikl)  *RHuSol(ikl)      ! DR97, Eqn 3.15
+          etEuBk(ikl) = & !
+                (etaNEW(ikl) + faceta(ikl)*(QaT_SV(ikl) & !
+                -SHuSol(ikl) & !
+                *(1.          -bCHdSV(ist) & !
+                *PsiArg(ikl))       )) & !
+                /(1.          + faceta(ikl)* SHuSol(ikl) & !
+                *bCHdSV(ist) & !
+                *PsiArg(ikl) & !
+                /etaNEW(ikl))          !
+          etEuBk(ikl) = etEuBk(ikl) & !
+  !    .                                 /(Ro_Wat*dz_dSV(0))     !
+                * dt_srf     /(Ro_Wat*dz_dSV(0))     !
+  !XF 15/05/2017 BUG
+        END DO                                             !
+      END DO                                               !
+        DO ikl=1,knonv                                     !
+          etaNEW(ikl) =  max(etEuBk(ikl),epsi)             !
+        END DO                                             !
+          dt_srf      =      dt_srf         * xgpsrf       !
+    END DO
+
+
+    endif                                       !
+
+  ! +--Surface: Latent    Heat Flux: Soil/Water Surface Contributions
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    DO ikl=1,knonv                                         !
+      isl        =  isnoSV(ikl)                            !
+      ist   = max(0,isotSV(ikl)-100*isnoSV(ikl))           ! 0 if    H2O
+      ist__s= min(1,ist)                                   ! 1 if no H2O
+      ist__w=     1-ist__s                                 ! 1 if    H2O
+      d__eta     =  eta_SV(ikl,isl)-etaNEW(ikl)            !
+      ! ! latent heat flux computation
+      HL___D(ikl)=( ist__s *ro_Wat *dz_dSV(0) & ! Soil Contrib.
+            *(etaNEW(ikl)    -etaBAK(ikl)) / dt__SV & !
+            +ist__w         *f_HSHL(ikl) & ! H2O  Contrib.
+            *(QaT_SV(ikl)    - qsatsg(ikl))        ) & !
+            * Lx_H2O(ikl)                            ! common factor
+
+  ! #DL     RHuSol(ikl) =(QaT_SV(ikl)                            !
+  ! #DL.                 -HL___D(ikl)    / f___HL(ikl))          !
+  ! #DL.                / qsatsg(ikl)                            !
+
+  ! +--Surface: Latent    Heat Flux: T Derivative
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      dLdTSV(ikl) = 0.
+  ! #DL     dLdTSV(ikl) = f___HL(ikl) * RHuSol(ikl) *dqs_dT(ikl) ! - d(HL)/d(T)
+  ! #DL     HL___D(ikl) = HL___D(ikl)                            !
+  ! #DL.                 +dLdTSV(ikl) * TsisSV(ikl,isl)          !
+    END DO                                                 !
+
+  ! +--Surface: Tridiagonal Matrix Set Up
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    DO ikl=1,knonv
+      isl             =  isnoSV(ikl)
+      TSurf0(ikl)     =  TsisSV(ikl,isl)
+
+      Elem_A          =  dtC_sv(ikl,isl)*mu__dz(ikl,isl)
+      Elem_C          =  0.
+      Diag_A(ikl,isl) = -Elem_A *Implic
+      Diag_C(ikl,isl) =  0.
+      Diag_B(ikl,isl) =  1.0d+0 -Diag_A(ikl,isl)
+      Diag_B(ikl,isl) =  Diag_B(ikl,isl) &
+            + dtC_sv(ikl,isl) * (dIRsdT(ikl) & ! Upw. Sol IR
+            +dSdTSV(ikl) & ! HS/Surf.Contr.
+            +dLdTSV(ikl))                      ! HL/Surf.Contr.
+
+      Term_D(ikl,isl) =  Explic *Elem_A *TsisSV(ikl,isl-1) &
+            +(1.0d+0 -Explic *Elem_A)*TsisSV(ikl,isl)
+
+
+
+      Term_D(ikl,isl) =  Term_D(ikl,isl) &
+            + dtC_sv(ikl,isl) * (sol_SV(ikl)    *SoSosv(ikl) & ! Absorbed
+            *(sEX_sv(ikl,isl+1) & ! Solar
+            -sEX_sv(ikl,isl  )) & !
+            +   IRd_SV(ikl)*Eso_sv(ikl) & ! Down Atm IR
+            +IRs__D(ikl) & ! Upw. Sol IR
+            +HS___D(ikl) & ! HS/Atmo.Contr.
+            +HL___D(ikl)            )! HL/Atmo.Contr.
+
+    END DO
+
+
+  ! +--Tridiagonal Elimination
+  ! +  =======================
+
+  ! +--Forward  Sweep
+  ! +  ^^^^^^^^^^^^^^
+    DO ikl=  1,knonv
+      Aux__P(ikl,-nsol) = Diag_B(ikl,-nsol)
+      Aux__Q(ikl,-nsol) =-Diag_C(ikl,-nsol)/Aux__P(ikl,-nsol)
+    END DO
+
+    DO ikl=      1,knonv
+
+    DO   isl=-nsol+1,min(nsno,isnoSV(ikl)+1)
+      Aux__P(ikl,isl)   = Diag_A(ikl,isl)  *Aux__Q(ikl,isl-1) &
+            +Diag_B(ikl,isl)
+      Aux__Q(ikl,isl)   =-Diag_C(ikl,isl)  /Aux__P(ikl,isl)
+    END DO
+    END DO
+
+    DO ikl=      1,knonv
+      TsisSV(ikl,-nsol) = Term_D(ikl,-nsol)/Aux__P(ikl,-nsol)
+    END DO
+
+    DO ikl=      1,knonv
+    DO   isl=-nsol+1,min(nsno,isnoSV(ikl)+1)
+      TsisSV(ikl,isl)   =(Term_D(ikl,isl) &
+            -Diag_A(ikl,isl)  *TsisSV(ikl,isl-1)) &
+            /Aux__P(ikl,isl)
+
+
+    END DO
+    END DO
+
+  ! +--Backward Sweep
+  ! +  ^^^^^^^^^^^^^^
+    DO ikl=     1,knonv
+    DO   isl=min(nsno-1,isnoSV(ikl)+1),-nsol,-1
+
+
+      TsisSV(ikl,isl)   = Aux__Q(ikl,isl)  *TsisSV(ikl,isl+1) &
+            +TsisSV(ikl,isl)
+      if(isl==0.and.isnoSV(ikl)==0) then
+
+       TsisSV(ikl,isl)  = min(TaT_SV(ikl)+30,TsisSV(ikl,isl))
+       TsisSV(ikl,isl)  = max(TaT_SV(ikl)-30,TsisSV(ikl,isl))
+
+
+  ! #EU      TsisSV(ikl,isl)  = max(TaT_SV(ikl)-15.,TsisSV(ikl,isl))
+
+      ! !XF 18/11/2018 to avoid ST reaching 70�C!!
+      ! !It is an error compensation but does not work over tundra
+
+      endif
+
+
+
+    END DO
+
+  END DO
+
+
+
+  ! +--Temperature Limits (avoids problems in case of no Snow Layers)
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    DO ikl=     1,knonv
+       isl              = isnoSV(ikl)
+
+       dTSurf            = TsisSV(ikl,isl) -     TSurf0(ikl)
+      TsisSV(ikl,isl)   = TSurf0(ikl) + sign(1.,dTSurf) & ! 180.0 dgC/hr
+            * min(abs(dTSurf),5.e-2*dt__SV)         ! =0.05 dgC/s
+
+
+
+    END DO
+
+    DO ikl=     1,knonv
+    DO   isl=min(nsno,isnoSV(ikl)+1),1      ,-1
+      TsisSV(ikl,isl)   = max(Ts_Min,       TsisSV(ikl,isl))
+      TsisSV(ikl,isl)   = min(Ts_Max,       TsisSV(ikl,isl))
+    END DO
+
+    END DO
+
+  ! +--Update Surface    Fluxes
+  ! +  ========================
+
+
+
+    DO ikl=      1,knonv
+      isl         = isnoSV(ikl)
+      IRs_SV(ikl) = IRs__D(ikl) & !
+            - dIRsdT(ikl) * TsisSV(ikl,isl)        !
+      HSs_sv(ikl) = HS___D(ikl) & ! Sensible Heat
+            - dSdTSV(ikl) * TsisSV(ikl,isl)        ! Downward > 0
+      HLs_sv(ikl) = HL___D(ikl) & ! Latent   Heat
+            - dLdTSV(ikl) * TsisSV(ikl,isl)        ! Downward > 0
+    END DO
+
+  return
+end subroutine sisvat_tso
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_weq.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_weq.F	(revision 5084)
+++ 	(revision )
@@ -1,104 +1,0 @@
- 
- 
-      subroutine SISVAT_wEq( labWEq ,istart)
- 
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_wEq                                22-09-2001  MAR |
-C |   SubRoutine SISVAT_wEq computes the Snow/Ice  Water  Equivalent       |
-C |                                                                        |
-C |                                                                        |
-C |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
-C |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
-C |   FILE                 |      CONTENT                                  |
-C |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
-C | # SISVAT_wEq.ve        | #ve: OUTPUT/Verification: Snow/Ice Water Eqv. |
-C |                        |      unit 45, SubRoutine  SISVAT_wEq **ONLY** |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
-
-      use VARphy
-      use VAR_SV
-      use VARxSV
- 
-      IMPLICIT NONE
-
- 
- 
-      character*6         labWEq
-      integer             istart
- 
-      logical             logWEq
-      common/SISVAT_wEq_L/logWEq
- 
- 
-C +--Local  Variables
-C +  ================
- 
-      integer  ikl   ,isn
-      real     SnoWEQ,IceWEQ
- 
- 
-C +--Switch Initialization
-C +  =====================
- 
-      IF (.NOT.logWEq)                                              THEN
-               logWEq = .true.
-               open(unit=45,status='unknown',file='SISVAT_wEq.ve')
-               rewind    45
-      END IF
- 
- 
-C +--Snow Water Equivalent
-C +  =====================
- 
-           ikl   = 1
-      IF          (isnoSV(ikl).gt.iiceSV(ikl))                      THEN
- 
-          SnoWEQ = 0.
-        DO isn   = iiceSV(ikl)+1 ,isnoSV(ikl)
-          SnoWEQ = SnoWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
-        END DO
- 
-      END IF
- 
- 
-C +--Ice  Water Equivalent
-C +  =====================
- 
-      IF        (iiceSV(1).gt.0)                                    THEN
- 
-          IceWEQ = 0.
-        DO isn   =             1 ,iiceSV(ikl)
-          IceWEQ = IceWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
-        END DO
- 
-      END IF
- 
- 
-C +--OUTPUT
-C +  ======
- 
- !      IF (istart.eq.1)                                              THEN
- !        write(45,45)dahost,i___SV(lwriSV(1)),j___SV(lwriSV(1)),
- !     .              n___SV(lwriSV(1))
- ! 45     format(a18,10('-'),'Pt.',3i4,60('-'))
- !      END IF
- 
- !      write(45,450) labWEq,IceWEQ,iiceSV(ikl),SnoWEQ
- !     .                    ,IceWEQ+SnoWEQ,isnoSV(ikl)
- !     .                                  ,drr_SV(ikl)*dt__SV
- !     .                                  ,dsn_SV(ikl)*dt__SV
- !     .                                  ,BufsSV(ikl)
- ! 450  format(a6,3x,'  I+S =',f11.4,'(',i2,') +',f11.4,' =',
- !     .                       f11.4,'(',i2,')',
- !     .             '  drr =', f7.4,
- !     .             '  dsn =', f7.4,
- !     .             '  Buf =', f7.4)
- 
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_weq.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_weq.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_weq.f90	(revision 5246)
@@ -0,0 +1,104 @@
+
+
+subroutine SISVAT_wEq( labWEq ,istart)
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_wEq                                22-09-2001  MAR |
+  ! |   SubRoutine SISVAT_wEq computes the Snow/Ice  Water  Equivalent       |
+  ! |                                                                        |
+  ! |                                                                        |
+  ! |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+  ! |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+  ! |   FILE                 |      CONTENT                                  |
+  ! |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+  ! | # SISVAT_wEq.ve        | #ve: OUTPUT/Verification: Snow/Ice Water Eqv. |
+  ! |                        |      unit 45, SubRoutine  SISVAT_wEq **ONLY** |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+  use VARphy
+  use VAR_SV
+  use VARxSV
+
+  IMPLICIT NONE
+
+
+
+  character(len=6) :: labWEq
+  integer :: istart
+
+  logical :: logWEq
+  common/SISVAT_wEq_L/logWEq
+
+
+  ! +--Local  Variables
+  ! +  ================
+
+  integer :: ikl   ,isn
+  real :: SnoWEQ,IceWEQ
+
+
+  ! +--Switch Initialization
+  ! +  =====================
+
+  IF (.NOT.logWEq)                                              THEN
+           logWEq = .true.
+           open(unit=45,status='unknown',file='SISVAT_wEq.ve')
+           rewind    45
+  END IF
+
+
+  ! +--Snow Water Equivalent
+  ! +  =====================
+
+       ikl   = 1
+  IF          (isnoSV(ikl).gt.iiceSV(ikl))                      THEN
+
+      SnoWEQ = 0.
+    DO isn   = iiceSV(ikl)+1 ,isnoSV(ikl)
+      SnoWEQ = SnoWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
+    END DO
+
+  END IF
+
+
+  ! +--Ice  Water Equivalent
+  ! +  =====================
+
+  IF        (iiceSV(1).gt.0)                                    THEN
+
+      IceWEQ = 0.
+    DO isn   =             1 ,iiceSV(ikl)
+      IceWEQ = IceWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
+    END DO
+
+  END IF
+
+
+  ! +--OUTPUT
+  ! +  ======
+
+  !!      IF (istart.eq.1)                                              THEN
+  !!        write(45,45)dahost,i___SV(lwriSV(1)),j___SV(lwriSV(1)),
+  !!     .              n___SV(lwriSV(1))
+  !! 45     format(a18,10('-'),'Pt.',3i4,60('-'))
+  !!      END IF
+
+  !!      write(45,450) labWEq,IceWEQ,iiceSV(ikl),SnoWEQ
+  !!     .                    ,IceWEQ+SnoWEQ,isnoSV(ikl)
+  !!     .                                  ,drr_SV(ikl)*dt__SV
+  !!     .                                  ,dsn_SV(ikl)*dt__SV
+  !!     .                                  ,BufsSV(ikl)
+  !! 450  format(a6,3x,'  I+S =',f11.4,'(',i2,') +',f11.4,' =',
+  !!     .                       f11.4,'(',i2,')',
+  !!     .             '  drr =', f7.4,
+  !!     .             '  dsn =', f7.4,
+  !!     .             '  Buf =', f7.4)
+
+  return
+end subroutine sisvat_weq
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zag.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zag.F	(revision 5084)
+++ 	(revision )
@@ -1,238 +1,0 @@
- 
- 
-      subroutine SISVAT_zAg
-     .                     (isagra,isagrb,WEagra
-     .                     ,dzagra,dzagrb,T_agra,T_agrb
-     .                     ,roagra,roagrb,etagra,etagrb
-     .                     ,G1agra,G1agrb,G2agra,G2agrb
-     .                     ,agagra,agagrb,Agreg1
-     .                     )
- 
-C +------------------------------------------------------------------------+
-C | MAR SURFACE                                       Sat 30-Apr-2004  MAR |
-C |   SubRoutine SISVAT_zAg aggregates two contiguous snow layers          |
-C |                                                                        |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  knonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-C |                     X       Number of Mosaic Cell per grid box         |
-C |                                                                        |
-C |   INPUT:   isagrb   : 2nd     Layer History                            |
-C |   ^^^^^                                                                |
-C |                                                                        |
-C |   INPUT:   dzagrb   : 2nd     Layer Thickness                          |
-C |   ^^^^^    T_agrb   : 2nd     Layer Temperature                        |
-C |            roagrb   : 2nd     Layer Density                            |
-C |            etagrb   : 2nd     Layer Water Content                      |
-C |            G1agrb   : 2nd     Layer Dendricity/Spher.                  |
-C |            G2agrb   : 2nd     Layer Sphericity/Size                    |
-C |            agagrb   : 2nd     Age                                      |
-C |            Agreg1   : 1. when Agregation constrained                   |
-C |                                                                        |
-C |   INPUT /  isagra   : 1st     Layer History                            |
-C |   OUTPUT:                                                              |
-C |   ^^^^^^                                                               |
-C |                                                                        |
-C |   INPUT /  dzagra   : 1st     Layer Thickness                          |
-C |   OUTPUT:  T_agra   : 1st     Layer Temperature                        |
-C |   ^^^^^^   roagra   : 1st     Layer Density                            |
-C |            etagra   : 1st     Layer Water Content                      |
-C |            G1agra   : 1st     Layer Dendricity/Spher.                  |
-C |            G2agra   : 1st     Layer Sphericity/Size                    |
-C |            agagra   : 1st     Age                                      |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
- 
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VAR0SV
-      use VARxSV
-
-      IMPLICIT NONE
-
- 
-C +--INPUT
-C +  -----
- 
-      integer   isagrb(knonv)                 ! 2nd Layer History
-      real      dzagrb(knonv)                 ! 2nd Layer Thickness
-      real      T_agrb(knonv)                 ! 2nd Layer Temperature
-      real      roagrb(knonv)                 ! 2nd Layer Density
-      real      etagrb(knonv)                 ! 2nd Layer Water Content
-      real      G1agrb(knonv)                 ! 2nd Layer Dendricity/Spher.
-      real      G2agrb(knonv)                 ! 2nd Layer Sphericity/Size
-      real      agagrb(knonv)                 ! 2nd Layer Age
- 
- 
-C +--INPUT/OUTPUT
-C +  ------------
- 
-      integer   isagra(knonv)                 ! 1st Layer History
-      real      WEagra(knonv)                 ! 1st Layer Height    [mm w.e.]
-      real      Agreg1(knonv)                 ! 1. ===>   Agregates
-      real      dzagra(knonv)                 ! 1st Layer Thickness
-      real      T_agra(knonv)                 ! 1st Layer Temperature
-      real      roagra(knonv)                 ! 1st Layer Density
-      real      etagra(knonv)                 ! 1st Layer Water Content
-      real      G1agra(knonv)                 ! 1st Layer Dendricity/Spher.
-      real      G2agra(knonv)                 ! 1st Layer Sphericity/Size
-      real      agagra(knonv)                 ! 1st Layer Age
- 
- 
-C +--Internal Variables
-C +  ==================
- 
-      integer   ikl
-      integer   nh                            ! Averaged    Snow History
-      integer   nh__OK                        ! 1=>Conserve Snow History
-      real      rh                            !
-      real      dz                            ! Thickness
-      real      dzro_1                        ! Thickness X Density, Lay.1
-      real      dzro_2                        ! Thickness X Density, Lay.2
-      real      dzro                          ! Thickness X Density, Aver.
-      real      ro                            ! Averaged    Density
-      real      wn                            ! Averaged    Water Content
-      real      tn                            ! Averaged    Temperature
-      real      ag                            ! Averaged    Snow Age
-      real      SameOK                        ! 1. => Same Type of Grains
-      real      G1same                        ! Averaged G1,  same Grains
-      real      G2same                        ! Averaged G2,  same Grains
-      real      typ__1                        ! 1. => Lay1 Type: Dendritic
-      real      zroNEW                        ! dz X ro, if fresh Snow
-      real      G1_NEW                        ! G1,      if fresh Snow
-      real      G2_NEW                        ! G2,      if fresh Snow
-      real      zroOLD                        ! dz X ro, if old   Snow
-      real      G1_OLD                        ! G1,      if old   Snow
-      real      G2_OLD                        ! G2,      if old   Snow
-      real      SizNEW                        ! Size,    if fresh Snow
-      real      SphNEW                        ! Spheric.,if fresh Snow
-      real      SizOLD                        ! Size,    if old   Snow
-      real      SphOLD                        ! Spheric.,if old   Snow
-      real      Siz_av                        ! Averaged    Grain Size
-      real      Sph_av                        ! Averaged    Grain Spher.
-      real      Den_av                        ! Averaged    Grain Dendr.
-      real      DendOK                        ! 1. => Average is  Dendr.
-      real      G1diff                        ! Averaged G1, diff. Grains
-      real      G2diff                        ! Averaged G2, diff. Grains
-      real      G1                            ! Averaged G1
-      real      G2                            ! Averaged G2
- 
-
- 
-C +--Mean   Properties
-C +  =================
- 
-C +-- 1 Densite, Contenu en Eau, Temperature /
-C +     Density, Water Content,  Temperature
-C +     ------------------------------------
- 
-      DO ikl = 1,knonv
-          dz      =  dzagra(ikl) + dzagrb(ikl)
-          dzro_1  =  roagra(ikl) * dzagra(ikl)
-          dzro_2  =  roagrb(ikl) * dzagrb(ikl)
-          dzro    =  dzro_1      + dzro_2
-          ro      =  dzro
-     .     /max(epsi,dz)
-          wn      = (dzro_1*etagra(ikl) + dzro_2*etagrb(ikl))
-     .     /max(epsi,dzro)
-          tn      = (dzro_1*T_agra(ikl) + dzro_2*T_agrb(ikl))
-     .     /max(epsi,dzro)
-          ag      = (dzro_1*agagra(ikl) + dzro_2*agagrb(ikl))
-     .     /max(epsi,dzro)
- 
-          rh      =  max(zero,sign(unun,zWEcSV(ikl)
-     .                                         -0.5*WEagra(ikl)))
-          nh__OK  =  rh
-          nh      =                 max(isagra(ikl),isagrb(ikl))
-c #HB.            *  nh__OK
-c #HB.          + (1-nh__OK)*       min(isagra(ikl),isagrb(ikl))
- 
- 
- 
-C +-- 2 Nouveaux Types de Grains /  new Grain Types
-C +     -------------------------------------------
- 
-C +-- 2.1. Meme  Type  de Neige  / same Grain Type
-C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          SameOK  =  max(zero,
-     .                   sign(unun, G1agra(ikl) *G1agrb(ikl)  - eps_21))
-          G1same  = (dzro_1*G1agra(ikl) + dzro_2*G1agrb(ikl))
-     .     /max(epsi,dzro)
-          G2same  = (dzro_1*G2agra(ikl) + dzro_2*G2agrb(ikl))
-     .     /max(epsi,dzro)
- 
-C +-- 2.2. Types differents / differents Types
-C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-          typ__1  =  max(zero,sign(unun,epsi-G1agra(ikl))) ! =1.=> Dendritic
-          zroNEW  =     typ__1  *dzro_1                    ! ro of Dendr.Lay.
-     .            + (1.-typ__1) *dzro_2                    !
-          G1_NEW  =     typ__1  *G1agra(ikl)               ! G1 of Dendr.Lay.
-     .            + (1.-typ__1) *G1agrb(ikl)               !
-          G2_NEW  =     typ__1  *G2agra(ikl)               ! G2 of Dendr.Lay.
-     .            + (1.-typ__1) *G2agrb(ikl)               !
-          zroOLD  = (1.-typ__1) *dzro_1                    ! ro of Spher.Lay.
-     .            +     typ__1  *dzro_2                    !
-          G1_OLD  = (1.-typ__1) *G1agra(ikl)               ! G1 of Spher.Lay.
-     .            +     typ__1  *G1agrb(ikl)               !
-          G2_OLD  = (1.-typ__1) *G2agra(ikl)               ! G2 of Spher.Lay.
-     .            +     typ__1  *G2agrb(ikl)               !
-          SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV             ! Size  Dendr.Lay.
-     .             +(1.+G1_NEW         /G1_dSV)            !
-     .                *(G2_NEW  *DScdSV/G1_dSV             !
-     .             +(1.-G2_NEW         /G1_dSV)*DFcdSV)    !
-          SphNEW  =     G2_NEW         /G1_dSV             ! Spher.Dendr.Lay.
-          SizOLD  =     G2_OLD                             ! Size  Spher.Lay.
-          SphOLD  =     G1_OLD         /G1_dSV             ! Spher.Spher.Lay.
-          Siz_av  = (zroNEW*SizNEW+zroOLD*SizOLD)      ! Averaged Size
-     .     /max(epsi,dzro)                             !
-          Sph_av  = (zroNEW*SphNEW+zroOLD*SphOLD)      ! Averaged Sphericity
-     .     /max(epsi,dzro)                             !
-          Den_av  = (Siz_av -(    Sph_av *DScdSV       !
-     .                       +(1.-Sph_av)*DFcdSV))     !
-     .            / (DDcdSV -(    Sph_av *DScdSV       !
-     .                       +(1.-Sph_av)*DFcdSV))     !
-          DendOK  = max(zero,                          !
-     .                  sign(unun,     Sph_av *DScdSV  ! Small   Grains Contr.
-     .                            +(1.-Sph_av)*DFcdSV  ! Faceted Grains Contr.
-     .                            -    Siz_av        ))!
-C +...    REMARQUE: le  type moyen (dendritique ou non) depend
-C +       ^^^^^^^^  de la  comparaison avec le diametre optique
-C +                 d'une neige recente de   dendricite nulle
-C +...    REMARK:   the mean type  (dendritic   or not) depends
-C +       ^^^^^^    on the comparaison with the optical diameter
-C +                 of a recent snow    having zero dendricity
- 
-          G1diff  =(   -DendOK *Den_av
-     .             +(1.-DendOK)*Sph_av) *G1_dSV
-          G2diff  =     DendOK *Sph_av  *G1_dSV
-     .             +(1.-DendOK)*Siz_av
-          G1      =     SameOK *G1same
-     .             +(1.-SameOK)*G1diff
-          G2      =     SameOK *G2same
-     .             +(1.-SameOK)*G2diff
- 
- 
-C +--Assignation to new Properties
-C +  =============================
- 
-          isagra(ikl)   = Agreg1(ikl) *nh +(1.-Agreg1(ikl)) *isagra(ikl)
-          dzagra(ikl)   = Agreg1(ikl) *dz +(1.-Agreg1(ikl)) *dzagra(ikl)
-          T_agra(ikl)   = Agreg1(ikl) *tn +(1.-Agreg1(ikl)) *T_agra(ikl)
-          roagra(ikl)   = Agreg1(ikl) *ro +(1.-Agreg1(ikl)) *roagra(ikl)
-          etagra(ikl)   = Agreg1(ikl) *wn +(1.-Agreg1(ikl)) *etagra(ikl)
-          G1agra(ikl)   = Agreg1(ikl) *G1 +(1.-Agreg1(ikl)) *G1agra(ikl)
-          G2agra(ikl)   = Agreg1(ikl) *G2 +(1.-Agreg1(ikl)) *G2agra(ikl)
-          agagra(ikl)   = Agreg1(ikl) *ag +(1.-Agreg1(ikl)) *agagra(ikl)
- 
-      END DO
- 
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zag.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zag.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zag.f90	(revision 5246)
@@ -0,0 +1,238 @@
+
+
+subroutine SISVAT_zAg &
+        (isagra,isagrb,WEagra &
+        ,dzagra,dzagrb,T_agra,T_agrb &
+        ,roagra,roagrb,etagra,etagrb &
+        ,G1agra,G1agrb,G2agra,G2agrb &
+        ,agagra,agagrb,Agreg1 &
+        )
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR SURFACE                                       Sat 30-Apr-2004  MAR |
+  ! |   SubRoutine SISVAT_zAg aggregates two contiguous snow layers          |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  ! |                     X       Number of Mosaic Cell per grid box         |
+  ! |                                                                        |
+  ! |   INPUT:   isagrb   : 2nd     Layer History                            |
+  ! |   ^^^^^                                                                |
+  ! |                                                                        |
+  ! |   INPUT:   dzagrb   : 2nd     Layer Thickness                          |
+  ! |   ^^^^^    T_agrb   : 2nd     Layer Temperature                        |
+  ! |            roagrb   : 2nd     Layer Density                            |
+  ! |            etagrb   : 2nd     Layer Water Content                      |
+  ! |            G1agrb   : 2nd     Layer Dendricity/Spher.                  |
+  ! |            G2agrb   : 2nd     Layer Sphericity/Size                    |
+  ! |            agagrb   : 2nd     Age                                      |
+  ! |            Agreg1   : 1. when Agregation constrained                   |
+  ! |                                                                        |
+  ! |   INPUT /  isagra   : 1st     Layer History                            |
+  ! |   OUTPUT:                                                              |
+  ! |   ^^^^^^                                                               |
+  ! |                                                                        |
+  ! |   INPUT /  dzagra   : 1st     Layer Thickness                          |
+  ! |   OUTPUT:  T_agra   : 1st     Layer Temperature                        |
+  ! |   ^^^^^^   roagra   : 1st     Layer Density                            |
+  ! |            etagra   : 1st     Layer Water Content                      |
+  ! |            G1agra   : 1st     Layer Dendricity/Spher.                  |
+  ! |            G2agra   : 1st     Layer Sphericity/Size                    |
+  ! |            agagra   : 1st     Age                                      |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VAR0SV
+  use VARxSV
+
+  IMPLICIT NONE
+
+
+  ! +--INPUT
+  ! +  -----
+
+  integer :: isagrb(knonv)                 ! 2nd Layer History
+  real :: dzagrb(knonv)                 ! 2nd Layer Thickness
+  real :: T_agrb(knonv)                 ! 2nd Layer Temperature
+  real :: roagrb(knonv)                 ! 2nd Layer Density
+  real :: etagrb(knonv)                 ! 2nd Layer Water Content
+  real :: G1agrb(knonv)                 ! 2nd Layer Dendricity/Spher.
+  real :: G2agrb(knonv)                 ! 2nd Layer Sphericity/Size
+  real :: agagrb(knonv)                 ! 2nd Layer Age
+
+
+  ! +--INPUT/OUTPUT
+  ! +  ------------
+
+  integer :: isagra(knonv)                 ! 1st Layer History
+  real :: WEagra(knonv)                 ! 1st Layer Height    [mm w.e.]
+  real :: Agreg1(knonv)                 ! 1. ===>   Agregates
+  real :: dzagra(knonv)                 ! 1st Layer Thickness
+  real :: T_agra(knonv)                 ! 1st Layer Temperature
+  real :: roagra(knonv)                 ! 1st Layer Density
+  real :: etagra(knonv)                 ! 1st Layer Water Content
+  real :: G1agra(knonv)                 ! 1st Layer Dendricity/Spher.
+  real :: G2agra(knonv)                 ! 1st Layer Sphericity/Size
+  real :: agagra(knonv)                 ! 1st Layer Age
+
+
+  ! +--Internal Variables
+  ! +  ==================
+
+  integer :: ikl
+  integer :: nh                            ! Averaged    Snow History
+  integer :: nh__OK                        ! 1=>Conserve Snow History
+  real :: rh                            !
+  real :: dz                            ! Thickness
+  real :: dzro_1                        ! Thickness X Density, Lay.1
+  real :: dzro_2                        ! Thickness X Density, Lay.2
+  real :: dzro                          ! Thickness X Density, Aver.
+  real :: ro                            ! Averaged    Density
+  real :: wn                            ! Averaged    Water Content
+  real :: tn                            ! Averaged    Temperature
+  real :: ag                            ! Averaged    Snow Age
+  real :: SameOK                        ! 1. => Same Type of Grains
+  real :: G1same                        ! Averaged G1,  same Grains
+  real :: G2same                        ! Averaged G2,  same Grains
+  real :: typ__1                        ! 1. => Lay1 Type: Dendritic
+  real :: zroNEW                        ! dz X ro, if fresh Snow
+  real :: G1_NEW                        ! G1,      if fresh Snow
+  real :: G2_NEW                        ! G2,      if fresh Snow
+  real :: zroOLD                        ! dz X ro, if old   Snow
+  real :: G1_OLD                        ! G1,      if old   Snow
+  real :: G2_OLD                        ! G2,      if old   Snow
+  real :: SizNEW                        ! Size,    if fresh Snow
+  real :: SphNEW                        ! Spheric.,if fresh Snow
+  real :: SizOLD                        ! Size,    if old   Snow
+  real :: SphOLD                        ! Spheric.,if old   Snow
+  real :: Siz_av                        ! Averaged    Grain Size
+  real :: Sph_av                        ! Averaged    Grain Spher.
+  real :: Den_av                        ! Averaged    Grain Dendr.
+  real :: DendOK                        ! 1. => Average is  Dendr.
+  real :: G1diff                        ! Averaged G1, diff. Grains
+  real :: G2diff                        ! Averaged G2, diff. Grains
+  real :: G1                            ! Averaged G1
+  real :: G2                            ! Averaged G2
+
+
+
+  ! +--Mean   Properties
+  ! +  =================
+
+  ! +-- 1 Densite, Contenu en Eau, Temperature /
+  ! +     Density, Water Content,  Temperature
+  ! +     ------------------------------------
+
+  DO ikl = 1,knonv
+      dz      =  dzagra(ikl) + dzagrb(ikl)
+      dzro_1  =  roagra(ikl) * dzagra(ikl)
+      dzro_2  =  roagrb(ikl) * dzagrb(ikl)
+      dzro    =  dzro_1      + dzro_2
+      ro      =  dzro &
+            /max(epsi,dz)
+      wn      = (dzro_1*etagra(ikl) + dzro_2*etagrb(ikl)) &
+            /max(epsi,dzro)
+      tn      = (dzro_1*T_agra(ikl) + dzro_2*T_agrb(ikl)) &
+            /max(epsi,dzro)
+      ag      = (dzro_1*agagra(ikl) + dzro_2*agagrb(ikl)) &
+            /max(epsi,dzro)
+
+      rh      =  max(zero,sign(unun,zWEcSV(ikl) &
+            -0.5*WEagra(ikl)))
+      nh__OK  =  rh
+      nh      =                 max(isagra(ikl),isagrb(ikl))
+  ! #HB.            *  nh__OK
+  ! #HB.          + (1-nh__OK)*       min(isagra(ikl),isagrb(ikl))
+
+
+
+  ! +-- 2 Nouveaux Types de Grains /  new Grain Types
+  ! +     -------------------------------------------
+
+  ! +-- 2.1. Meme  Type  de Neige  / same Grain Type
+  ! +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      SameOK  =  max(zero, &
+            sign(unun, G1agra(ikl) *G1agrb(ikl)  - eps_21))
+      G1same  = (dzro_1*G1agra(ikl) + dzro_2*G1agrb(ikl)) &
+            /max(epsi,dzro)
+      G2same  = (dzro_1*G2agra(ikl) + dzro_2*G2agrb(ikl)) &
+            /max(epsi,dzro)
+
+  ! +-- 2.2. Types differents / differents Types
+  ! +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      typ__1  =  max(zero,sign(unun,epsi-G1agra(ikl))) ! =1.=> Dendritic
+      zroNEW  =     typ__1  *dzro_1 & ! ro of Dendr.Lay.
+            + (1.-typ__1) *dzro_2                    !
+      G1_NEW  =     typ__1  *G1agra(ikl) & ! G1 of Dendr.Lay.
+            + (1.-typ__1) *G1agrb(ikl)               !
+      G2_NEW  =     typ__1  *G2agra(ikl) & ! G2 of Dendr.Lay.
+            + (1.-typ__1) *G2agrb(ikl)               !
+      zroOLD  = (1.-typ__1) *dzro_1 & ! ro of Spher.Lay.
+            +     typ__1  *dzro_2                    !
+      G1_OLD  = (1.-typ__1) *G1agra(ikl) & ! G1 of Spher.Lay.
+            +     typ__1  *G1agrb(ikl)               !
+      G2_OLD  = (1.-typ__1) *G2agra(ikl) & ! G2 of Spher.Lay.
+            +     typ__1  *G2agrb(ikl)               !
+      SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV & ! Size  Dendr.Lay.
+            +(1.+G1_NEW         /G1_dSV) & !
+            *(G2_NEW  *DScdSV/G1_dSV & !
+            +(1.-G2_NEW         /G1_dSV)*DFcdSV)    !
+      SphNEW  =     G2_NEW         /G1_dSV             ! Spher.Dendr.Lay.
+      SizOLD  =     G2_OLD                             ! Size  Spher.Lay.
+      SphOLD  =     G1_OLD         /G1_dSV             ! Spher.Spher.Lay.
+      Siz_av  = (zroNEW*SizNEW+zroOLD*SizOLD) & ! Averaged Size
+            /max(epsi,dzro)                             !
+      Sph_av  = (zroNEW*SphNEW+zroOLD*SphOLD) & ! Averaged Sphericity
+            /max(epsi,dzro)                             !
+      Den_av  = (Siz_av -(    Sph_av *DScdSV & !
+            +(1.-Sph_av)*DFcdSV)) & !
+            / (DDcdSV -(    Sph_av *DScdSV & !
+            +(1.-Sph_av)*DFcdSV))     !
+      DendOK  = max(zero, & !
+            sign(unun,     Sph_av *DScdSV & ! Small   Grains Contr.
+            +(1.-Sph_av)*DFcdSV & ! Faceted Grains Contr.
+            -    Siz_av        ))!
+  ! +...    REMARQUE: le  type moyen (dendritique ou non) depend
+  ! +       ^^^^^^^^  de la  comparaison avec le diametre optique
+  ! +                 d'une neige recente de   dendricite nulle
+  ! +...    REMARK:   the mean type  (dendritic   or not) depends
+  ! +       ^^^^^^    on the comparaison with the optical diameter
+  ! +                 of a recent snow    having zero dendricity
+
+      G1diff  =(   -DendOK *Den_av &
+            +(1.-DendOK)*Sph_av) *G1_dSV
+      G2diff  =     DendOK *Sph_av  *G1_dSV &
+            +(1.-DendOK)*Siz_av
+      G1      =     SameOK *G1same &
+            +(1.-SameOK)*G1diff
+      G2      =     SameOK *G2same &
+            +(1.-SameOK)*G2diff
+
+
+  ! +--Assignation to new Properties
+  ! +  =============================
+
+      isagra(ikl)   = Agreg1(ikl) *nh +(1.-Agreg1(ikl)) *isagra(ikl)
+      dzagra(ikl)   = Agreg1(ikl) *dz +(1.-Agreg1(ikl)) *dzagra(ikl)
+      T_agra(ikl)   = Agreg1(ikl) *tn +(1.-Agreg1(ikl)) *T_agra(ikl)
+      roagra(ikl)   = Agreg1(ikl) *ro +(1.-Agreg1(ikl)) *roagra(ikl)
+      etagra(ikl)   = Agreg1(ikl) *wn +(1.-Agreg1(ikl)) *etagra(ikl)
+      G1agra(ikl)   = Agreg1(ikl) *G1 +(1.-Agreg1(ikl)) *G1agra(ikl)
+      G2agra(ikl)   = Agreg1(ikl) *G2 +(1.-Agreg1(ikl)) *G2agra(ikl)
+      agagra(ikl)   = Agreg1(ikl) *ag +(1.-Agreg1(ikl)) *agagra(ikl)
+
+  END DO
+
+  return
+end subroutine sisvat_zag
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zcr.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zcr.F	(revision 5084)
+++ 	(revision )
@@ -1,175 +1,0 @@
- 
- 
-      subroutine SISVAT_zCr
-C +
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_zCr                                12-12-2002  MAR |
-C |   SubRoutine SISVAT_zCr determines criteria for Layers Agregation      |
-C |                                                                        |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  klonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-C |                     X       Number of Mosaic Cell per grid box         |
-C |                                                                        |
-C |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
-C |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
-C |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
-C |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
-C |                                                                        |
-C |   INPUT /  ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
-C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
-C |   ^^^^^^   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
-C |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
-C |            agsnSV   : Snow       Age                             [day] |
-C |                                                                        |
-C |   OUTPUT:  LIndsv   : Relative Index of a contiguous Layer to agregate |
-C |   ^^^^^^                                                               |
-C +------------------------------------------------------------------------+
-C +
-C +
-C +
-C +
-C +--Global Variables
-C +  ================
-C  
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VAR0SV
-      use VARxSV
-      use VARySV
-      use VARtSV
-     
-      IMPLICIT NONE
-
-C +
-C +
-C +--Internal Variables
-C +  ==================
-C +
-      integer   ikl   ,isn   ,is0   ,is1
-      integer   isno_1                        ! Switch:  ! Snow Layer over Ice
-      real      Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure
-      real      DenSph                        ! 1. when contiguous spheric
-C +                                           !     and dendritic  Grains
-      real      DendOK                        ! 1. when dendritic  Grains
-      real      dTypMx                        ! Grain Type Differ.
-      real      dTypSp                        ! Sphericity Weight
-      real      dTypRo                        ! Density    Weight
-      real      dTypDi                        ! Grain Diam.Weight
-      real      dTypHi                        ! History    Weight
- 
- 
-C +--DATA
-C +  ====
- 
-      data      dTypMx / 200.0  /             ! Grain Type Weight
-      data      dTypSp /   0.5  /             ! Sphericity Weight
-      data      dTypRo /   0.5  /             ! Density    Weight
-      data      dTypDi /  10.0  /             ! Grain Diam.Weight
-      data      dTypHi / 100.0  /             ! History    Weight
- 
- 
-C +--Agregation Criteria
-C +  ===================
-C +
-      DO  ikl=1,knonv
-          i_thin(ikl) = min(i_thin(ikl),isnoSV(ikl))
-          isn         = max(1          ,i_thin(ikl))
-C +
-C +
-C +--Comparison with the downward Layer
-C +  ----------------------------------
-C +
-
-          is0    = max(1,        i_thin(ikl)-1 )        ! Downward Layer Index
-          DenSph = max(zero,                            ! isn/is1
-     .                 sign(unun,                       ! Dendricity/Sphericity
-     .                      epsi-G1snSV(ikl,isn)        !            Switch
-     .                          *G1snSV(ikl,is0)))      !
-          DendOK = max(zero,                            ! Dendricity Switch
-     .                 sign(unun,                       !
-     .                      epsi-G1snSV(ikl,isn)))      !
-C +          
-          Dtyp_0 =
-     .         DenSph *      dTypMx
-     .    +(1.-DenSph)
-     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
-     .                      -G1snSV(ikl,is0))           !     Contribution
-     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
-     .                      -G2snSV(ikl,is0))) *dTypSp  !     Contribution
-     .                  +abs(ro__SV(ikl,isn)            ! Density
-     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
-     .    +(1.-DenSph)                                  !
-     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
-     .                      -G1snSV(ikl,is0))           !     Contribution
-     .                  +abs(G2snSV(ikl,isn)            ! Size
-     .                      -G2snSV(ikl,is0))) *dTypDi  !     Contribution
-     .                  +abs(ro__SV(ikl,isn)            ! Density
-     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
-          Dtyp_0 =                                      !
-     .                   min(dTypMx,                    !
-     .                       Dtyp_0                     !
-     .                  +abs(istoSV(ikl,isn)            ! History
-     .                      -istoSV(ikl,is0))  *dTypHi) !     Contribution
-     .        +             (1 -abs(isn-is0))  * 1.e+6  !"Same Layer"Score
-     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
-     .                                 -is0))  * 1.e+6  ! Interface" Score
-C +
-C +
-C +--Comparison with the   upward Layer
-C +  ----------------------------------
-C +
-          is1    = min(          i_thin(ikl)+1,         ! Upward   Layer Index
-     .                 max(1,    isnoSV(ikl)  ))        !
-          DenSph = max(zero,                            ! isn/is1
-     .                 sign(unun,                       ! Dendricity/Sphericity
-     .                      epsi-G1snSV(ikl,isn)        !            Switch
-     .                          *G1snSV(ikl,is1)))      !
-          DendOK = max(zero,                            ! Dendricity Switch
-     .                 sign(unun,                       !
-     .                      epsi-G1snSV(ikl,isn)))      !
-C +
-          Dtyp_1 =
-     .         DenSph *      dTypMx
-     .    +(1.-DenSph)
-     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
-     .                      -G1snSV(ikl,is1))           !     Contribution
-     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
-     .                      -G2snSV(ikl,is1))) *dTypSp  !     Contribution
-     .                  +abs(ro__SV(ikl,isn)            ! Density
-     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
-     .    +(1.-DenSph)                                  !
-     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
-     .                      -G1snSV(ikl,is1))           !     Contribution
-     .                  +abs(G2snSV(ikl,isn)            ! Size
-     .                      -G2snSV(ikl,is1))) *dTypDi  !     Contribution
-     .                  +abs(ro__SV(ikl,isn)            ! Density
-     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
-          Dtyp_1 =                                      !
-     .                   min(dTypMx,                    !
-     .                       Dtyp_1                     !
-     .                  +abs(istoSV(ikl,isn)            ! History
-     .                      -istoSV(ikl,is1))  *dTypHi) !     Contribution
-     .        +             (1 -abs(isn-is1))  * 1.e+6  !"Same Layer"Score
-     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
-     .                                 -isn))  * 1.e+6  ! Interface" Score
-C +
-C +
-C +--Index of the Layer to agregate
-C +  ==============================
-C +
-          LIndsv(ikl) = sign(unun,Dtyp_0
-     .                           -Dtyp_1)
-          isno_1      = (1 -min (abs(isnoSV(ikl)        ! Switch = 1
-     .                              -iiceSV(ikl)-1),1)) !   if isno = iice +1
-     .                * (1 -min (abs(isnoSV(ikl)        ! Switch = 1
-     .                              -i_thin(ikl)  ),1)) !   if isno = i_ithin
-          LIndsv(ikl) = (1 -isno_1) *LIndsv(ikl)        ! Contiguous Layer is
-     .                     -isno_1                      ! downward for top L.
-          i_thin(ikl) =  max(1,   i_thin(ikl)   )
-      END DO
-C +
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zcr.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zcr.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zcr.f90	(revision 5246)
@@ -0,0 +1,175 @@
+
+
+subroutine SISVAT_zCr
+  ! +
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_zCr                                12-12-2002  MAR |
+  ! |   SubRoutine SISVAT_zCr determines criteria for Layers Agregation      |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  klonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  ! |                     X       Number of Mosaic Cell per grid box         |
+  ! |                                                                        |
+  ! |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
+  ! |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+  ! |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+  ! |                                                                        |
+  ! |   INPUT /  ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+  ! |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+  ! |   ^^^^^^   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+  ! |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+  ! |            agsnSV   : Snow       Age                             [day] |
+  ! |                                                                        |
+  ! |   OUTPUT:  LIndsv   : Relative Index of a contiguous Layer to agregate |
+  ! |   ^^^^^^                                                               |
+  ! +------------------------------------------------------------------------+
+  ! +
+  ! +
+  ! +
+  ! +
+  ! +--Global Variables
+  ! +  ================
+  !
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VAR0SV
+  use VARxSV
+  use VARySV
+  use VARtSV
+
+  IMPLICIT NONE
+
+  ! +
+  ! +
+  ! +--Internal Variables
+  ! +  ==================
+  ! +
+  integer :: ikl   ,isn   ,is0   ,is1
+  integer :: isno_1                        ! Switch:  ! Snow Layer over Ice
+  real :: Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure
+  real :: DenSph                        ! 1. when contiguous spheric
+  ! +                                           !     and dendritic  Grains
+  real :: DendOK                        ! 1. when dendritic  Grains
+  real :: dTypMx                        ! Grain Type Differ.
+  real :: dTypSp                        ! Sphericity Weight
+  real :: dTypRo                        ! Density    Weight
+  real :: dTypDi                        ! Grain Diam.Weight
+  real :: dTypHi                        ! History    Weight
+
+
+  ! +--DATA
+  ! +  ====
+
+  data      dTypMx / 200.0  /             ! Grain Type Weight
+  data      dTypSp /   0.5  /             ! Sphericity Weight
+  data      dTypRo /   0.5  /             ! Density    Weight
+  data      dTypDi /  10.0  /             ! Grain Diam.Weight
+  data      dTypHi / 100.0  /             ! History    Weight
+
+
+  ! +--Agregation Criteria
+  ! +  ===================
+  ! +
+  DO  ikl=1,knonv
+      i_thin(ikl) = min(i_thin(ikl),isnoSV(ikl))
+      isn         = max(1          ,i_thin(ikl))
+  ! +
+  ! +
+  ! +--Comparison with the downward Layer
+  ! +  ----------------------------------
+  ! +
+
+      is0    = max(1,        i_thin(ikl)-1 )        ! Downward Layer Index
+      DenSph = max(zero, & ! isn/is1
+            sign(unun, & ! Dendricity/Sphericity
+            epsi-G1snSV(ikl,isn) & !            Switch
+            *G1snSV(ikl,is0)))      !
+      DendOK = max(zero, & ! Dendricity Switch
+            sign(unun, & !
+            epsi-G1snSV(ikl,isn)))      !
+  ! +
+      Dtyp_0 = &
+            DenSph *      dTypMx &
+            +(1.-DenSph) &
+            *    DendOK *((abs(G1snSV(ikl,isn) & ! Dendricity
+            -G1snSV(ikl,is0)) & !     Contribution
+            +abs(G2snSV(ikl,isn) & ! Sphericity
+            -G2snSV(ikl,is0))) *dTypSp & !     Contribution
+            +abs(ro__SV(ikl,isn) & ! Density
+            -ro__SV(ikl,is0))  *dTypRo) & !     Contribution
+            +(1.-DenSph) & !
+            *(1.-DendOK)*((abs(G1snSV(ikl,isn) & ! Sphericity
+            -G1snSV(ikl,is0)) & !     Contribution
+            +abs(G2snSV(ikl,isn) & ! Size
+            -G2snSV(ikl,is0))) *dTypDi & !     Contribution
+            +abs(ro__SV(ikl,isn) & ! Density
+            -ro__SV(ikl,is0))  *dTypRo) !     Contribution
+      Dtyp_0 = & !
+            min(dTypMx, & !
+            Dtyp_0 & !
+            +abs(istoSV(ikl,isn) & ! History
+            -istoSV(ikl,is0))  *dTypHi) & !     Contribution
+            +             (1 -abs(isn-is0))  * 1.e+6 & !"Same Layer"Score
+            +  max(0,1-abs(iiceSV(ikl) & !"Ice /Snow
+            -is0))  * 1.e+6  ! Interface" Score
+  ! +
+  ! +
+  ! +--Comparison with the   upward Layer
+  ! +  ----------------------------------
+  ! +
+      is1    = min(          i_thin(ikl)+1, & ! Upward   Layer Index
+            max(1,    isnoSV(ikl)  ))        !
+      DenSph = max(zero, & ! isn/is1
+            sign(unun, & ! Dendricity/Sphericity
+            epsi-G1snSV(ikl,isn) & !            Switch
+            *G1snSV(ikl,is1)))      !
+      DendOK = max(zero, & ! Dendricity Switch
+            sign(unun, & !
+            epsi-G1snSV(ikl,isn)))      !
+  ! +
+      Dtyp_1 = &
+            DenSph *      dTypMx &
+            +(1.-DenSph) &
+            *    DendOK *((abs(G1snSV(ikl,isn) & ! Dendricity
+            -G1snSV(ikl,is1)) & !     Contribution
+            +abs(G2snSV(ikl,isn) & ! Sphericity
+            -G2snSV(ikl,is1))) *dTypSp & !     Contribution
+            +abs(ro__SV(ikl,isn) & ! Density
+            -ro__SV(ikl,is1))  *dTypRo) & !     Contribution
+            +(1.-DenSph) & !
+            *(1.-DendOK)*((abs(G1snSV(ikl,isn) & ! Sphericity
+            -G1snSV(ikl,is1)) & !     Contribution
+            +abs(G2snSV(ikl,isn) & ! Size
+            -G2snSV(ikl,is1))) *dTypDi & !     Contribution
+            +abs(ro__SV(ikl,isn) & ! Density
+            -ro__SV(ikl,is1))  *dTypRo) !     Contribution
+      Dtyp_1 = & !
+            min(dTypMx, & !
+            Dtyp_1 & !
+            +abs(istoSV(ikl,isn) & ! History
+            -istoSV(ikl,is1))  *dTypHi) & !     Contribution
+            +             (1 -abs(isn-is1))  * 1.e+6 & !"Same Layer"Score
+            +  max(0,1-abs(iiceSV(ikl) & !"Ice /Snow
+            -isn))  * 1.e+6  ! Interface" Score
+  ! +
+  ! +
+  ! +--Index of the Layer to agregate
+  ! +  ==============================
+  ! +
+      LIndsv(ikl) = sign(unun,Dtyp_0 &
+            -Dtyp_1)
+      isno_1      = (1 -min (abs(isnoSV(ikl) & ! Switch = 1
+            -iiceSV(ikl)-1),1)) & !   if isno = iice +1
+            * (1 -min (abs(isnoSV(ikl) & ! Switch = 1
+            -i_thin(ikl)  ),1)) !   if isno = i_ithin
+      LIndsv(ikl) = (1 -isno_1) *LIndsv(ikl) & ! Contiguous Layer is
+            -isno_1                      ! downward for top L.
+      i_thin(ikl) =  max(1,   i_thin(ikl)   )
+  END DO
+  ! +
+  return
+end subroutine sisvat_zcr
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zsn.F
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zsn.F	(revision 5084)
+++ 	(revision )
@@ -1,741 +1,0 @@
- 
- 
-      subroutine SISVAT_zSn
- 
-C +------------------------------------------------------------------------+
-C | MAR          SISVAT_zSn                                12-07-2019  MAR |
-C |   SubRoutine SISVAT_zSn manages the Snow Pack vertical Discretization  |
-C |                                                                        |
-C +------------------------------------------------------------------------+
-C |                                                                        |
-C |   PARAMETERS:  knonv: Total Number of columns =                        |
-C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
-C |                     X       Number of Mosaic Cell per grid box         |
-C |                                                                        |
-C |   INPUT /  NLaysv   = New             Snow Layer  Switch               |
-C |   OUTPUT:  isnoSV   = total Nb of Ice/Snow Layers                      |
-C |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
-C |            iiceSV   = total Nb of Ice      Layers                      |
-C |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
-C |                                                                        |
-C |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
-C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
-C |   ^^^^^^   ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
-C |            eta_SV   : Soil/Snow Water   Content                [m3/m3] |
-C |            dzsnSV   : Snow Layer        Thickness                  [m] |
-C |            G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
-C |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
-C |            agsnSV   : Snow       Age                             [day] |
-C |                                                                        |
-C |   METHOD:  1) Agregate the thinest Snow Layer                          |
-C |   ^^^^^^      if a new Snow Layer has been precipitated   (NLaysv = 1) |
-C |            2) Divide   a too thick Snow Layer except                   |
-C |               if the maximum Number of Layer is reached                |
-C |               in this case forces                          NLay_s = 1  |
-C |            3) Agregate the thinest Snow Layer                          |
-C |               in order to divide a too thick Snow Layer                |
-C |               at next Time Step when                       NLay_s = 1  |
-C |                                                                        |
-C +------------------------------------------------------------------------+
- 
- 
- 
- 
-C +--Global Variables
-C +  ================
- 
-
-      use VARphy
-      use VAR_SV
-      use VARdSV
-      use VAR0SV
-      use VARxSV
-      use VARySV
-      use surface_data, only: ok_zsn_ii
-
-      IMPLICIT NONE
-
- 
-C +--Internal Variables
-C +  ==================
- 
-      integer   ikl   ,isn   ,i               !
- 
-
-            
-
- 
- 
-      integer   NLay_s(knonv)                 ! Split Snow Layer         Switch
-      integer   isagr1(knonv)                 ! 1st     Layer History
-      integer   isagr2(knonv)                 ! 2nd     Layer History
-      integer   LstLay                        ! 0 ====> isnoSV = 1
-      integer   isno_n                        ! Snow Normal.Profile
-      integer   iice_n                        ! Ice  Normal.Profile
-      integer   iiceOK                        ! Ice         Switch
-      integer   icemix                        ! 0 ====> Agregated Snow+Ice=Snow
-C +                                           ! 1                          Ice
-      integer   isn1  (knonv)                 ! 1st layer to stagger
-      real      staggr                        !              stagger  Switch
- 
-      real      WEagre(knonv)                 ! Snow Water Equivalent Thickness
-      real      dzthin(knonv)                 ! Thickness of the thinest layer
-      real      OKthin                        ! Swich ON  a  new thinest layer
-      real      dz_dif                        ! difference from ideal discret.
-      real      thickL                        ! Thick Layer          Indicator
-      real      OK_ICE                        ! Swich ON   uppermost Ice Layer
- 
-      real      Agrege(knonv)                 ! 1. when Agregation constrained
-      real      dzepsi                        ! Min Single Snw Layer Thickness
-      real      dzxmin                        ! Min Acceptable Layer Thickness
-      real      dz_min                        ! Min            Layer Thickness
-      real      dz_max                        ! Max            Layer Thickness
-      real      dzagr1(knonv)                 ! 1st     Layer Thickness
-      real      dzagr2(knonv)                 ! 2nd     Layer Thickness
-      real      T_agr1(knonv)                 ! 1st     Layer Temperature
-      real      T_agr2(knonv)                 ! 2nd     Layer Temperature
-      real      roagr1(knonv)                 ! 1st     Layer Density
-      real      roagr2(knonv)                 ! 2nd     Layer Density
-      real      etagr1(knonv)                 ! 1st     Layer Water Content
-      real      etagr2(knonv)                 ! 2nd     Layer Water Content
-      real      G1agr1(knonv)                 ! 1st     Layer Dendricity/Spher.
-      real      G1agr2(knonv)                 ! 2nd     Layer Dendricity/Spher.
-      real      G2agr1(knonv)                 ! 1st     Layer Sphericity/Size
-      real      G2agr2(knonv)                 ! 2nd     Layer Sphericity/Size
-      real      agagr1(knonv)                 ! 1st     Layer Age
-      real      agagr2(knonv)                 ! 2nd     Layer Age
-
- 
-C +--DATA
-C +  ====
- 
-      data      icemix /   0    /             ! 0 ====> Agregated Snow+Ice=Snow
-      data      dzepsi /   0.0020/            ! Min single Layer Thickness
-      data      dzxmin /   0.0025/            ! Min accept.Layer Thickness
-c #EU data      dz_min /   0.0050/            ! Min Local  Layer Thickness < SMn
-      data      dz_min /   0.0040/            ! Min Local  Layer Thickness < SMn
-      data      dz_max /   0.0300/            ! Min Gener. Layer Thickness
-C +   CAUTION:  dz_max > dz_min*2 is required ! Otherwise re-agregation is
-C +                                           ! activated  after splitting
- 
-
- 
-
- 
-C +--Constrains Agregation         of too thin  Layers
-C +  =================================================
- 
-C +--Search the thinest  non-zero Layer
-C +  ----------------------------------
- 
-        DO ikl=1,knonv
-          if(isnoSV(ikl)<=2)             dz_min=max(0.0050,dz_min)
- 
-                                          dzepsi=0.0015
-          if(ro__SV(ikl,isnoSV(ikl))>920) dzepsi=0.0020
- 
-          dzthin(ikl) = 0.                              ! Arbitrary unrealistic
-        END DO                                          !       Layer Thickness
-cXF
-      DO ikl=1,knonv
-      DO   isn=1,isnoSV(ikl)-3 ! no agregation of 3 first snowlayers
-                               ! XF 04/07/2019
- 
-          isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
-          iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
-          iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
-! #vz     dz_ref(isn) =                                 !
-! #vz.          dz_min *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
-! #vz.                 +    iiceOK *    2**iice_n)      !
-! #vz.               /max(1,isnoSV(ikl))                !
-          dz_dif      = max(zero,                       ! Actual      Profile
-     .          dz_min                                  !
-     .                 *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
-     .                 +    iiceOK *2.   **iice_n)      !
-     .        - dzsnSV(ikl, isn)                    )   ! Actual      Profile
-! #vz     dzwdif(isn) =     dz_dif                      !
-          OKthin      = max(zero,                       !
-     .                      sign(unun,                  !
-     .                           dz_dif-dzthin(ikl)))   ! 1.=> New thinest Lay.
-     .                * max(0,                          ! 1 => .le. isnoSV
-     .                  min(1,                          ! 1 => isn is in the
-     .                      isnoSV(ikl)-isn +1 ))       !          Snow Pack
-     .                * min(unun,                                !
-!
-!                       1st additional Condition to accept OKthin
-     .                  max(zero,                                ! combination
-     .                      sign(unun,G1snSV(ikl,      isn  )    ! G1 with same
-     .                               *G1snSV(ikl,max(1,isn-1)))) !  sign => OK
-!
-!                       2nd additional Condition to accept OKthin
-     .                + max(zero,                                ! G1>0
-     .                      sign(unun,G1snSV(ikl,      isn   ))) !  =>OK
-!
-!                       3rd additional Condition to accept OKthin
-     .                + max(zero,                                ! dz too small
-     .                      sign(unun,dzxmin                     !  =>OK
-     .                               -dzsnSV(ikl,      isn   ))))!
- 
-          i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) ! Update   thinest Lay.
-     .                         + OKthin   * isn         !                Index
-          dzthin(ikl) =    (1. - OKthin)  * dzthin(ikl) !
-     .                         + OKthin   * dz_dif      !
-        END DO
-      END DO
- 
-
- 
-      DO ikl=1,knonv
-      DO   isn=1,isnoSV(ikl)
-          OKthin =      max(zero,                       !
-     .                      sign(unun,                  !
-     .                           dz_min                 !
-     .                          -dzsnSV(ikl,isn)))      !
-     .                * max(zero,                       ! ON if dz > 0
-     .                      sign(unun,                  !
-     .                           dzsnSV(ikl,isn)-epsi)) !
-     .           *min(1,max(0,                          ! Multiple Snow    Lay.
-     .                      min (1,                     ! Switch = 1
-     .                           isnoSV(ikl)            !   if isno > iice + 1
-     .                          -iiceSV(ikl)-1))        !
-C +                                                     !
-     .             +int(max(zero,                       !
-     .                      sign(unun,                  !
-     .                           dzepsi                 ! Minimum accepted for
-     .                          -dzsnSV(ikl,isn))))     ! 1 Snow Layer over Ice
-     .             *int(max(zero,                       ! ON if dz > 0
-     .                      sign(unun,                  !
-     .                           dzsnSV(ikl,isn)-epsi)))!
-     .                 *(1 -min (abs(isnoSV(ikl)        ! Switch = 1
-     .                              -iiceSV(ikl)-1),1)) !   if isno = iice + 1
-C +                                                     !
-     .                 +max(0,                          ! Ice
-     .                      min (1,                     ! Switch
-     .                           iiceSV(ikl)+1-isn)))   !
-     .             *min(unun,                                    !
-     .                  max(zero,                                ! combination
-     .                      sign(unun,G1snSV(ikl,      isn  )    ! G1>0 + G1<0
-     .                               *G1snSV(ikl,max(1,isn-1)))) ! NO
-     .                + max(zero,                                !
-     .                      sign(unun,G1snSV(ikl,      isn   ))) !
-     .                + max(zero,                                !
-     .                      sign(unun,dzxmin                     !
-     .                               -dzsnSV(ikl,      isn   ))))!
-          i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) ! Update   thinest Lay.
-     .                         + OKthin   * isn         !                Index
-        END DO
-      END DO
- 
-
-
- 
-C +   ***************
-      call SISVAT_zCr
-C +   ***************
- 
- 
-C +--Assign the 2 Layers to agregate
-C +  -------------------------------
- 
-        DO ikl=1,knonv
-          isn         =    i_thin(ikl)
-          if(LIndsv(ikl)>0) isn=min(nsno-1,isn) ! cXF
-          isagr1(ikl) =    istoSV(ikl,isn)
-          isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
-          dzagr1(ikl) =    dzsnSV(ikl,isn)
-          dzagr2(ikl) =    dzsnSV(ikl,isn+LIndsv(ikl))
-          T_agr1(ikl) =    TsisSV(ikl,isn)
-          T_agr2(ikl) =    TsisSV(ikl,isn+LIndsv(ikl))
-          roagr1(ikl) =    ro__SV(ikl,isn)
-          roagr2(ikl) =    ro__SV(ikl,isn+LIndsv(ikl))
-          etagr1(ikl) =    eta_SV(ikl,isn)
-          etagr2(ikl) =    eta_SV(ikl,isn+LIndsv(ikl))
-          G1agr1(ikl) =    G1snSV(ikl,isn)
-          G1agr2(ikl) =    G1snSV(ikl,isn+LIndsv(ikl))
-          G2agr1(ikl) =    G2snSV(ikl,isn)
-          G2agr2(ikl) =    G2snSV(ikl,isn+LIndsv(ikl))
-          agagr1(ikl) =    agsnSV(ikl,isn)
-          agagr2(ikl) =    agsnSV(ikl,isn+LIndsv(ikl))
-          LstLay      = min(1,max(  0,isnoSV(ikl) -1))  ! 0  if single Layer
-          isnoSV(ikl) =               isnoSV(ikl)       ! decrement   isnoSV
-     .     -(1-LstLay)* max(zero,                       ! if downmost  Layer
-     .                      sign(unun,eps_21            ! <  1.e-21 m
-     .                               -dzsnSV(ikl,1)))   !
-          isnoSV(ikl) = max(   0,     isnoSV(ikl)   )   !
-          Agrege(ikl) = max(zero,                       !
-     .                      sign(unun,dz_min            ! No Agregation
-     .                               -dzagr1(ikl)  ))   ! if too thick Layer
-     .                               *LstLay            ! if  a single Layer
-     .                * min( max(0   ,isnoSV(ikl)+1     ! if Agregation
-     .                               -i_thin(ikl)       !    with    a Layer
-     .                               -LIndsv(ikl)  ),1) !    above the Pack
- 
-          WEagre(ikl) = 0.
-        END DO
- 
- 
-        DO ikl=1,knonv
-        DO   isn=1,isnoSV(ikl)
-          WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn)
-     .                                *min(1,max(0,i_thin(ikl)+1-isn))
-        ENDDO
-        ENDDO
- 
- 
-C +--Agregates
-C +  ---------
- 
-C +     ***************
-        call SISVAT_zAg
-     .                 (isagr1,isagr2,WEagre
-     .                 ,dzagr1,dzagr2,T_agr1,T_agr2
-     .                 ,roagr1,roagr2,etagr1,etagr2
-     .                 ,G1agr1,G1agr2,G2agr1,G2agr2
-     .                 ,agagr1,agagr2,Agrege
-     .                 )
-C +     ***************
- 
- 
-C +--Rearranges the Layers
-C +  ---------------------
- 
-C +--New (agregated) Snow layer
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-        DO ikl=1,knonv
-          isn     =             i_thin(ikl)
-          isn     = min(isn,isn+LIndsv(ikl))
-          isnoSV(ikl) =  max(0.,isnoSV(ikl) -Agrege(ikl))
-          iiceSV(ikl) =         iiceSV(ikl)
-     .            -max(0,sign(1,iiceSV(ikl) -isn +icemix))
-     .                                      *Agrege(ikl)
-     .            *max(0,sign(1,iiceSV(ikl) -1          ))
-          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
-     .                      +   Agrege(ikl) *isagr1(ikl)
-          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
-     .                      +   Agrege(ikl) *dzagr1(ikl)
-          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
-     .                      +   Agrege(ikl) *T_agr1(ikl)
-          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
-     .                      +   Agrege(ikl) *roagr1(ikl)
-          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
-     .                      +   Agrege(ikl) *etagr1(ikl)
-          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
-     .                      +   Agrege(ikl) *G1agr1(ikl)
-          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
-     .                      +   Agrege(ikl) *G2agr1(ikl)
-          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
-     .                      +   Agrege(ikl) *agagr1(ikl)
-        END DO
- 
-C +--Above
-C +  ^^^^^
-        DO ikl=1,knonv
-          isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
-        END DO
-        DO i=  1,nsno-1
-        DO ikl=1,knonv
-            staggr        =  min(1,max(0,i +1 -isn1(ikl)   ))
-            istoSV(ikl,i) = (1.-staggr     )*istoSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*istoSV(ikl,i  )
-     .                      +   Agrege(ikl) *istoSV(ikl,i+1))
-            dzsnSV(ikl,i) = (1.-staggr     )*dzsnSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*dzsnSV(ikl,i  )
-     .                      +   Agrege(ikl) *dzsnSV(ikl,i+1))
-            TsisSV(ikl,i) = (1.-staggr     )*TsisSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*TsisSV(ikl,i  )
-     .                      +   Agrege(ikl) *TsisSV(ikl,i+1))
-            ro__SV(ikl,i) = (1.-staggr     )*ro__SV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*ro__SV(ikl,i  )
-     .                      +   Agrege(ikl) *ro__SV(ikl,i+1))
-            eta_SV(ikl,i) = (1.-staggr     )*eta_SV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*eta_SV(ikl,i  )
-     .                      +   Agrege(ikl) *eta_SV(ikl,i+1))
-            G1snSV(ikl,i) = (1.-staggr     )*G1snSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*G1snSV(ikl,i  )
-     .                      +   Agrege(ikl) *G1snSV(ikl,i+1))
-            G2snSV(ikl,i) = (1.-staggr     )*G2snSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*G2snSV(ikl,i  )
-     .                      +   Agrege(ikl) *G2snSV(ikl,i+1))
-            agsnSV(ikl,i) = (1.-staggr     )*agsnSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*agsnSV(ikl,i  )
-     .                      +   Agrege(ikl) *agsnSV(ikl,i+1))
-        END DO
-        END DO
- 
-        DO ikl=1,knonv
-          isn             = min(isnoSV(ikl) +1,nsno)
-          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
-          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
-          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
-          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
-          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
-          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
-          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
-          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
-        END DO
- 
-
- 
- 
-C +--Constrains Splitting          of too thick Layers
-C +  =================================================
- 
- 
-C +--Search the thickest non-zero Layer
-C +  ----------------------------------
- 
-        DO ikl=1,knonv
-          dzthin(ikl) =   0.                            ! Arbitrary unrealistic
-        END DO
-      DO ikl=1,knonv
-        DO   isn=1,isnoSV(ikl)
-          isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
-          iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
-          iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
-          dz_dif    =(      dzsnSV(ikl,isn)             ! Actual      Profile
-     .        - dz_max *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
-     .                 +    iiceOK *2.   **iice_n)  )   !
-     .                 /max(dzsnSV(ikl,isn),epsi)       !
-          OKthin      = max(zero,                       !
-     .                      sign(unun,                  !
-     .                           dz_dif-dzthin(ikl)))   ! 1.=>New thickest Lay.
-     .                * max(0,                          ! 1 =>.le. isnoSV
-     .                  min(1,                          !
-     .                      isnoSV(ikl)-isn +1 ))       !
-          i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) !  Update thickest Lay.
-     .                         + OKthin   * isn         !                Index
-          dzthin(ikl) =    (1. - OKthin)  * dzthin(ikl) !
-     .                         + OKthin   * dz_dif      !
-        END DO
- 
-        isn=max(1,isnoSV(ikl)-3)
-        if(dzsnSV(ikl,isn)>0.30) then   ! surface layer > 30cm
-         i_thin(ikl) = isn              ! XF 04/07/2019
-         dzthin(ikl) = dzsnSV(ikl,isn)
-        endif
- 
-        isn=max(1,isnoSV(ikl)-2)
-        if(dzsnSV(ikl,isn)>0.10) then   ! surface layer > 10cm
-         i_thin(ikl) = isn              ! XF 04/07/2019
-         dzthin(ikl) = dzsnSV(ikl,isn)
-        endif
- 
-        isn=max(1,isnoSV(ikl)-1)
-        if(dzsnSV(ikl,isn)>0.05) then   ! surface layer > 5cm
-         i_thin(ikl) = isn              ! XF 04/07/2019
-         dzthin(ikl) = dzsnSV(ikl,isn)
-        endif
- 
-        isn=max(1,isnoSV(ikl))
-        if(dzsnSV(ikl,isn)>0.02) then   ! surface layer > 2cm
-         i_thin(ikl) = isn              ! XF 04/07/2019
-         dzthin(ikl) = dzsnSV(ikl,isn)
-        endif
- 
-      END DO
- 
-      DO   ikl=1,knonv
-          ThickL      = max(zero,                       ! 1. => a too   thick
-     .                      sign(unun,dzthin(ikl)       !         Layer exists
-     .                               -epsi       ))     !
-     .        * max(0,1-max(0   ,     isnoSV(ikl)       ! No spliting allowed
-     .                               -nsno+1     ))     ! if isno > nsno - 1
-          Agrege(ikl) =               ThickL            ! 1. => effective split
-     .        * max(0,1-max(0   ,     NLaysv(ikl)       !
-     .                               +isnoSV(ikl)       !
-     .                               -nsno+1     ))     !
-          NLay_s(ikl) =               ThickL            ! Agregation
-     .        * max(0,1-max(0   ,     NLaysv(ikl)       ! to allow  Splitting
-     .                               +isnoSV(ikl)       !   at next Time Step
-     .                               -nsno       ))     !
-     .                               -Agrege(ikl)       !
-          NLay_s(ikl) = max(0   ,     NLay_s(ikl))      ! Agregation effective
-      END DO
- 
-
-C +--Rearranges the Layers
-C +  ---------------------
- 
-      DO isn=nsno,2,-1
-      DO ikl=1,knonv
-        IF (Agrege(ikl).gt.0..AND.i_thin(ikl).lt.isnoSV(ikl))       THEN
-          staggr          =  min(1,max(0,isn-i_thin(ikl)    -1))
-     .                    *  min(1,max(0,    isnoSV(ikl)-isn+2))
-          istoSV(ikl,isn) =        staggr  * istoSV(ikl ,isn-1)
-     .                    + (1. -  staggr) * istoSV(ikl ,isn  )
-          dzsnSV(ikl,isn) =        staggr  * dzsnSV(ikl ,isn-1)
-     .                    + (1. -  staggr) * dzsnSV(ikl ,isn  )
-          TsisSV(ikl,isn) =        staggr  * TsisSV(ikl ,isn-1)
-     .                    + (1. -  staggr) * TsisSV(ikl ,isn  )
-          ro__SV(ikl,isn) =        staggr  * ro__SV(ikl ,isn-1)
-     .                    + (1. -  staggr) * ro__SV(ikl ,isn  )
-          eta_SV(ikl,isn) =        staggr  * eta_SV(ikl ,isn-1)
-     .                    + (1. -  staggr) * eta_SV(ikl ,isn  )
-          G1snSV(ikl,isn) =        staggr  * G1snSV(ikl ,isn-1)
-     .                    + (1. -  staggr) * G1snSV(ikl ,isn  )
-          G2snSV(ikl,isn) =        staggr  * G2snSV(ikl ,isn-1)
-     .                    + (1. -  staggr) * G2snSV(ikl ,isn  )
-          agsnSV(ikl,isn) =        staggr  * agsnSV(ikl ,isn-1)
-     .                    + (1. -  staggr) * agsnSV(ikl ,isn  )
-        END IF
-      END DO
-      END DO
- 
-      DO  ikl=1,knonv
-          isn             =     i_thin(ikl)
-          dzsnSV(ikl,isn) = 0.5*Agrege(ikl) *dzsnSV(ikl,isn)
-     .                    + (1.-Agrege(ikl))*dzsnSV(ikl,isn)
- 
-          isn             = min(i_thin(ikl) +1,nsno)
-          istoSV(ikl,isn) =     Agrege(ikl) *istoSV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*istoSV(ikl,isn)
-          dzsnSV(ikl,isn) =     Agrege(ikl) *dzsnSV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*dzsnSV(ikl,isn)
-          TsisSV(ikl,isn) =     Agrege(ikl) *TsisSV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*TsisSV(ikl,isn)
-          ro__SV(ikl,isn) =     Agrege(ikl) *ro__SV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*ro__SV(ikl,isn)
-          eta_SV(ikl,isn) =     Agrege(ikl) *eta_SV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*eta_SV(ikl,isn)
-          G1snSV(ikl,isn) =     Agrege(ikl) *G1snSV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*G1snSV(ikl,isn)
-          G2snSV(ikl,isn) =     Agrege(ikl) *G2snSV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*G2snSV(ikl,isn)
-          agsnSV(ikl,isn) =     Agrege(ikl) *agsnSV(ikl,isn-1)
-     .                    + (1.-Agrege(ikl))*agsnSV(ikl,isn)
-          isnoSV(ikl)     = min(Agrege(ikl) +isnoSV(ikl),real(nsno))
-          iiceSV(ikl)     =                  iiceSV(ikl)
-     .                    +     Agrege(ikl) *max(0,sign(1,iiceSV(ikl)
-     .                                                   -isn +icemix))
-     .                                      *max(0,sign(1,iiceSV(ikl)
-     .                                                   -1          ))
-      END DO
- 
- 
-C +--Constrains Agregation in case of too much  Layers
-C +  =================================================
- 
-C +--Search the thinest   non-zero Layer
-C +  -----------------------------------
-
-
- 
-        DO ikl=1,knonv
-          dzthin(ikl) =   0.                            ! Arbitrary unrealistic
-        END DO                                          !       Layer Thickness
-      DO ikl=1,knonv
-        DO isn=1,isnoSV(ikl)-3 ! no agregation of 3 first snowlayers
-                               ! XF 04/07/2019
- 
-          isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
-          iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
-          iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
-! #vz     dz_ref(isn) =                                 !
-! #vz.          dz_min *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
-! #vz.                 +    iiceOK *    2**iice_n)      !
-! #vz.               /max(1,isnoSV(ikl))                !
-          dz_dif      =     dz_min                      ! Actual      Profile
-     .                    - dzsnSV(ikl    ,isn)         !
-     .        /max(epsi,((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
-     .                 +    iiceOK *2.   **iice_n))     !
-! #vz     dzwdif(isn) =     dz_dif                      !
-          OKthin      = max(zero,                       !
-     .                      sign(unun,                  !
-     .                           dz_dif  - dzthin(ikl)))! 1.=> New thinest Lay.
-     .                * max(0,                          ! 1 => .le. isnoSV
-     .                  min(1,                          !
-     .                      isnoSV(ikl)-isn +1 ))       !
-          i_thin(ikl) =    (1. - OKthin) * i_thin(ikl)  ! Update   thinest Lay.
-     .                         + OKthin  * isn          !                Index
-          dzthin(ikl) =    (1. - OKthin) * dzthin(ikl)  !
-     .                         + OKthin  * dz_dif       !
-
-
-        END DO
-      END DO
- 
- 
-
-
-
-C +--Index of the contiguous Layer to agregate
-C +  -----------------------------------------
- 
-C +   ***************
-      call SISVAT_zCr
-C +   ***************
- 
- 
-C +--Assign the 2 Layers to agregate
-C +  -------------------------------
- 
-        DO ikl=1,knonv
-          isn         =    i_thin(ikl)
-          if(LIndsv(ikl)>0) isn=min(isn, nsno-1) !cXF
-          isagr1(ikl) =    istoSV(ikl,isn)
-          isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
-          dzagr1(ikl) =    dzsnSV(ikl,isn)
-          dzagr2(ikl) =    dzsnSV(ikl,isn+LIndsv(ikl))
-          T_agr1(ikl) =    TsisSV(ikl,isn)
-          T_agr2(ikl) =    TsisSV(ikl,isn+LIndsv(ikl))
-          roagr1(ikl) =    ro__SV(ikl,isn)
-          roagr2(ikl) =    ro__SV(ikl,isn+LIndsv(ikl))
-          etagr1(ikl) =    eta_SV(ikl,isn)
-          etagr2(ikl) =    eta_SV(ikl,isn+LIndsv(ikl))
-          G1agr1(ikl) =    G1snSV(ikl,isn)
-          G1agr2(ikl) =    G1snSV(ikl,isn+LIndsv(ikl))
-          G2agr1(ikl) =    G2snSV(ikl,isn)
-          G2agr2(ikl) =    G2snSV(ikl,isn+LIndsv(ikl))
-          agagr1(ikl) =    agsnSV(ikl,isn)
-          agagr2(ikl) =    agsnSV(ikl,isn+LIndsv(ikl))
-          LstLay      = min(1,max(  0,    isnoSV(ikl)-1   ))
-          Agrege(ikl) = min(1,
-     .                  max(0,
-     .                      NLaysv(ikl)   +isnoSV(ikl)-nsno
-     .                     +NLay_s(ikl)                    )
-     .                                    *LstLay           )
- 
-C + minimum uppermost layer thickness to guarantee a correct reproduction of the snow
-C + atmosphere coupling
-        if(dzsnSV(ikl,max(1,isnoSV(ikl)-0))>0.02 .or.   ! surface layers> 2-5-10
-     .     dzsnSV(ikl,max(1,isnoSV(ikl)-1))>0.05 .or.   ! XF 04/07/2019
-     .     dzsnSV(ikl,max(1,isnoSV(ikl)-2))>0.10 .or.
-     .     dzsnSV(ikl,max(1,isnoSV(ikl)-3))>0.30 )then
-          Agrege(ikl) = min(1,
-     .                  max(0,
-     .                      NLaysv(ikl)   +isnoSV(ikl)+1-nsno ! nsno-1 layers ma
-     .                     +NLay_s(ikl)                    )
-     .                                    *LstLay           )
-        endif
- 
-          isnoSV(ikl) =                    isnoSV(ikl)
-     .     -(1-LstLay)*max(zero,
-     .                     sign(unun,      eps_21
-     .                                    -dzsnSV(ikl,1)   ))
-          isnoSV(ikl) =max(   0,           isnoSV(ikl)      )
- 
-          WEagre(ikl) = 0.
-        END DO
- 
-        DO isn=1,nsno
-        DO ikl=1,knonv
-          WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn)
-     .                                *min(1,max(0,i_thin(ikl)+1-isn))
-        ENDDO
-        ENDDO
-
-C +--Agregates
-C +  ---------
- 
-C +     ***************
-        call SISVAT_zAg
-     .                 (isagr1,isagr2,WEagre
-     .                 ,dzagr1,dzagr2,T_agr1,T_agr2
-     .                 ,roagr1,roagr2,etagr1,etagr2
-     .                 ,G1agr1,G1agr2,G2agr1,G2agr2
-     .                 ,agagr1,agagr2,Agrege
-     .                 )
-C +     ***************
- 
- 
-C +--Rearranges the Layers
-C +  ---------------------
- 
-C +--New (agregated) Snow layer
-C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
-        DO ikl=1,knonv
-          isn     =             i_thin(ikl)
-          isn     = min(isn,isn+LIndsv(ikl))
-          isnoSV(ikl) =  max(0.,isnoSV(ikl) -Agrege(ikl))
-          iiceSV(ikl) =         iiceSV(ikl)
-     .            -max(0,sign(1,iiceSV(ikl) -isn +icemix))
-     .                                      *Agrege(ikl)
-     .            *max(0,sign(1,iiceSV(ikl) -1          ))
-          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
-     .                      +   Agrege(ikl) *isagr1(ikl)
-          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
-     .                      +   Agrege(ikl) *dzagr1(ikl)
-          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
-     .                      +   Agrege(ikl) *T_agr1(ikl)
-          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
-     .                      +   Agrege(ikl) *roagr1(ikl)
-          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
-     .                      +   Agrege(ikl) *etagr1(ikl)
-          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
-     .                      +   Agrege(ikl) *G1agr1(ikl)
-          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
-     .                      +   Agrege(ikl) *G2agr1(ikl)
-          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
-     .                      +   Agrege(ikl) *agagr1(ikl)
-        END DO
- 
-C +--Above
-C +  ^^^^^
-        DO ikl=1,knonv
-          isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
-        END DO
-        DO i=  1,nsno-1
-        DO ikl=1,knonv
-            staggr        =  min(1,max(0,i +1 -isn1(ikl)   ))
-            istoSV(ikl,i) = (1.-staggr     )*istoSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*istoSV(ikl,i  )
-     .                      +   Agrege(ikl) *istoSV(ikl,i+1))
-            dzsnSV(ikl,i) = (1.-staggr     )*dzsnSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*dzsnSV(ikl,i  )
-     .                      +   Agrege(ikl) *dzsnSV(ikl,i+1))
-            TsisSV(ikl,i) = (1.-staggr     )*TsisSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*TsisSV(ikl,i  )
-     .                      +   Agrege(ikl) *TsisSV(ikl,i+1))
-            ro__SV(ikl,i) = (1.-staggr     )*ro__SV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*ro__SV(ikl,i  )
-     .                      +   Agrege(ikl) *ro__SV(ikl,i+1))
-            eta_SV(ikl,i) = (1.-staggr     )*eta_SV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*eta_SV(ikl,i  )
-     .                      +   Agrege(ikl) *eta_SV(ikl,i+1))
-            G1snSV(ikl,i) = (1.-staggr     )*G1snSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*G1snSV(ikl,i  )
-     .                      +   Agrege(ikl) *G1snSV(ikl,i+1))
-            G2snSV(ikl,i) = (1.-staggr     )*G2snSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*G2snSV(ikl,i  )
-     .                      +   Agrege(ikl) *G2snSV(ikl,i+1))
-            agsnSV(ikl,i) = (1.-staggr     )*agsnSV(ikl,i  )
-     .            + staggr*((1.-Agrege(ikl))*agsnSV(ikl,i  )
-     .                      +   Agrege(ikl) *agsnSV(ikl,i+1))
-        END DO
-        END DO
- 
-        DO ikl=1,knonv
-          isn             = min(isnoSV(ikl) +1,nsno)
-          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
-          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
-          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
-          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
-          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
-          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
-          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
-          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
-        END DO
-
-
-C +--Search new Ice/Snow Interface (option II in MAR)
-C +  ===============================================
-
-        IF (ok_zsn_ii) THEN 
-        
-        DO ikl=1,knonv
-          iiceSV(ikl) =  0
-        END DO
- 
-        DO ikl=1,knonv
-        DO   isn=1,isnoSV(ikl)
-          OK_ICE      = max(zero,sign(unun,ro__SV(ikl,isn)-ro_ice+20.))
-     .                * max(zero,sign(unun,dzsnSV(ikl,isn)-epsi))
-          iiceSV(ikl) = (1.-OK_ICE)       *iiceSV(ikl)
-     .                +     OK_ICE        *isn
-        END DO
-        END DO
-
-        END IF
- 
-      return
-      end
Index: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zsn.f90
===================================================================
--- LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zsn.f90	(revision 5246)
+++ LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zsn.f90	(revision 5246)
@@ -0,0 +1,741 @@
+
+
+subroutine SISVAT_zSn
+
+  ! +------------------------------------------------------------------------+
+  ! | MAR          SISVAT_zSn                                12-07-2019  MAR |
+  ! |   SubRoutine SISVAT_zSn manages the Snow Pack vertical Discretization  |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+  ! |                                                                        |
+  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
+  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+  ! |                     X       Number of Mosaic Cell per grid box         |
+  ! |                                                                        |
+  ! |   INPUT /  NLaysv   = New             Snow Layer  Switch               |
+  ! |   OUTPUT:  isnoSV   = total Nb of Ice/Snow Layers                      |
+  ! |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+  ! |            iiceSV   = total Nb of Ice      Layers                      |
+  ! |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+  ! |                                                                        |
+  ! |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+  ! |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+  ! |   ^^^^^^   ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+  ! |            eta_SV   : Soil/Snow Water   Content                [m3/m3] |
+  ! |            dzsnSV   : Snow Layer        Thickness                  [m] |
+  ! |            G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+  ! |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+  ! |            agsnSV   : Snow       Age                             [day] |
+  ! |                                                                        |
+  ! |   METHOD:  1) Agregate the thinest Snow Layer                          |
+  ! |   ^^^^^^      if a new Snow Layer has been precipitated   (NLaysv = 1) |
+  ! |            2) Divide   a too thick Snow Layer except                   |
+  ! |               if the maximum Number of Layer is reached                |
+  ! |               in this case forces                          NLay_s = 1  |
+  ! |            3) Agregate the thinest Snow Layer                          |
+  ! |               in order to divide a too thick Snow Layer                |
+  ! |               at next Time Step when                       NLay_s = 1  |
+  ! |                                                                        |
+  ! +------------------------------------------------------------------------+
+
+
+
+
+  ! +--Global Variables
+  ! +  ================
+
+
+  use VARphy
+  use VAR_SV
+  use VARdSV
+  use VAR0SV
+  use VARxSV
+  use VARySV
+  use surface_data, only: ok_zsn_ii
+
+  IMPLICIT NONE
+
+
+  ! +--Internal Variables
+  ! +  ==================
+
+  integer :: ikl   ,isn   ,i               !
+
+
+
+
+
+
+  integer :: NLay_s(knonv)                 ! Split Snow Layer         Switch
+  integer :: isagr1(knonv)                 ! 1st     Layer History
+  integer :: isagr2(knonv)                 ! 2nd     Layer History
+  integer :: LstLay                        ! 0 ====> isnoSV = 1
+  integer :: isno_n                        ! Snow Normal.Profile
+  integer :: iice_n                        ! Ice  Normal.Profile
+  integer :: iiceOK                        ! Ice         Switch
+  integer :: icemix                        ! 0 ====> Agregated Snow+Ice=Snow
+  ! +                                           ! 1                          Ice
+  integer :: isn1  (knonv)                 ! 1st layer to stagger
+  real :: staggr                        !              stagger  Switch
+
+  real :: WEagre(knonv)                 ! Snow Water Equivalent Thickness
+  real :: dzthin(knonv)                 ! Thickness of the thinest layer
+  real :: OKthin                        ! Swich ON  a  new thinest layer
+  real :: dz_dif                        ! difference from ideal discret.
+  real :: thickL                        ! Thick Layer          Indicator
+  real :: OK_ICE                        ! Swich ON   uppermost Ice Layer
+
+  real :: Agrege(knonv)                 ! 1. when Agregation constrained
+  real :: dzepsi                        ! Min Single Snw Layer Thickness
+  real :: dzxmin                        ! Min Acceptable Layer Thickness
+  real :: dz_min                        ! Min            Layer Thickness
+  real :: dz_max                        ! Max            Layer Thickness
+  real :: dzagr1(knonv)                 ! 1st     Layer Thickness
+  real :: dzagr2(knonv)                 ! 2nd     Layer Thickness
+  real :: T_agr1(knonv)                 ! 1st     Layer Temperature
+  real :: T_agr2(knonv)                 ! 2nd     Layer Temperature
+  real :: roagr1(knonv)                 ! 1st     Layer Density
+  real :: roagr2(knonv)                 ! 2nd     Layer Density
+  real :: etagr1(knonv)                 ! 1st     Layer Water Content
+  real :: etagr2(knonv)                 ! 2nd     Layer Water Content
+  real :: G1agr1(knonv)                 ! 1st     Layer Dendricity/Spher.
+  real :: G1agr2(knonv)                 ! 2nd     Layer Dendricity/Spher.
+  real :: G2agr1(knonv)                 ! 1st     Layer Sphericity/Size
+  real :: G2agr2(knonv)                 ! 2nd     Layer Sphericity/Size
+  real :: agagr1(knonv)                 ! 1st     Layer Age
+  real :: agagr2(knonv)                 ! 2nd     Layer Age
+
+
+  ! +--DATA
+  ! +  ====
+
+  data      icemix /   0    /             ! 0 ====> Agregated Snow+Ice=Snow
+  data      dzepsi /   0.0020/            ! Min single Layer Thickness
+  data      dzxmin /   0.0025/            ! Min accept.Layer Thickness
+  ! #EU data      dz_min /   0.0050/            ! Min Local  Layer Thickness < SMn
+  data      dz_min /   0.0040/            ! Min Local  Layer Thickness < SMn
+  data      dz_max /   0.0300/            ! Min Gener. Layer Thickness
+  ! +   CAUTION:  dz_max > dz_min*2 is required ! Otherwise re-agregation is
+  ! +                                           ! activated  after splitting
+
+
+
+
+
+  ! +--Constrains Agregation         of too thin  Layers
+  ! +  =================================================
+
+  ! +--Search the thinest  non-zero Layer
+  ! +  ----------------------------------
+
+    DO ikl=1,knonv
+      if(isnoSV(ikl)<=2)             dz_min=max(0.0050,dz_min)
+
+                                      dzepsi=0.0015
+      if(ro__SV(ikl,isnoSV(ikl))>920) dzepsi=0.0020
+
+      dzthin(ikl) = 0.                              ! Arbitrary unrealistic
+    END DO                                          !       Layer Thickness
+  !XF
+  DO ikl=1,knonv
+  DO   isn=1,isnoSV(ikl)-3 ! no agregation of 3 first snowlayers
+                           ! ! XF 04/07/2019
+
+      isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
+      iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
+      iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
+  ! #vz     dz_ref(isn) =                                 !
+  ! #vz.          dz_min *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+  ! #vz.                 +    iiceOK *    2**iice_n)      !
+  ! #vz.               /max(1,isnoSV(ikl))                !
+      dz_dif      = max(zero, & ! Actual      Profile
+            dz_min & !
+            *((1-iiceOK)*isno_n*isno_n & ! Theoretical Profile
+            +    iiceOK *2.   **iice_n) & !
+            - dzsnSV(ikl, isn)                    )   ! Actual      Profile
+  ! #vz     dzwdif(isn) =     dz_dif                      !
+      OKthin      = max(zero, & !
+            sign(unun, & !
+            dz_dif-dzthin(ikl))) & ! 1.=> New thinest Lay.
+            * max(0, & ! 1 => .le. isnoSV
+            min(1, & ! 1 => isn is in the
+            isnoSV(ikl)-isn +1 )) & !          Snow Pack
+            * min(unun, & !
+  !
+  !                   1st additional Condition to accept OKthin
+            max(zero, & ! combination
+            sign(unun,G1snSV(ikl,      isn  ) & ! G1 with same
+            *G1snSV(ikl,max(1,isn-1)))) & !  sign => OK
+  !
+  !                   2nd additional Condition to accept OKthin
+            + max(zero, & ! G1>0
+            sign(unun,G1snSV(ikl,      isn   ))) & !  =>OK
+  !
+  !                   3rd additional Condition to accept OKthin
+            + max(zero, & ! dz too small
+            sign(unun,dzxmin & !  =>OK
+            -dzsnSV(ikl,      isn   ))))!
+
+      i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) & ! Update   thinest Lay.
+            + OKthin   * isn         !                Index
+      dzthin(ikl) =    (1. - OKthin)  * dzthin(ikl) & !
+            + OKthin   * dz_dif      !
+    END DO
+  END DO
+
+
+
+  DO ikl=1,knonv
+  DO   isn=1,isnoSV(ikl)
+      OKthin =      max(zero, & !
+            sign(unun, & !
+            dz_min & !
+            -dzsnSV(ikl,isn))) & !
+            * max(zero, & ! ON if dz > 0
+            sign(unun, & !
+            dzsnSV(ikl,isn)-epsi)) & !
+            *min(1,max(0, & ! Multiple Snow    Lay.
+            min (1, & ! Switch = 1
+            isnoSV(ikl) & !   if isno > iice + 1
+            -iiceSV(ikl)-1)) & !
+  ! +                                                     !
+            +int(max(zero, & !
+            sign(unun, & !
+            dzepsi & ! Minimum accepted for
+            -dzsnSV(ikl,isn)))) & ! 1 Snow Layer over Ice
+            *int(max(zero, & ! ON if dz > 0
+            sign(unun, & !
+            dzsnSV(ikl,isn)-epsi))) & !
+            *(1 -min (abs(isnoSV(ikl) & ! Switch = 1
+            -iiceSV(ikl)-1),1)) & !   if isno = iice + 1
+  ! +                                                     !
+            +max(0, & ! Ice
+            min (1, & ! Switch
+            iiceSV(ikl)+1-isn))) & !
+            *min(unun, & !
+            max(zero, & ! combination
+            sign(unun,G1snSV(ikl,      isn  ) & ! G1>0 + G1<0
+            *G1snSV(ikl,max(1,isn-1)))) & ! NO
+            + max(zero, & !
+            sign(unun,G1snSV(ikl,      isn   ))) & !
+            + max(zero, & !
+            sign(unun,dzxmin & !
+            -dzsnSV(ikl,      isn   ))))!
+      i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) & ! Update   thinest Lay.
+            + OKthin   * isn         !                Index
+    END DO
+  END DO
+
+
+
+
+  ! +   ***************
+  call SISVAT_zCr
+  ! +   ***************
+
+
+  ! +--Assign the 2 Layers to agregate
+  ! +  -------------------------------
+
+    DO ikl=1,knonv
+      isn         =    i_thin(ikl)
+      if(LIndsv(ikl)>0) isn=min(nsno-1,isn) ! cXF
+      isagr1(ikl) =    istoSV(ikl,isn)
+      isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
+      dzagr1(ikl) =    dzsnSV(ikl,isn)
+      dzagr2(ikl) =    dzsnSV(ikl,isn+LIndsv(ikl))
+      T_agr1(ikl) =    TsisSV(ikl,isn)
+      T_agr2(ikl) =    TsisSV(ikl,isn+LIndsv(ikl))
+      roagr1(ikl) =    ro__SV(ikl,isn)
+      roagr2(ikl) =    ro__SV(ikl,isn+LIndsv(ikl))
+      etagr1(ikl) =    eta_SV(ikl,isn)
+      etagr2(ikl) =    eta_SV(ikl,isn+LIndsv(ikl))
+      G1agr1(ikl) =    G1snSV(ikl,isn)
+      G1agr2(ikl) =    G1snSV(ikl,isn+LIndsv(ikl))
+      G2agr1(ikl) =    G2snSV(ikl,isn)
+      G2agr2(ikl) =    G2snSV(ikl,isn+LIndsv(ikl))
+      agagr1(ikl) =    agsnSV(ikl,isn)
+      agagr2(ikl) =    agsnSV(ikl,isn+LIndsv(ikl))
+      LstLay      = min(1,max(  0,isnoSV(ikl) -1))  ! 0  if single Layer
+      isnoSV(ikl) =               isnoSV(ikl) & ! decrement   isnoSV
+            -(1-LstLay)* max(zero, & ! if downmost  Layer
+            sign(unun,eps_21 & ! <  1.e-21 m
+            -dzsnSV(ikl,1)))   !
+      isnoSV(ikl) = max(   0,     isnoSV(ikl)   )   !
+      Agrege(ikl) = max(zero, & !
+            sign(unun,dz_min & ! No Agregation
+            -dzagr1(ikl)  )) & ! if too thick Layer
+            *LstLay & ! if  a single Layer
+            * min( max(0   ,isnoSV(ikl)+1 & ! if Agregation
+            -i_thin(ikl) & !    with    a Layer
+            -LIndsv(ikl)  ),1) !    above the Pack
+
+      WEagre(ikl) = 0.
+    END DO
+
+
+    DO ikl=1,knonv
+    DO   isn=1,isnoSV(ikl)
+      WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn) &
+            *min(1,max(0,i_thin(ikl)+1-isn))
+    ENDDO
+    ENDDO
+
+
+  ! +--Agregates
+  ! +  ---------
+
+  ! +     ***************
+    call SISVAT_zAg &
+          (isagr1,isagr2,WEagre &
+          ,dzagr1,dzagr2,T_agr1,T_agr2 &
+          ,roagr1,roagr2,etagr1,etagr2 &
+          ,G1agr1,G1agr2,G2agr1,G2agr2 &
+          ,agagr1,agagr2,Agrege &
+          )
+  ! +     ***************
+
+
+  ! +--Rearranges the Layers
+  ! +  ---------------------
+
+  ! +--New (agregated) Snow layer
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+    DO ikl=1,knonv
+      isn     =             i_thin(ikl)
+      isn     = min(isn,isn+LIndsv(ikl))
+      isnoSV(ikl) =  max(0.,isnoSV(ikl) -Agrege(ikl))
+      iiceSV(ikl) =         iiceSV(ikl) &
+            -max(0,sign(1,iiceSV(ikl) -isn +icemix)) &
+            *Agrege(ikl) &
+            *max(0,sign(1,iiceSV(ikl) -1          ))
+      istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn) &
+            +   Agrege(ikl) *isagr1(ikl)
+      dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn) &
+            +   Agrege(ikl) *dzagr1(ikl)
+      TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn) &
+            +   Agrege(ikl) *T_agr1(ikl)
+      ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn) &
+            +   Agrege(ikl) *roagr1(ikl)
+      eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn) &
+            +   Agrege(ikl) *etagr1(ikl)
+      G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn) &
+            +   Agrege(ikl) *G1agr1(ikl)
+      G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn) &
+            +   Agrege(ikl) *G2agr1(ikl)
+      agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn) &
+            +   Agrege(ikl) *agagr1(ikl)
+    END DO
+
+  ! +--Above
+  ! +  ^^^^^
+    DO ikl=1,knonv
+      isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
+    END DO
+    DO i=  1,nsno-1
+    DO ikl=1,knonv
+        staggr        =  min(1,max(0,i +1 -isn1(ikl)   ))
+        istoSV(ikl,i) = (1.-staggr     )*istoSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*istoSV(ikl,i  ) &
+              +   Agrege(ikl) *istoSV(ikl,i+1))
+        dzsnSV(ikl,i) = (1.-staggr     )*dzsnSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*dzsnSV(ikl,i  ) &
+              +   Agrege(ikl) *dzsnSV(ikl,i+1))
+        TsisSV(ikl,i) = (1.-staggr     )*TsisSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*TsisSV(ikl,i  ) &
+              +   Agrege(ikl) *TsisSV(ikl,i+1))
+        ro__SV(ikl,i) = (1.-staggr     )*ro__SV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*ro__SV(ikl,i  ) &
+              +   Agrege(ikl) *ro__SV(ikl,i+1))
+        eta_SV(ikl,i) = (1.-staggr     )*eta_SV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*eta_SV(ikl,i  ) &
+              +   Agrege(ikl) *eta_SV(ikl,i+1))
+        G1snSV(ikl,i) = (1.-staggr     )*G1snSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*G1snSV(ikl,i  ) &
+              +   Agrege(ikl) *G1snSV(ikl,i+1))
+        G2snSV(ikl,i) = (1.-staggr     )*G2snSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*G2snSV(ikl,i  ) &
+              +   Agrege(ikl) *G2snSV(ikl,i+1))
+        agsnSV(ikl,i) = (1.-staggr     )*agsnSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*agsnSV(ikl,i  ) &
+              +   Agrege(ikl) *agsnSV(ikl,i+1))
+    END DO
+    END DO
+
+    DO ikl=1,knonv
+      isn             = min(isnoSV(ikl) +1,nsno)
+      istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
+      dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+      TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
+      ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
+      eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
+      G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
+      G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
+      agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
+    END DO
+
+
+
+
+  ! +--Constrains Splitting          of too thick Layers
+  ! +  =================================================
+
+
+  ! +--Search the thickest non-zero Layer
+  ! +  ----------------------------------
+
+    DO ikl=1,knonv
+      dzthin(ikl) =   0.                            ! Arbitrary unrealistic
+    END DO
+  DO ikl=1,knonv
+    DO   isn=1,isnoSV(ikl)
+      isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
+      iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
+      iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
+      dz_dif    =(      dzsnSV(ikl,isn) & ! Actual      Profile
+            - dz_max *((1-iiceOK)*isno_n*isno_n & ! Theoretical Profile
+            +    iiceOK *2.   **iice_n)  ) & !
+            /max(dzsnSV(ikl,isn),epsi)       !
+      OKthin      = max(zero, & !
+            sign(unun, & !
+            dz_dif-dzthin(ikl))) & ! 1.=>New thickest Lay.
+            * max(0, & ! 1 =>.le. isnoSV
+            min(1, & !
+            isnoSV(ikl)-isn +1 ))       !
+      i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) & !  Update thickest Lay.
+            + OKthin   * isn         !                Index
+      dzthin(ikl) =    (1. - OKthin)  * dzthin(ikl) & !
+            + OKthin   * dz_dif      !
+    END DO
+
+    isn=max(1,isnoSV(ikl)-3)
+    if(dzsnSV(ikl,isn)>0.30) then   ! surface layer > 30cm
+     i_thin(ikl) = isn              ! XF 04/07/2019
+     dzthin(ikl) = dzsnSV(ikl,isn)
+    endif
+
+    isn=max(1,isnoSV(ikl)-2)
+    if(dzsnSV(ikl,isn)>0.10) then   ! surface layer > 10cm
+     i_thin(ikl) = isn              ! XF 04/07/2019
+     dzthin(ikl) = dzsnSV(ikl,isn)
+    endif
+
+    isn=max(1,isnoSV(ikl)-1)
+    if(dzsnSV(ikl,isn)>0.05) then   ! surface layer > 5cm
+     i_thin(ikl) = isn              ! XF 04/07/2019
+     dzthin(ikl) = dzsnSV(ikl,isn)
+    endif
+
+    isn=max(1,isnoSV(ikl))
+    if(dzsnSV(ikl,isn)>0.02) then   ! surface layer > 2cm
+     i_thin(ikl) = isn              ! XF 04/07/2019
+     dzthin(ikl) = dzsnSV(ikl,isn)
+    endif
+
+  END DO
+
+  DO   ikl=1,knonv
+      ThickL      = max(zero, & ! 1. => a too   thick
+            sign(unun,dzthin(ikl) & !         Layer exists
+            -epsi       )) & !
+            * max(0,1-max(0   ,     isnoSV(ikl) & ! No spliting allowed
+            -nsno+1     ))     ! if isno > nsno - 1
+      Agrege(ikl) =               ThickL & ! 1. => effective split
+            * max(0,1-max(0   ,     NLaysv(ikl) & !
+            +isnoSV(ikl) & !
+            -nsno+1     ))     !
+      NLay_s(ikl) =               ThickL & ! Agregation
+            * max(0,1-max(0   ,     NLaysv(ikl) & ! to allow  Splitting
+            +isnoSV(ikl) & !   at next Time Step
+            -nsno       )) & !
+            -Agrege(ikl)       !
+      NLay_s(ikl) = max(0   ,     NLay_s(ikl))      ! Agregation effective
+  END DO
+
+
+  ! +--Rearranges the Layers
+  ! +  ---------------------
+
+  DO isn=nsno,2,-1
+  DO ikl=1,knonv
+    IF (Agrege(ikl).gt.0..AND.i_thin(ikl).lt.isnoSV(ikl))       THEN
+      staggr          =  min(1,max(0,isn-i_thin(ikl)    -1)) &
+            *  min(1,max(0,    isnoSV(ikl)-isn+2))
+      istoSV(ikl,isn) =        staggr  * istoSV(ikl ,isn-1) &
+            + (1. -  staggr) * istoSV(ikl ,isn  )
+      dzsnSV(ikl,isn) =        staggr  * dzsnSV(ikl ,isn-1) &
+            + (1. -  staggr) * dzsnSV(ikl ,isn  )
+      TsisSV(ikl,isn) =        staggr  * TsisSV(ikl ,isn-1) &
+            + (1. -  staggr) * TsisSV(ikl ,isn  )
+      ro__SV(ikl,isn) =        staggr  * ro__SV(ikl ,isn-1) &
+            + (1. -  staggr) * ro__SV(ikl ,isn  )
+      eta_SV(ikl,isn) =        staggr  * eta_SV(ikl ,isn-1) &
+            + (1. -  staggr) * eta_SV(ikl ,isn  )
+      G1snSV(ikl,isn) =        staggr  * G1snSV(ikl ,isn-1) &
+            + (1. -  staggr) * G1snSV(ikl ,isn  )
+      G2snSV(ikl,isn) =        staggr  * G2snSV(ikl ,isn-1) &
+            + (1. -  staggr) * G2snSV(ikl ,isn  )
+      agsnSV(ikl,isn) =        staggr  * agsnSV(ikl ,isn-1) &
+            + (1. -  staggr) * agsnSV(ikl ,isn  )
+    END IF
+  END DO
+  END DO
+
+  DO  ikl=1,knonv
+      isn             =     i_thin(ikl)
+      dzsnSV(ikl,isn) = 0.5*Agrege(ikl) *dzsnSV(ikl,isn) &
+            + (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+
+      isn             = min(i_thin(ikl) +1,nsno)
+      istoSV(ikl,isn) =     Agrege(ikl) *istoSV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*istoSV(ikl,isn)
+      dzsnSV(ikl,isn) =     Agrege(ikl) *dzsnSV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+      TsisSV(ikl,isn) =     Agrege(ikl) *TsisSV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*TsisSV(ikl,isn)
+      ro__SV(ikl,isn) =     Agrege(ikl) *ro__SV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*ro__SV(ikl,isn)
+      eta_SV(ikl,isn) =     Agrege(ikl) *eta_SV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*eta_SV(ikl,isn)
+      G1snSV(ikl,isn) =     Agrege(ikl) *G1snSV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*G1snSV(ikl,isn)
+      G2snSV(ikl,isn) =     Agrege(ikl) *G2snSV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*G2snSV(ikl,isn)
+      agsnSV(ikl,isn) =     Agrege(ikl) *agsnSV(ikl,isn-1) &
+            + (1.-Agrege(ikl))*agsnSV(ikl,isn)
+      isnoSV(ikl)     = min(Agrege(ikl) +isnoSV(ikl),real(nsno))
+      iiceSV(ikl)     =                  iiceSV(ikl) &
+            +     Agrege(ikl) *max(0,sign(1,iiceSV(ikl) &
+            -isn +icemix)) &
+            *max(0,sign(1,iiceSV(ikl) &
+            -1          ))
+  END DO
+
+
+  ! +--Constrains Agregation in case of too much  Layers
+  ! +  =================================================
+
+  ! +--Search the thinest   non-zero Layer
+  ! +  -----------------------------------
+
+
+
+    DO ikl=1,knonv
+      dzthin(ikl) =   0.                            ! Arbitrary unrealistic
+    END DO                                          !       Layer Thickness
+  DO ikl=1,knonv
+    DO isn=1,isnoSV(ikl)-3 ! no agregation of 3 first snowlayers
+                           ! ! XF 04/07/2019
+
+      isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
+      iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
+      iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
+  ! #vz     dz_ref(isn) =                                 !
+  ! #vz.          dz_min *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+  ! #vz.                 +    iiceOK *    2**iice_n)      !
+  ! #vz.               /max(1,isnoSV(ikl))                !
+      dz_dif      =     dz_min & ! Actual      Profile
+            - dzsnSV(ikl    ,isn) & !
+            /max(epsi,((1-iiceOK)*isno_n*isno_n & ! Theoretical Profile
+            +    iiceOK *2.   **iice_n))     !
+  ! #vz     dzwdif(isn) =     dz_dif                      !
+      OKthin      = max(zero, & !
+            sign(unun, & !
+            dz_dif  - dzthin(ikl))) & ! 1.=> New thinest Lay.
+            * max(0, & ! 1 => .le. isnoSV
+            min(1, & !
+            isnoSV(ikl)-isn +1 ))       !
+      i_thin(ikl) =    (1. - OKthin) * i_thin(ikl) & ! Update   thinest Lay.
+            + OKthin  * isn          !                Index
+      dzthin(ikl) =    (1. - OKthin) * dzthin(ikl) & !
+            + OKthin  * dz_dif       !
+
+
+    END DO
+  END DO
+
+
+
+
+
+  ! +--Index of the contiguous Layer to agregate
+  ! +  -----------------------------------------
+
+  ! +   ***************
+  call SISVAT_zCr
+  ! +   ***************
+
+
+  ! +--Assign the 2 Layers to agregate
+  ! +  -------------------------------
+
+    DO ikl=1,knonv
+      isn         =    i_thin(ikl)
+      if(LIndsv(ikl)>0) isn=min(isn, nsno-1) !cXF
+      isagr1(ikl) =    istoSV(ikl,isn)
+      isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
+      dzagr1(ikl) =    dzsnSV(ikl,isn)
+      dzagr2(ikl) =    dzsnSV(ikl,isn+LIndsv(ikl))
+      T_agr1(ikl) =    TsisSV(ikl,isn)
+      T_agr2(ikl) =    TsisSV(ikl,isn+LIndsv(ikl))
+      roagr1(ikl) =    ro__SV(ikl,isn)
+      roagr2(ikl) =    ro__SV(ikl,isn+LIndsv(ikl))
+      etagr1(ikl) =    eta_SV(ikl,isn)
+      etagr2(ikl) =    eta_SV(ikl,isn+LIndsv(ikl))
+      G1agr1(ikl) =    G1snSV(ikl,isn)
+      G1agr2(ikl) =    G1snSV(ikl,isn+LIndsv(ikl))
+      G2agr1(ikl) =    G2snSV(ikl,isn)
+      G2agr2(ikl) =    G2snSV(ikl,isn+LIndsv(ikl))
+      agagr1(ikl) =    agsnSV(ikl,isn)
+      agagr2(ikl) =    agsnSV(ikl,isn+LIndsv(ikl))
+      LstLay      = min(1,max(  0,    isnoSV(ikl)-1   ))
+      Agrege(ikl) = min(1, &
+            max(0, &
+            NLaysv(ikl)   +isnoSV(ikl)-nsno &
+            +NLay_s(ikl)                    ) &
+            *LstLay           )
+
+  ! + minimum uppermost layer thickness to guarantee a correct reproduction of the snow
+  ! + atmosphere coupling
+    if(dzsnSV(ikl,max(1,isnoSV(ikl)-0))>0.02 .or. & ! surface layers> 2-5-10
+          dzsnSV(ikl,max(1,isnoSV(ikl)-1))>0.05 .or. & ! XF 04/07/2019
+          dzsnSV(ikl,max(1,isnoSV(ikl)-2))>0.10 .or. &
+          dzsnSV(ikl,max(1,isnoSV(ikl)-3))>0.30 )then
+      Agrege(ikl) = min(1, &
+            max(0, &
+            NLaysv(ikl)   +isnoSV(ikl)+1-nsno & ! nsno-1 layers ma
+            +NLay_s(ikl)                    ) &
+            *LstLay           )
+    endif
+
+      isnoSV(ikl) =                    isnoSV(ikl) &
+            -(1-LstLay)*max(zero, &
+            sign(unun,      eps_21 &
+            -dzsnSV(ikl,1)   ))
+      isnoSV(ikl) =max(   0,           isnoSV(ikl)      )
+
+      WEagre(ikl) = 0.
+    END DO
+
+    DO isn=1,nsno
+    DO ikl=1,knonv
+      WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn) &
+            *min(1,max(0,i_thin(ikl)+1-isn))
+    ENDDO
+    ENDDO
+
+  ! +--Agregates
+  ! +  ---------
+
+  ! +     ***************
+    call SISVAT_zAg &
+          (isagr1,isagr2,WEagre &
+          ,dzagr1,dzagr2,T_agr1,T_agr2 &
+          ,roagr1,roagr2,etagr1,etagr2 &
+          ,G1agr1,G1agr2,G2agr1,G2agr2 &
+          ,agagr1,agagr2,Agrege &
+          )
+  ! +     ***************
+
+
+  ! +--Rearranges the Layers
+  ! +  ---------------------
+
+  ! +--New (agregated) Snow layer
+  ! +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+    DO ikl=1,knonv
+      isn     =             i_thin(ikl)
+      isn     = min(isn,isn+LIndsv(ikl))
+      isnoSV(ikl) =  max(0.,isnoSV(ikl) -Agrege(ikl))
+      iiceSV(ikl) =         iiceSV(ikl) &
+            -max(0,sign(1,iiceSV(ikl) -isn +icemix)) &
+            *Agrege(ikl) &
+            *max(0,sign(1,iiceSV(ikl) -1          ))
+      istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn) &
+            +   Agrege(ikl) *isagr1(ikl)
+      dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn) &
+            +   Agrege(ikl) *dzagr1(ikl)
+      TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn) &
+            +   Agrege(ikl) *T_agr1(ikl)
+      ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn) &
+            +   Agrege(ikl) *roagr1(ikl)
+      eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn) &
+            +   Agrege(ikl) *etagr1(ikl)
+      G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn) &
+            +   Agrege(ikl) *G1agr1(ikl)
+      G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn) &
+            +   Agrege(ikl) *G2agr1(ikl)
+      agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn) &
+            +   Agrege(ikl) *agagr1(ikl)
+    END DO
+
+  ! +--Above
+  ! +  ^^^^^
+    DO ikl=1,knonv
+      isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
+    END DO
+    DO i=  1,nsno-1
+    DO ikl=1,knonv
+        staggr        =  min(1,max(0,i +1 -isn1(ikl)   ))
+        istoSV(ikl,i) = (1.-staggr     )*istoSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*istoSV(ikl,i  ) &
+              +   Agrege(ikl) *istoSV(ikl,i+1))
+        dzsnSV(ikl,i) = (1.-staggr     )*dzsnSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*dzsnSV(ikl,i  ) &
+              +   Agrege(ikl) *dzsnSV(ikl,i+1))
+        TsisSV(ikl,i) = (1.-staggr     )*TsisSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*TsisSV(ikl,i  ) &
+              +   Agrege(ikl) *TsisSV(ikl,i+1))
+        ro__SV(ikl,i) = (1.-staggr     )*ro__SV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*ro__SV(ikl,i  ) &
+              +   Agrege(ikl) *ro__SV(ikl,i+1))
+        eta_SV(ikl,i) = (1.-staggr     )*eta_SV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*eta_SV(ikl,i  ) &
+              +   Agrege(ikl) *eta_SV(ikl,i+1))
+        G1snSV(ikl,i) = (1.-staggr     )*G1snSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*G1snSV(ikl,i  ) &
+              +   Agrege(ikl) *G1snSV(ikl,i+1))
+        G2snSV(ikl,i) = (1.-staggr     )*G2snSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*G2snSV(ikl,i  ) &
+              +   Agrege(ikl) *G2snSV(ikl,i+1))
+        agsnSV(ikl,i) = (1.-staggr     )*agsnSV(ikl,i  ) &
+              + staggr*((1.-Agrege(ikl))*agsnSV(ikl,i  ) &
+              +   Agrege(ikl) *agsnSV(ikl,i+1))
+    END DO
+    END DO
+
+    DO ikl=1,knonv
+      isn             = min(isnoSV(ikl) +1,nsno)
+      istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
+      dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+      TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
+      ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
+      eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
+      G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
+      G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
+      agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
+    END DO
+
+
+  ! +--Search new Ice/Snow Interface (option II in MAR)
+  ! +  ===============================================
+
+    IF (ok_zsn_ii) THEN
+
+    DO ikl=1,knonv
+      iiceSV(ikl) =  0
+    END DO
+
+    DO ikl=1,knonv
+    DO   isn=1,isnoSV(ikl)
+      OK_ICE      = max(zero,sign(unun,ro__SV(ikl,isn)-ro_ice+20.)) &
+            * max(zero,sign(unun,dzsnSV(ikl,isn)-epsi))
+      iiceSV(ikl) = (1.-OK_ICE)       *iiceSV(ikl) &
+            +     OK_ICE        *isn
+    END DO
+    END DO
+
+    END IF
+
+  return
+end subroutine sisvat_zsn
