Index: LMDZ5/trunk/libf/phylmd/conf_phys_m.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/conf_phys_m.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/conf_phys_m.F90	(revision 1865)
@@ -83,4 +83,5 @@
   character (len = 10),SAVE  :: type_veget_omp
   CHARACTER(len = 8),SAVE   :: aer_type_omp
+  logical,SAVE              :: ok_snow_omp
   logical,SAVE              :: ok_newmicro_omp
   logical,SAVE        :: ok_journe_omp, ok_mensuel_omp, ok_instan_omp, ok_hf_omp        
@@ -227,4 +228,13 @@
   call getin('VEGET', type_veget_omp)
 !
+
+! Martin
+!Config Key  = ok_snow
+!Config Desc = Flag to activate snow model SISVAT
+!Config Def  = .false.
+  ok_snow_omp = .false.
+  call getin('ok_snow', ok_snow_omp)
+! Martin
+
 !Config Key  = OK_journe
 !Config Desc = Pour des sorties journalieres 
@@ -1737,4 +1747,7 @@
          ok_veget=.false.
     endif
+    ! Martin
+    ok_snow = ok_snow_omp
+    ! Martin
 
     ok_newmicro = ok_newmicro_omp
@@ -1860,4 +1873,5 @@
   write(lunout,*)' Version ocean = ', version_ocean
   write(lunout,*)' Config veget = ', ok_veget,type_veget
+  write(lunout,*)' Snow model SISVAT : ok_snow = ', ok_snow
   write(lunout,*)' Sortie journaliere = ', ok_journe
   write(lunout,*)' Sortie haute frequence = ', ok_hf
Index: LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90	(revision 1865)
@@ -171,4 +171,5 @@
        debut,     lafin,                              &
        rlon,      rlat,      rugoro,   rmu0,          &
+       zsig,      sollwd_m,  pphi,     cldt,          &
        rain_f,    snow_f,    solsw_m,  sollw_m,       &
        t,         q,         u,        v,             &
@@ -177,4 +178,5 @@
        lwdown_m,  cdragh,    cdragm,   zu1,    zv1,   &
        alb1_m,    alb2_m,    zxsens,   zxevap,        &
+       alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
        zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
        d_t,       d_q,       d_u,      d_v, d_t_diss, & 
@@ -224,4 +226,9 @@
 ! rlat-----input-R- latitude en degree
 ! rugos----input-R- longeur de rugosite (en m)
+! Martin
+! zsig-----input-R- slope
+! cldt-----input-R- total cloud fraction
+! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
+! Martin
 !
 ! d_t------output-R- le changement pour "t"
@@ -287,4 +294,10 @@
     REAL, DIMENSION(klon,klev+1), INTENT(IN)        :: paprs   ! pression between layers (Pa) 
     REAL, DIMENSION(klon, nbsrf), INTENT(IN)        :: pctsrf  ! sub-surface fraction
+! Martin
+    REAL, DIMENSION(klon),        INTENT(IN)        :: zsig    ! slope
+    REAL, DIMENSION(klon),        INTENT(IN)        :: sollwd_m ! net longwave radiation at mean s    
+    REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud fraction
+    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: pphi    ! geopotential (m2/s2)
+! Martin
 
 ! Input/Output variables
@@ -298,5 +311,4 @@
     REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: v10m    ! v speed at 10m
     REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke 
-
 ! Output variables
 !****************************************************************************************
@@ -308,4 +320,7 @@
     REAL, DIMENSION(klon),        INTENT(OUT)       :: alb1_m     ! mean albedo in visible SW interval
     REAL, DIMENSION(klon),        INTENT(OUT)       :: alb2_m     ! mean albedo in near IR SW interval
+    ! Martin
+	REAL, DIMENSION(klon),        INTENT(OUT)       :: alb3_lic
+    ! Martin
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsens     ! sensible heat flux at surface with inversed sign 
                                                                   ! (=> positive sign upwards)
@@ -370,4 +385,12 @@
     REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q     ! water vapour flux(latent flux) (kg/m**2/s)
 
+! Martin
+! sisvat
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: qsnow      ! snow water content
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: snowhgt    ! snow height
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: to_ice     ! snow passed to ice
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: sissnow    ! snow in snow model
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: runoff     ! runoff on land ice
+! Martin
 
 ! Local variables with attribute SAVE
@@ -429,5 +452,5 @@
     REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
     REAL, DIMENSION(klon)              :: ypsref
-    REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb1_new, yalb2_new
+    REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb1_new, yalb2_new, yalb3_new
     REAL, DIMENSION(klon)              :: ztsol
     REAL, DIMENSION(klon)              :: alb_m  ! mean albedo for whole SW interval
@@ -475,4 +498,15 @@
 
     REAL                               :: zx_qs1, zcor1, zdelta1 
+
+    ! Martin
+    REAL, DIMENSION(klon, nbsrf)       :: sollwd ! net longwave radiation at surface
+    REAL, DIMENSION(klon)              :: ysollwd
+    REAL, DIMENSION(klon)              :: ytoice
+    REAL, DIMENSION(klon)              :: ysnowhgt, yqsnow, ysissnow, yrunoff
+    REAL, DIMENSION(klon)              :: yzsig
+    REAL, DIMENSION(klon,klev)         :: ypphi
+    REAL, DIMENSION(klon)              :: ycldt
+    REAL, DIMENSION(klon)              :: yrmu0
+    ! Martin
 
 !****************************************************************************************
@@ -556,4 +590,9 @@
     d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0        ; yqsol = 0.0    
     ytherm = 0.0  ; ytke=0.
+    ! Martin
+    ysnowhgt = 0.0; yqsnow = 0.0     ; yrunoff = 0.0   ; ytoice =0.0
+    yalb3_new = 0.0  ; ysissnow = 0.0  ; ysollwd = 0.0
+    ypphi = 0.0   ; ycldt = 0.0      ; yrmu0 = 0.0
+    ! Martin
     
     tke(:,:,is_ave)=0.
@@ -644,4 +683,7 @@
        DO i = 1, klon
           sollw(i,nsrf) = sollw_m(i) + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ts(i,nsrf))
+          ! Martin
+          sollwd(i,nsrf)= sollwd_m(i)
+          ! Martin
           solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
        ENDDO
@@ -712,4 +754,9 @@
           ypaprs(j,klev+1) = paprs(i,klev+1)
           ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 )
+          ! Martin
+          yzsig(j)   = zsig(i)
+          ycldt(j)   = cldt(i)
+          yrmu0(j)   = rmu0(i)
+          ! Martin
        END DO
 
@@ -862,5 +909,8 @@
      
        CASE(is_lic)
+          ! Martin
           CALL surf_landice(itap, dtime, knon, ni, &
+               rlon, rlat, debut, lafin, &
+               yrmu0, ysollwd, yalb, ypphi(:,1), &
                ysolsw, ysollw, yts, ypplay(:,1), &
                ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
@@ -871,5 +921,30 @@
                ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
                ytsurf_new, y_dflux_t, y_dflux_q, &
+               yzsig, ycldt, &
+               ysnowhgt, yqsnow, ytoice, ysissnow, &
+               yalb3_new, yrunoff, &
                y_flux_u1, y_flux_v1)
+          !CALL surf_landice(itap, dtime, knon, ni, &
+          !     ysolsw, ysollw, yts, ypplay(:,1), &
+          !     ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
+          !     AcoefH, AcoefQ, BcoefH, BcoefQ, &
+          !     AcoefU, AcoefV, BcoefU, BcoefV, &
+          !     ypsref, yu1, yv1, yrugoro, pctsrf, &
+          !     ysnow, yqsurf, yqsol, yagesno, &
+          !     ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+          !     ytsurf_new, y_dflux_t, y_dflux_q, &
+          !     y_flux_u1, y_flux_v1)
+
+          alb3_lic(i)=0.
+          DO j = 1, knon
+             i = ni(j)
+             alb3_lic(i) = yalb3_new(j)
+             snowhgt(i)   = ysnowhgt(j)
+             qsnow(i)     = yqsnow(j)
+             to_ice(i)    = ytoice(j)
+             sissnow(i)   = ysissnow(j)
+             runoff(i)    = yrunoff(j)
+          END DO
+          ! Martin
           
        CASE(is_oce)
Index: LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90	(revision 1865)
@@ -264,4 +264,8 @@
 !$OMP THREADPRIVATE(rneb)
 
+! variables de sorties MM
+      REAL, ALLOCATABLE,DIMENSION(:) :: zxsnow,snowhgt,qsnow,to_ice
+      REAL, ALLOCATABLE,DIMENSION(:) :: sissnow,runoff,albsol3_lic
+
 CONTAINS
 
@@ -414,4 +418,8 @@
 
 
+      ALLOCATE (zxsnow(klon),snowhgt(klon),qsnow(klon),to_ice(klon),sissnow(klon),runoff(klon),albsol3_lic(klon))
+
+
+
 END SUBROUTINE phys_local_var_init
 
@@ -554,4 +562,5 @@
       DEALLOCATE(beta_prec)
       DEALLOCATE(rneb)
+      DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
 
 END SUBROUTINE phys_local_var_end
Index: LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 1865)
@@ -1153,4 +1153,18 @@
   TYPE(ctrl_out), SAVE :: o_rldcs4co2 = ctrl_out((/ 5, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     'rldcs4co2', 'Downwelling CS LW 4xCO2 atmosphere', 'W/m2', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_snowsrf = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11 /), &
+    'snowsrf', 'Snow mass at surface', 'kg/m2', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_qsnow = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11 /), &
+    'qsnow', 'Water contained in snow', 'kg/m2', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_snowhgt = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11 /), &
+    'snowhgt', 'Snow height at surface', 'm', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_toice = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11 /), &
+    'to_ice', 'Snow passed to ice model', 'kg/m2', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_sissnow = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11 /), &
+    'sissnow', 'Snow in snow model', 'kg/m2', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_runoff = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11 /), &
+    'runoff', 'Run-off rate land ice', 'kg/m2/s', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_albslw3 = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11 /), &
+    'albslw3', 'Surface albedo LW3', '-', (/ ('', i=1, 9) /))
 
 !!!!!!!!!!!!! Sorties niveaux standards de pression NMC 
Index: LMDZ5/trunk/libf/phylmd/phys_output_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/phys_output_mod.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/phys_output_mod.F90	(revision 1865)
@@ -41,4 +41,6 @@
     USE mod_phys_lmdz_para
     USE aero_mod, only : naero_spc,name_aero
+	!Martin
+    USE surface_data, ONLY : ok_snow
     USE phys_output_ctrlout_mod
 
Index: LMDZ5/trunk/libf/phylmd/phys_output_var_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/phys_output_var_mod.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/phys_output_var_mod.F90	(revision 1865)
@@ -23,4 +23,5 @@
       REAL, ALLOCATABLE :: bils_latent(:) ! bilan de chaleur au sol
 !$OMP THREADPRIVATE(bils_ec,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
+
 
 ! ug Plein de variables venues de phys_output_mod
Index: LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90	(revision 1865)
@@ -31,8 +31,9 @@
     USE phys_state_var_mod
     USE phys_local_var_mod
+    USE phys_output_var_mod
     USE indice_sol_mod
     USE infotrac
     USE comgeomphy
-    USE surface_data,     ONLY : type_ocean, ok_veget
+    USE surface_data,     ONLY : type_ocean, ok_veget, ok_snow
     USE aero_mod
     USE ioipsl
@@ -296,4 +297,14 @@
 ENDIF
       CALL histwrite_phy(o_tauy, zx_tmp_fi2d)
+
+      IF (ok_snow) THEN
+         CALL histwrite_phy(o_snowsrf, zxsnow)
+         CALL histwrite_phy(o_qsnow, qsnow)
+         CALL histwrite_phy(o_snowhgt,snowhgt)
+         CALL histwrite_phy(o_toice,to_ice)
+         CALL histwrite_phy(o_sissnow,sissnow)
+         CALL histwrite_phy(o_runoff,runoff)
+         CALL histwrite_phy(o_albslw3,albsol3_lic)
+      ENDIF
 
 
Index: LMDZ5/trunk/libf/phylmd/physiq.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/physiq.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/physiq.F90	(revision 1865)
@@ -25,5 +25,5 @@
   USE pbl_surface_mod, ONLY : pbl_surface
   USE change_srf_frac_mod
-  USE surface_data,     ONLY : type_ocean, ok_veget
+  USE surface_data,     ONLY : type_ocean, ok_veget, ok_snow
   USE phys_local_var_mod ! Variables internes non sauvegardees de la physique
   USE phys_state_var_mod ! Variables sauvegardees de la physique
@@ -773,5 +773,5 @@
 
   !
-  REAL zxsnow(klon)
+!  REAL zxsnow(klon)
   REAL zxsnow_dummy(klon)
   !
@@ -1997,4 +1997,5 @@
           debut,     lafin, &
           rlon,      rlat,      rugoro,  rmu0,      &
+          zsig,      sollwdown, pphi,    cldt,      &
           rain_fall, snow_fall, solsw,   sollw,     &
           t_seri,    q_seri,    u_seri,  v_seri,    &
@@ -2003,4 +2004,5 @@
           sollwdown, cdragh,    cdragm,  u1,    v1, &
           albsol1,   albsol2,   sens,    evap,   &
+          albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
           zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
           d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
Index: LMDZ5/trunk/libf/phylmd/sisvat/LMDZCTR.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/LMDZCTR.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/LMDZCTR.F90	(revision 1865)
@@ -0,0 +1,54 @@
+MODULE LMDZCTR
+
+IMPLICIT NONE
+! +                                                                
+                                                                                
+      logical           reaVAR    ! Input INI: Prev.Dyn.Simulat. (MAR, GCM)     
+      logical           reaLBC    ! Input LBC: Prev.Dyn.Simulat. (MAR, GCM)     
+      logical           safVAR    ! Full Output on Saving Files   MARxxx.DAT    
+      logical           sALONE    !                                             
+      logical           geoNST    !                                             
+      logical           conmas    ! Mass       Conserv. Constraint Init.Switch  
+      logical           potvor    ! P.-Vortic. Conserv. Constraint Init.Switch  
+      logical           hamfil    ! Initial Filtered Fields (Time, Hamming)     
+      logical           brocam    ! Brown and Campana  Time      Scheme Switch  
+      logical           LFrBAK    ! Leap-Frog Backward Advection Scheme Switch  
+      logical           openLB    !                                             
+      logical           sommlb    !                                             
+      logical           FirstC    !                                             
+      logical           qqmass    ! Mass       Conservation             Switch  
+      logical           turhor    ! Horizontal Diffusion (Smagorinsky)  Switch  
+      logical           SBLitr    !                                             
+      logical           tur_25    !                                             
+      logical           convec    ! Convective  Adjustment              Switch  
+      logical           MFLX_d    ! Convective  Adjustment (deep)       Switch  
+      logical           MFLX_s    ! Convective  Adjustment (shallow)    Switch  
+      logical           micphy    ! Cloud       Microphysics            Switch  
+      logical           fracld    ! Fractional  Cloudiness              Switch  
+      logical           chimod    ! Atmospheric Chemical Model          Switch  
+      logical           physic    ! Atmospheric/Surface Physics         Switch  
+      logical           polmod    ! Interactive Polynya    is           Switch  
+      logical           snomod    ! Interactive Snow Model is           Switch  
+      logical           BloMod    !                                             
+      logical           vegmod    ! Interactive SVAT                    Switch  
+      logical           VSISVAT   !                                             
+      logical           no_vec    ! Scalar     (NO Vectorization)       Switch  
+                                                                                
+                                                                                
+      integer           itexpe,iterun,nterun,nbhour,itConv                      
+      integer           iboucl,nboucl,nprint,ipr_nc,npr_nc                      
+      integer           maptyp                                                  
+      integer           log_1D                                                  
+                                                                                
+      real*8            Robert                                                  
+      real*8            rrmin ,rrmax                                            
+      real*8            rxbase,rxfact                                           
+      real*8            fxlead                                                  
+      real*8            tMFLXd        ! d(time) between 2 deep convection CALL  
+      real*8            aMFLXd,aMFLXs ! adjustment times (deep, shallow)        
+                                                                               
+      character*16      fnam                                                    
+
+
+END MODULE LMDZCTR
+
Index: LMDZ5/trunk/libf/phylmd/sisvat/LMDZ_KL.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/LMDZ_KL.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/LMDZ_KL.F90	(revision 1865)
@@ -0,0 +1,43 @@
+MODULE LMDZ_KL
+
+USE VAR_SV, only : klonv
+
+IMPLICIT NONE
+! +
+    REAL, DIMENSION(:),SAVE,ALLOCATABLE :: SOsoKL    ! Abs Solar Radiation 
+!$OMP THREADPRIVATE(SOsoKL)
+    REAL, DIMENSION(:),SAVE,ALLOCATABLE :: IRsoKL    ! Abs IR    Radiation 
+!$OMP THREADPRIVATE(IRsoKL)
+    REAL, DIMENSION(:),SAVE,ALLOCATABLE :: HSsoKL    ! Abs Sensible Ht Flux 
+!$OMP THREADPRIVATE(HSsoKL)
+    REAL, DIMENSION(:),SAVE,ALLOCATABLE :: HLsoKL    ! Abs Latent Heat Flux 
+!$OMP THREADPRIVATE(HLsoKL)
+    REAL, DIMENSION(:),SAVE,ALLOCATABLE :: HLs_KL    ! Evaporation          
+!$OMP THREADPRIVATE(HLs_KL)
+    REAL, DIMENSION(:),SAVE,ALLOCATABLE :: HLv_KL    ! Transpiration        
+!$OMP THREADPRIVATE(HLv_KL)
+    
+!   REAL, DIMENSION(klonv)                 :: SOsoNC    ! Abs Solar Radiation  
+!   REAL, DIMENSION(klonv)                 :: IRsoNC    ! Abs IR    Radiation  
+!   REAL, DIMENSION(klonv)                 :: HSsoNC    ! Abs Sensible Ht Flux
+!   REAL, DIMENSION(klonv)                 :: HLsoNC    ! Abs Latent Heat Flux
+!   REAL, DIMENSION(klonv)                 :: HLs_NC    ! Evaporation      
+!   REAL, DIMENSION(klonv)                 :: HLv_NC    ! Transpiration       
+
+CONTAINS
+  
+  SUBROUTINE INIT_LMDZ_KL
+  IMPLICIT NONE
+  
+    ALLOCATE(SOsoKL(klonv))    ! Abs Solar Radiation 
+    ALLOCATE(IRsoKL(klonv))    ! Abs IR    Radiation 
+    ALLOCATE(HSsoKL(klonv))    ! Abs Sensible Ht Flux 
+    ALLOCATE(HLsoKL(klonv))    ! Abs Latent Heat Flux 
+    ALLOCATE(HLs_KL(klonv))    ! Evaporation          
+    ALLOCATE(HLv_KL(klonv))    ! Transpiration        
+       
+  END SUBROUTINE INIT_LMDZ_KL
+  
+  
+END MODULE LMDZ_KL
+
Index: LMDZ5/trunk/libf/phylmd/sisvat/PHY_SV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/PHY_SV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/PHY_SV.F90	(revision 1865)
@@ -0,0 +1,70 @@
+MODULE PHY_SV
+
+IMPLICIT NONE
+
+! Constants
+                                                                              
+      CHARACTER(LEN=1), PARAMETER :: labnum(0:9) =                            &
+              (/'0','1','2','3','4','5','6','7','8','9'/)             
+!C +...                labnum: Alphanumeric Character                          
+                                                                               
+      INTEGER, PARAMETER ::  izr=0,iun=1                                             
+      REAL, PARAMETER    ::  zer0 = 0.0e+0, half = 0.5e+0, un_1 = 1.0e+0,     &
+     &                       eps6 = 1.0e-6, epsn = 1.0e-9, R_1000=1.e3             
+      REAL               ::  ea_MAX,ea_MIN 
+!C +...                    zer0 = 0.0e+0                                       
+!C +                       half = 0.5e+0                                 
+!C +                       un_1 = 1.0e+0                             
+!C +                       eps6 = 1.0e-6  ! Arbirary Small Value           !    1.e-6     
+!C +                       epsn = 1.0e-9  ! Arbirary Small Value           !    1.e-6 
+!C +                       R_1000=1.e3     
+!C +                       ea_MIN   ! MAX allowed exponential Argum. ! computed by HOST     
+!C +                       ea_MIN   ! MIN allowed exponential Argum. ! computed by HOST     
+                                                                              
+      REAL, PARAMETER    ::  piNmbr = 3.141592653589793238462643e0
+      REAL, SAVE         ::  Dg2Rad = piNmbr / 180.
+!C +...                    piNmbr   ! pi    = 3.141592653589793238462643e0             
+!C +...                    Dg2rad   ! pi / 180                                       
+      REAL, PARAMETER    ::  Grav_F = 9.81e0, Grav_I = 1./Grav_F                       
+!C +                   Grav_F:  Gravitational  Force         =  9.81    m/s2           
+!C +                   Grav_I: 1 / Grav_F                    = 1 /9.81    s2/m    
+                                                                              
+      REAL, PARAMETER    ::  A_MolV = 1.35e-5, vonKrm = 0.40e0, A_Stab = 5.8,  &
+     &                       AhStab = 5.4,     AsStab = 4.0,    r_Stab = 3.0            
+!C +...                A_MolV: Air Viscosity                 = 1.35d-5 m2/s   
+!C +                   vonKrm: von Karman constant           = 0.4            
+!C +                   A_Stab: Stability  Coefficient Moment = 5.8             
+!C +                   AhStab: Stability  Coefficient Heat   = 5.4             
+!C +                   AsStab: Stability  Coefficient Blown * = 4.0            
+!C +                   r_Stab: Turbulent Diffusivities Ratio K*/Km             
+                                                                              
+      REAL, PARAMETER    ::  R_DAir=287.05967, CpdAir=1004.708845,             &
+     &                       RCp=R_DAir/CpdAir,p0_kap=3.73010e0,               &
+     &                       StefBo=5.67e-8         
+      REAL, PARAMETER    ::  LhfH2O=3.34e+5, LhvH2O=2.5008e+6,&
+     &                       LhsH2O=2.8345e+6      
+!C +...                R_DAir: perfect gas law constant for dry air (287 J/kg/K) 
+!C +                   CpdAir: dry air specific heat at constant p (1004 J/kg/K) 
+!C +                   RCp   : R / Cp                      
+!C +                   p0_kap: 100 kPa ** (R/Cp)                                    
+!C +                   LhfH2O: Latent Heat of Fusion of Snow  =    3.34d+5 J/kg
+!C +                   LhvH2O: Latent Heat Vaporisation Snow  = 2500.00d+3 J/kg  
+!C +                   LhsH2O: Latent Heat Sublimation  Snow  = 2833.60d+3 J/kg  
+!C +                   StefBo: Stefan-Boltzman Constant       =    5.67d-8 W/m2/K4
+                                                                                
+      REAL, PARAMETER    ::  rhoWat=1000.00e0, hC_Wat=4186.00e0        
+!C +                   rhoWat: Water Specific Mass            = 1000.00d+0 kg/m3 
+!C +                   hC_Wat: Water Heat Capacity            = 4186.00d+0 J/kg/K
+                                                                                
+      REAL, PARAMETER    ::  rhoIce=920.e0, BSnoRo=3.30e+2                             
+!C +...                rhoIce:  Density      of Pure Ice      =  920.00d+0 kg/m3
+!C +                   BSnoRo : Blowed Snow Density           =  255.00d+0 kg/m3 
+                                                                                
+      REAL, PARAMETER    ::  Tf_Sno=273.16e+0,Tf_Sea=271.2e+0             
+!C +...                Tf_Sno: Snow  Melting  Point           =  273.16    K     
+!C +...                Tf_Sea: Sea   Melting  Point           =  271.2     K
+
+                      
+                                                                                
+
+END MODULE PHY_SV
Index: LMDZ5/trunk/libf/phylmd/sisvat/VAR0SV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VAR0SV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VAR0SV.F90	(revision 1865)
@@ -0,0 +1,31 @@
+MODULE VAR0SV
+
+USE VAR_SV, only : nsol, nsno 
+USE VARdSV, only : nsot, nvgt
+
+IMPLICIT NONE
+                                                  
+      INTEGER    :: islpSV(-nsol:0)                                           
+      INTEGER    :: isnpSV(      nsno)                                        
+      INTEGER    :: islmSV(-nsol:0)    
+                                      
+      INTEGER,PARAMETER :: nkhy=50                                            
+      REAL       :: Implic,Explic                                             
+      REAL       :: dzmiSV(-nsol:0)          ! dz_(i-1/2)                     
+      REAL       :: dzi_SV(-nsol:0)          ! dz_(i-1)/(dz_(i)+dz_(i-1))     
+      REAL       :: dziiSV(-nsol:0)          ! dz_(i)  /(dz_(i)+dz_(i-1))     
+      REAL       :: dtz_SV(-nsol:0)          ! dt / dz                        
+      REAL       :: dz78SV(-nsol:0)          ! 7/8 (dz)                       
+      REAL       :: dz34SV(-nsol:0)          ! 3/4 (dz)                       
+      REAL       :: dz_8SV(-nsol:0)          ! 1/8 (dz)                       
+      REAL       :: dzAvSV(-nsol:0)          ! 1/8dz_(-1)+3/4dz+1/8dz_(+1)    
+      REAL       :: OcndSV                   ! Swab Ocean / Soil Ratio        
+      REAL       :: RF__SV( 0:nvgt,-nsol:0)  ! Root Fraction                  
+      REAL       :: rocsSV( 0:nsot)          ! Soil Contribution to (ro c)_s  
+      REAL       :: etamSV( 0:nsot)          ! Soil Minimum Humidity          
+      REAL       :: s1__SV( 0:nsot)          ! ... X eta**( b+2), DR97(3.36)  
+      REAL       :: s2__SV( 0:nsot)          ! ... X eta**(2b+3), DR97(3.35)  
+      REAL       :: aKdtSV( 0:nsot, 0:nkhy)  ! Khyd=a*eta+b: a * dt           
+      REAL       :: bKdtSV( 0:nsot, 0:nkhy)  ! Khyd=a*eta+b: b * dt           
+
+END MODULE VAR0SV
Index: LMDZ5/trunk/libf/phylmd/sisvat/VAR_SV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VAR_SV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VAR_SV.F90	(revision 1865)
@@ -0,0 +1,18 @@
+MODULE VAR_SV
+
+IMPLICIT NONE
+! +
+! +   LMDZ_SV dims
+! +   ===================
+! +
+!      INTEGER,PARAMETER :: nsol=nsoilmx-1
+!      INTEGER,PARAMETER :: nsno=nsnowmx
+      INTEGER,PARAMETER    :: nsol=10      !8
+      INTEGER,PARAMETER    :: nsno=35
+      INTEGER,PARAMETER :: nb_wri=1
+      INTEGER,SAVE      :: klonv
+!$OMP_THREADPRIVATE(klonv)
+      INTEGER,SAVE      :: knonv
+!$OMP_THREADPRIVATE(knonv)
+
+END MODULE VAR_SV
Index: LMDZ5/trunk/libf/phylmd/sisvat/VARdCP.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VARdCP.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VARdCP.F90	(revision 1865)
@@ -0,0 +1,30 @@
+MODULE VARdCP
+
+IMPLICIT NONE
+! +                  
+!C +--Col de Porte specific Constants                                            
+!C +  ===============================                                            
+                                                                                
+      LOGICAL :: ColPrt                ! Col de Porte Switch               
+                                                                                
+                                                                                
+!C +--Fractions of total solar irradiances in 3 spectral intervals               
+!C +  ------------------------------------------------------------               
+                                                                                
+      REAL, PARAMETER :: Dr_1SN=0.59, Dr_2SN=0.31, Dr_3SN=0.10               
+      REAL, PARAMETER :: Df_1SN=0.95, Df_2SN=0.05, Df_3SN=0.00              
+      REAL, PARAMETER :: Dfc1SN=0.66, Dfc2SN=0.27, Dfc3SN=0.07               
+      REAL :: DirSol,DifSol,TotSol,Clouds                               
+
+!     Dr_1SN,Dr_2SN,Dr_3SN  ! Direct  Radiation                 
+!     Df_1SN,Df_2SN,Df_3SN  ! Diffuse Radiation, Clear  Sky     
+!     Dfc1SN,Dfc2SN,Dfc3SN  ! Diffuse Radiation, Cloudy Sky     
+!C +--DATA - from common block COL DE PORTE                            
+!C +  ====                                                                       
+!c #CP data     ColPrt /.true./                                   
+!                                                                                
+!C +.           0.3--0.8micr.m   0.8--1.5micr.m   1.5--2.8micr.m                 
+!C +            Fractions of total solar irradiance in 3 spectral intervals      
+!C +***        (see Eric Martin Sept. 1996, CROCUS, Subroutine METEO)          
+                                                                                
+END MODULE VARdCP   
Index: LMDZ5/trunk/libf/phylmd/sisvat/VARdSV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VARdSV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VARdSV.F90	(revision 1865)
@@ -0,0 +1,141 @@
+MODULE VARdSV
+
+USE VAR_SV
+
+IMPLICIT NONE
+
+
+! +--SISVAT Global Variables
+! +  =======================
+
+      LOGICAL           ::   INI_SV=.false.          ! Initialisation Switch     
+      REAL,PARAMETER    ::   eps_21=1.e-21           ! Arbitrary  very small value
+
+
+! +--Snow
+! +  ----
+
+      INTEGER,PARAMETER,DIMENSION(5) ::   istdSV(1:5)=(/1,2,3,4,5/)  ! Snow History
+
+      REAL,PARAMETER    ::   Cn_dSV= 2105.           ! Snow Heat Capacity          [J/kg/K]
+      REAL,PARAMETER    ::   SMndSV= 1.00            ! Minimum Thickness of new Layers
+      REAL,PARAMETER    ::   G1_dSV= 99.             ! Conversion 0/99-->0/1 
+      REAL,PARAMETER    ::   DDcdSV= 1.,DFcdSV= 4.,DScdSV= 3.   
+                                                     ! Snow Grains Optical Diameter [1e-4m]
+      REAL,PARAMETER    ::   ADSdSV= 4.              ! Snow Grains Actual  Diameter [1e-4m]
+      REAL,PARAMETER    ::   So1dSV= 0.580,So2dSV= 0.320,So3dSV= 0.100
+                                                     ! Total Solar Irradiance Fractions [-]
+                                                     ! Tuning ETH camp 0.3--0.8mim Interval
+                                                     ! Tuning ETH camp 0.8--1.5mim Interval
+                                                     ! Tuning ETH camp 1.5--2.8mim Interval
+                                                     ! So1dSV=0.606,So2dSV=0.301,So3dSV=0.093
+      REAL,PARAMETER    ::   aI1dSV= 0.40,aI2dSV= 0.45,aI3dSV= 0.65
+                                                     ! Bare Ice Albedo                  [-]
+                                                     ! Minimum/Maximum/ICE lense albedo at 
+                                                     ! 800 kg/m3 and minimum pure snow albedo
+      REAL,PARAMETER    ::   ws0dSV= 0.07            ! Irreducible Water Saturation in Snow
+      REAL,PARAMETER    ::   roCdSV= 800.            ! Pore Hole Close OFF Density  [kg/m3]
+      REAL,PARAMETER    ::   ru_dSV= 200.            ! Surficial Water Scale Factor [kg/m2]
+
+!C +--Ice
+!C +  ---
+
+      REAL,PARAMETER    ::   CdidSV= 2.1
+
+!C +--Vegetation
+!C +  ----------
+
+      INTEGER,PARAMETER ::   nvgt=12
+      REAL,PARAMETER    ::   DH_dSV(0:nvgt) = (/ 0.00, 0.07, 0.21,      &
+     &       0.70, 0.07, 0.21, 0.70, 1.40, 5.60,14.00, 1.40, 5.60,14.00/)
+                                                  ! Displacement            Height   [m]
+
+      REAL,PARAMETER    ::   Z0mdSV(0:nvgt) = (/ 0.01, 0.01, 0.03,      &
+     &       0.10, 0.01, 0.03, 0.10, 0.20, 0.80, 2.00, 0.20, 0.80, 2.00/)
+                                                  ! Roughness  Length for Momentum   [m]
+
+      REAL,PARAMETER    ::   StodSV(0:nvgt) = (/5000.,  50.,  50.,      &
+     &        50.,  50.,  50.,  50.,  10.,  10.,  10.,  10.,  10.,  10./)
+                                                  ! Minimum    Stomatal Resistance [s/m]
+
+      REAL,PARAMETER    ::   PR_dSV(0:nvgt) = (/  0.0,0.5e9,0.5e9,      & 
+     &      0.5e9,0.5e9,0.5e9,0.5e9,1.0e9,1.0e9,1.0e9,1.0e9,1.0e9,1.0e9/)
+                                                  ! Roots Fraction Beta Coefficient  [-]
+
+      REAL,PARAMETER    ::   rbtdSV(0:nvgt) = (/0.000,0.961,0.961,      &
+     &      0.961,0.943,0.964,0.972,0.968,0.962,0.962,0.971,0.976,0.976/)
+
+!        /0.00,  0.01,5000.,   0.0,   0.000,      !  0 NO     VEGETATION
+!         0.07,  0.01,  50.,   0.5e9, 0.961,      !  1 CROPS      LOW
+!         0.21,  0.03,  50.,   0.5e9, 0.961,      !  2 CROPS      MEDIUM
+!         0.70,  0.10,  50.,   0.5e9, 0.961,      !  3 CROPS      HIGH
+!         0.07,  0.01,  50.,   0.5e9, 0.943,      !  4 GRASS      LOW
+!         0.21,  0.03,  50.,   0.5e9, 0.964,      !  5 GRASS      MEDIUM
+!         0.70,  0.10,  50.,   0.5e9, 0.972,      !  6 GRASS      HIGH
+!         1.40,  0.20,  10.,   1.0e9, 0.968,      !  7 BROADLEAF  LOW
+!         5.60,  0.80,  10.,   1.0e9, 0.962,      !  8 BROADLEAF  MEDIUM
+!        14.00,  2.00,  10.,   1.0e9, 0.962,      !  9 BROADLEAF  HIGH
+!         1.40,  0.20,  10.,   1.0e9, 0.971,      ! 10 NEEDLELEAF LOW
+!         5.60,  0.80,  10.,   1.0e9, 0.976,      ! 11 NEEDLELEAF MEDIUM
+!        14.00,  2.00,  10.,   1.0e9, 0.976/      ! 12 NEEDLELEAF HIGH
+
+                                                  ! Internal Plant      Resistance   [s]
+      REAL,PARAMETER    ::   pscdSV = 250.        ! Critical Leaf Water Potential    [m]
+      REAL,PARAMETER    ::   StxdSV = 5000.       ! maXimum  Stomatal   Resistance [s/m]
+      REAL,PARAMETER    ::   LAIdSV = 4.          ! maximum  LAI
+
+
+!C +--Soil
+!C +  ----
+
+      REAL,PARAMETER    ::   rcwdSV = 4.180e+6    ! Density * Water Specific Heat
+      REAL              ::   dz_dSV(-nsol:0)      ! Vertical  Discretization MARSV:
+                                                  !/0.72,0.20,0.060,0.019,0.001/ 
+                                                  ! Layer's Thickness
+      REAL              ::   zz_dSV               ! Soil      Thickness
+
+      INTEGER,PARAMETER ::   nsot=12
+      REAL,PARAMETER    ::   etadSV(0:nsot) = (/ 1.000,0.395,0.410,     &
+     &     0.435,0.485,0.451,0.420,0.477,0.476,0.426,0.492,0.482,0.001 /)      
+                                                  ! Water Content at Saturation  [m3/m3]
+
+      REAL,PARAMETER    ::   psidSV(0:nsot) = (/ 1.000,0.121,0.090,     &
+     &     0.218,0.786,0.478,0.299,0.356,0.630,0.153,0.490,0.405,0.001 /)
+                                                  ! Water Succion at Saturation      [m]
+
+      REAL,PARAMETER    ::   Ks_dSV(0:nsot) = (/ 0.e00, 176.0e-6,       &
+     &          156.3e-6,  34.1e-6,   7.2e-6,   7.0e-6,   6.3e-6,       &
+     &            1.7e-6,   2.5e-6,   2.2e-6,   1.0e-6,   1.3e-6,0.0e0 /)
+                                                  ! Hydraulic Conductivity
+                                                  !               at Saturation    [m/s]
+      REAL,PARAMETER    ::   bCHdSV(0:nsot) = (/ 1.00, 4.05, 4.38,      &
+     &      4.90, 5.30, 5.39, 7.12, 7.75, 8.52,10.40,10.40,11.40, 0.02 /)
+                                                  ! Clapp-Hornberger Coefficient b   [-]
+
+ !     etadSV,   psidSV,   Ks_dSV    bCHdSV  
+ !     /1.000,    1.000,   0.0e00,     1.00,      !  0 WATER
+ !      0.395,    0.121, 176.0e-6,     4.05,      !  1 SAND
+ !      0.410,    0.090, 156.3e-6,     4.38,      !  2 LOAMY      SAND
+ !      0.435,    0.218,  34.1e-6,     4.90,      !  3 SANDY      LOAM
+ !      0.485,    0.786,   7.2e-6,     5.30,      !  4 SILT       LOAM
+ !      0.451,    0.478,   7.0e-6,     5.39,      !  5            LOAM
+ !      0.420,    0.299,   6.3e-6,     7.12,      !  6 SANDY CLAY LOAM
+ !      0.477,    0.356,   1.7e-6,     7.75,      !  7 SILTY CLAY LOAM 
+ !      0.476,    0.630,   2.5e-6,     8.52,      !  8       CLAY LOAM
+ !      0.426,    0.153,   2.2e-6,    10.40,      !  9 SANDY CLAY
+ !      0.492,    0.490,   1.0e-6,    10.40,      ! 10 SILTY CLAY
+ !      0.482,    0.405,   1.3e-6,    11.40,      ! 11       CLAY
+ !      0.001,    0.001,   0.0e00,     0.02/      ! 12       ICE 
+
+
+!C +--Water Bodies
+!C +  ------------
+
+      REAL,PARAMETER    ::   vK_dSV = 1000.       ! Diffusivity in Water          [m2/s]
+      REAL,PARAMETER    ::   TSIdSV = 0.50        ! Sea-Ice Fraction: SST Scale      [K]
+
+      INTEGER ::  ivg1,iso1  !rajout hjp for ini - check if ivg,iso is possible
+
+!
+
+END MODULE VARdSV
Index: LMDZ5/trunk/libf/phylmd/sisvat/VARlSV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VARlSV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VARlSV.F90	(revision 1865)
@@ -0,0 +1,11 @@
+MODULE VARlSV
+
+IMPLICIT NONE
+                                                                                
+! +  ==========                                                                 
+! +--MARlSV.inc                                                                 
+! +  ==========                                                                 
+                                                                                
+      LOGICAL :: iniIRs,iniOUT                           
+                                                                                
+END MODULE VARlSV
Index: LMDZ5/trunk/libf/phylmd/sisvat/VARphy.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VARphy.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VARphy.F90	(revision 1865)
@@ -0,0 +1,106 @@
+MODULE VARphy
+
+IMPLICIT NONE
+
+! MAR Constants
+                                                                              
+      CHARACTER(LEN=1), PARAMETER :: labnum(0:9) =                            &
+              (/'0','1','2','3','4','5','6','7','8','9'/)             
+!C +...                labnum: Alphanumeric Character                          
+                                                                               
+      INTEGER, PARAMETER ::  izr=0,iun=1                                             
+      REAL, PARAMETER    ::  zero = 0.0e+0, demi = 0.5e+0, unun = 1.0e+0,     &
+     &                       epsi = 1.0e-6, eps9 = 1.0e-9, eps12= 1.0e-12,    &
+     &                       third=1/3,     thous=1.e3             
+      REAL               ::  argmin,argmax      !hj valeurs??
+!C +...                    zero = 0.0e+0                                       
+!C +                            demi = 0.5e+0                                 
+!C +                                 unun = 1.0e+0                             
+!C +                                      epsi = 1.0e-6                        
+!C +                                           eps9 = 1.0e-9                   
+!C +                                                eps12= 1.0e-12             
+!C +                                                      third=1/3            
+!C +                                                            thous=1.e3     
+!C +                       argmin:        Function exp(x) Minimum Argument     
+!C +                              argmax: Function exp(x) Maximum Argument     
+!C +                                      (Min/Max are Machine Dependant)      
+                                                                              
+      REAL, PARAMETER    ::  pi = 3.141592653589793238462643e0,               &
+     &                       degrad = pi / 180.d0, hourad = pi /  12.d0 
+!C +...                pi    = 3.141592653589793238462643e0                   
+!C +                   degrad= pi / 180.d0                                     
+!C +                   hourad= pi /  12.d0                                    
+                                                                               
+      REAL, PARAMETER    ::  earthr = 6371.229e+3, earthv = 729.217e-7,       &
+     &                       gravit = 9.81e0,      gravi2 = gravit**2 ,       &
+     &                       grvinv = 1./gravit                       
+!C +...                earthr: Earth Radius                  =6371.d+3    m    
+!C +...                earthv: Earth Angular Velocity        = 7.29d-5  s-1   
+!C +                   gravit: Earth Gravity Acceleration    = 9.81    m/s2    
+!C +                   gravi2: idem (squared)                                  
+!C +                   grvinv: idem (inverse)                                  
+                                                                              
+      REAL, PARAMETER    ::  akmol = 1.35e-5, vonkar = 0.40e0, A_Turb = 5.8,  &
+     &                       AhTurb = 5.4,    AsTurb = 4.0,    r_Turb = 3.0            
+!C +...                akmol : Air Viscosity                 = 1.35d-5 m2/s   
+!C +                   vonkar: von Karman constant           = 0.4            
+!C +                   A_Turb: Stability  Coefficient Moment = 5.8             
+!C +                   AhTurb: Stability  Coefficient Heat   = 5.4             
+!C +                   AsTurb: Stability  Coefficient BLOW * = 4.0            
+!C +                   r_Turb: Turbulent Diffusivities Ratio K*/Km             
+                                                                              
+!      REAL    ::  RDryAi,cp,CvDrya,racv,cap,pcap,stefan,qv_MIN           
+      REAL, PARAMETER    ::  RDryAi=287.05967, ra=287.05967, cp=1004.708845,  &
+     &                       CvDrya=Cp-RDryAi, racv=RDryAi/CvDryA,            &
+     &                       cap=0.28586e0,    pcap=3.73010e0,                &
+     &                       stefan=5.67e-8,   qv_MIN=3.00e-6          
+      REAL, PARAMETER    ::  RVapor=461.e0,    epsq=3.00e-6, Lv_H2O=2.5008e+6,&
+     &                       Ls_H2O=2.8345e+6, r_LvCp=2490.04,r_LcCp=332.27,  &
+     &                       r_LsCp=2822.31            
+!C +...                RDryAi: perfect gas law constant for dry air (287 J/kg/K) 
+!C +                   ra    : perfect gas law constant for dry air (287 J/kg/K) 
+!C +                   cp    : dry air specific heat at constant p (1004 J/kg/K) 
+!C +                   CvDryA: dry air specific heat at constant V ( 717 J/kg/K) 
+!C +                   racv  = ra / cv      = ra /(cp-ra)                        
+!C +                   cap   = ra / cp                                           
+!C +                   pcap  = 100.[kPa]**cap                                    
+!C +...                RVapor: perfect gas law constant Water Vapor (461 J/kg/K) 
+!C +                   epsq  : Minimum Water Vapor Content    =    3.00d-6 kg/kg 
+!C +                   Lv_H2O: Latent Heat Vaporisation/Water = 2500.00d+3 J/kg  
+!C +                   Ls_H2O: Latent Heat Sublimation /Ice   = 2833.60d+3 J/kg  
+!C +                   r_LvCp [Lv=2500000J/kg]/[Cp=1004J/kg/K]= 2490.04    K/[kg/
+!C +                   r_LvCp [Lc= 333600J/kg]/[Cp=1004J/kg/K]=  332.27    K/[kg/
+!C +                   r_LvCp [Ls=2833600J/kg]/[Cp=1004J/kg/K]= 2822.31    K/[kg/
+!C +                   stefan: Stefan Constant                =    5.67d-8 W/m2/K
+!C +                   qv_MIN: Minimum Specific Humidity      =    3.00d-6 kg/kg 
+                                                                                
+      REAL, PARAMETER    ::  tfrwat=271.20e0,  siclf=302.00e6,cdsice=2.04e0,  &
+     &                       hic0=1.00e0, ro_Wat=1000.00e0, C__Wat=4186.00e0, &
+     &                       fracoh=0.75e0             
+!C +...                tfrwat: Sea-Water freezing Temperature =  271.20d+0 K     
+!C +                   siclf : Sea-Ice Heat of Fusion         =  302.00d+6 J/m3  
+!C +                   cdsice: Sea-Ice Thermal Conductivity   =    2.04d+0 W/mK  
+!C +                   hic0  : Sea-Ice Initial Thickness      =    2.00d+0 m     
+!C +                   ro_Wat: Density       of Water         = 1000.00d+0 kg/m3 
+!C +                   C__Wat: Heat Capacity of Water         = 4186.00d+0 J/kg/K
+!C +                   fracoh: 25% of cooling = Oceanic Heat Flux                
+!C +***                        (Hibler 1984)    (ANTARCTIC Ocean)                
+                                                                                
+      REAL, PARAMETER    ::  ro_Ice=920.e0, cdice=2.10e0                                 
+!C +...                ro_Ice:  Density      of Pure Ice       =  920.00d+0 kg/m3
+!C +                   cdice :  Conductivity of Pure Ice       =    2.51d+0 W/m/K
+                                                                                
+      REAL, PARAMETER    ::  TfSnow=273.15e+0,csnow=2105.00e+0,r0sno=3.00e+1, &
+     &                       blsno=3.30e+2,   Lf_H2O=3.337e+5                          
+!C +...                TfSnow:        Snow melting Temperature=  273.15d+0 K     
+!C +                    csnow:Heat Capacity of Snow             2105      J/kg/K 
+!C +                         (Loth et al. 1993, JGR 98 D6, 2.2.2 2e para p.10453)
+!C +                   r0sno : Fresh  Snow Density                50.00d+0 kg/m3 
+!C +                   blsno : Blowed Snow Density               330.00d+0 kg/m3 
+!C +                   Lf_H2O: Latent Heat of Fusion of Snow  =    3.34d+5 J/kg  
+
+! MAR Constants
+                      
+                                                                                
+
+END MODULE VARphy
Index: LMDZ5/trunk/libf/phylmd/sisvat/VARtSV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VARtSV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VARtSV.F90	(revision 1865)
@@ -0,0 +1,73 @@
+MODULE VARtSV
+
+USE VAR_SV, only : nsol, nsno, klonv
+
+IMPLICIT NONE
+! +
+      INTEGER, PARAMETER      ::   ntaver = 4
+! +
+      REAL,ALLOCATABLE,SAVE                ::   toicSV(:)    ! Snow to ice balance    
+!$OMP THREADPRIVATE(toicSV)
+
+      REAL,ALLOCATABLE,SAVE                ::   dz1_SV(:,:) ! "inverse" layer thicknes
+!$OMP TREADPRIVATE(dz1_SV)
+      REAL,ALLOCATABLE,SAVE                ::   dz2_SV(:,:) ! layer thickness
+!$OMP TREADPRIVATE(dz2_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   Tsf_SV  ! surface temperature !hj12032010
+!$OMP TREADPRIVATE(Tsf_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   TsfnSV  ! new surface temperature 
+!$OMP TREADPRIVATE(TsfnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   AcoHSV, BcoHSV ! coefficients for Enthalpy
+!$OMP TREADPRIVATE(AcoHSV, BcoHSV)                             ! evolution,from atmosphere
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   AcoQSV, BcoQSV ! coefficients for Humidity
+!$OMP TREADPRIVATE( AcoQSV, BcoQSV)                            ! evolution,from atmosphere
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   ps__SV  ! surface pressure 
+!$OMP TREADPRIVATE(ps__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   p1l_SV  ! 1st layer pressure 
+!$OMP TREADPRIVATE(p1l_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   cdH_SV  ! drag coeff Energy (?)
+!$OMP TREADPRIVATE(cdH_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   rsolSV  ! Radiation balance surface
+!$OMP TREADPRIVATE(rsolSV)
+      REAL,SAVE                            ::   lambSV  ! coefficient soil layers
+!$OMP TREADPRIVATE(lambSV)
+
+                                                                   ! #AW 
+      REAL, ALLOCATABLE,SAVE               ::   V__mem(:,:)                         
+!$OMP THREADPRIVATE(V__mem)                                        ! #AW
+      REAL, ALLOCATABLE,SAVE               ::   VVmmem(:)                              
+!$OMP THREADPRIVATE(VVmmem)                                        ! #AH 
+      REAL, ALLOCATABLE,SAVE               ::   T__mem(:,:)                           
+!$OMP THREADPRIVATE(T__mem)                                        ! #AH 
+      REAL, ALLOCATABLE,SAVE               ::   dTmmem(:)                             
+!$OMP THREADPRIVATE(dTmmem)
+        
+CONTAINS
+
+  SUBROUTINE INIT_VARtSV
+  IMPLICIT NONE
+  
+      ALLOCATE(toicSV(klonv))
+
+      ALLOCATE(dz1_SV(klonv,-nsol:nsno))     ! "inverse" layer thicknes
+      ALLOCATE(dz2_SV(klonv,-nsol:nsno))     ! layer thickness
+      ALLOCATE(Tsf_SV(klonv))                ! surface temperature !hj12032010
+      ALLOCATE(TsfnSV(klonv))                ! new surface temperature 
+      ALLOCATE(AcoHSV(klonv), BcoHSV(klonv)) ! coefficients for Enthalpy
+                                             ! evolution,from atmosphere
+      ALLOCATE(AcoQSV(klonv), BcoQSV(klonv)) ! coefficients for Humidity
+                                             ! evolution,from atmosphere
+      ALLOCATE(ps__SV(klonv))                ! surface pressure 
+      ALLOCATE(p1l_SV(klonv))                ! 1st layer pressure 
+      ALLOCATE(cdH_SV(klonv))                ! drag coeff Energy (?)
+      ALLOCATE(rsolSV(klonv))                ! Radiation balance surface
+
+                                                                   ! #AW
+      ALLOCATE(V__mem(klonv,ntaver))                               ! #AW
+      ALLOCATE(VVmmem(klonv))                                      ! #AH
+      ALLOCATE(T__mem(klonv,ntaver))                               ! #AH
+      ALLOCATE(dTmmem(klonv))
+  END SUBROUTINE INIT_VARtSV
+
+END MODULE VARtSV
+
Index: LMDZ5/trunk/libf/phylmd/sisvat/VARxSV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VARxSV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VARxSV.F90	(revision 1865)
@@ -0,0 +1,365 @@
+MODULE VARxSV                      
+
+USE VAR_SV, only : klonv, nsol, nsno, nb_wri
+                                                          
+IMPLICIT NONE                                                                                
+! +--SISVAT INPUT        Variables                                              
+! +  -----------------------------                                              
+  
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   LSmask  ! Land-Sea   Mask                 
+!$OMP TREADPRIVATE(LSmask)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   isotSV  ! Soil       Type                 
+!$OMP TREADPRIVATE(isotSV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   iWaFSV  ! Soil       Drainage:(1,0)=(y,n) 
+!$OMP TREADPRIVATE(iWaFSV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   ivgtSV  ! Vegetation Type                 
+!$OMP TREADPRIVATE(ivgtSV)
+                                                                              
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   coszSV  ! Cosine of Sun zenithal Angle    
+!$OMP TREADPRIVATE(coszSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   sol_SV  ! Downward  Solar    Radiation    
+!$OMP TREADPRIVATE(sol_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   IRd_SV  ! Downward  Longwave Radiation    
+!$OMP TREADPRIVATE(IRd_SV)
+                                                                                
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   drr_SV  ! Rain  Intensity       [kg/m2/s] 
+!$OMP TREADPRIVATE(drr_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dsn_SV  ! Snow  Intensity       [kg/m2/s] 
+!$OMP TREADPRIVATE(dsn_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dsnbSV  ! Idem, fraction, from Drift  [-] 
+!$OMP TREADPRIVATE(dsnbSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   esnbSV  ! Idem, fraction, from Drift  [-]
+!$OMP TREADPRIVATE(esnbSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dbs_SV  ! Drift Amount            [kg/m2] 
+!$OMP TREADPRIVATE(dbs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BrosSV  ! Buffer Snow Layer Density
+!$OMP TREADPRIVATE(BrosSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BG1sSV  ! Buffer Snow Layer Dendr/Sphe[-]
+!$OMP TREADPRIVATE(BG1sSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BG2sSV  ! Buffer Snow Layer Spher/Size[-][0.0001m]
+!$OMP TREADPRIVATE(BG2sSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dz0_SV  ! dz0(Sastrugi dh)            [m] 
+!$OMP TREADPRIVATE(dz0_SV)
+                                                                               
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   cld_SV  ! Cloudiness (seen from SBL)      
+!$OMP TREADPRIVATE(cld_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   za__SV  ! SBL Height                      
+!$OMP TREADPRIVATE(za__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   VV__SV  !(SBL Top)  Wind Velocity         
+!$OMP TREADPRIVATE(VV__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   VVs_SV  !(Sastr,V)  Relevance
+!$OMP TREADPRIVATE(VVs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   RRs_SV  !(Sastr,V)  Counter
+!$OMP TREADPRIVATE(RRs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   DDs_SV  !(Sastr,V)  Angle
+!$OMP TREADPRIVATE(DDs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   TaT_SV  ! SBL Top   Temperature           
+!$OMP TREADPRIVATE(TaT_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   ExnrSV  ! Exner     Potential             
+!$OMP TREADPRIVATE(ExnrSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dSdTSV  ! Sensible Heat Flux T Derivat.   
+!$OMP TREADPRIVATE(dSdTSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dLdTSV  ! Latent   Heat Flux T Derivat.   
+!$OMP TREADPRIVATE(dLdTSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rhT_SV  ! SBL Top   Air  Density          
+!$OMP TREADPRIVATE(rhT_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   QaT_SV  ! SBL Top   Specific Humidity     
+!$OMP TREADPRIVATE(QaT_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dQa_SV  ! SBL Flux  Limitation of Qa      
+!$OMP TREADPRIVATE(dQa_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   qsnoSV  ! SBL Mean  Snow       Content    
+!$OMP TREADPRIVATE(qsnoSV)
+                                                                            
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   LAI0SV  ! Nominal Leaf Area Index         
+!$OMP TREADPRIVATE(LAI0SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   glf0SV  ! Green   Leaf Fraction           
+!$OMP TREADPRIVATE(glf0SV)
+                                                                               
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   alb0SV  ! Soil    Albedo                  
+!$OMP TREADPRIVATE(alb0SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   slopSV  ! Snow/Ice/Soil-Water Surf. Slope 
+!$OMP TREADPRIVATE(slopSV)
+
+                                                              
+      REAL,SAVE                      ::   zSBLSV  ! SBL Height (Initial Value)      
+!$OMP TREADPRIVATE(zSBLSV)
+      REAL,SAVE                      ::   dt__SV  ! Time Step                       
+!$OMP TREADPRIVATE(dt__SV)
+      CHARACTER (len=18),SAVE        ::   daHost  ! Date Host Model                 
+!$OMP TREADPRIVATE(daHost)
+                                                                               
+                                                                               
+! +--SISVAT INPUT/OUTPUT Variables                                             
+! +  -----------------------------                                             
+                                                                               
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   isnoSV  ! Nb of Ice/Snow Layers           
+!$OMP TREADPRIVATE(isnoSV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   ispiSV  ! Uppermost superimposed ice      
+!$OMP TREADPRIVATE(ispiSV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   iiceSV  ! Nb of Ice      Layers           
+!$OMP TREADPRIVATE(iiceSV)
+      INTEGER ,ALLOCATABLE,SAVE    ::   istoSV(:,:)  ! Snow Layer     History          
+!$OMP TREADPRIVATE(istoSV)
+                                                                               
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   alb_SV  ! Surface-Canopy Albedo           
+!$OMP TREADPRIVATE(alb_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   emi_SV  ! Surface-Canopy Emissivity       
+!$OMP TREADPRIVATE(emi_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   IRs_SV  ! Soil           IR Flux          
+!$OMP TREADPRIVATE(IRs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   LMO_SV  ! Monin-Obukhov  Scale            
+!$OMP TREADPRIVATE(LMO_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   us__SV  ! Friction       Velocity         
+!$OMP TREADPRIVATE(us__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   uts_SV  ! Temperature Turbulent Scale     
+!$OMP TREADPRIVATE(uts_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   cutsSV  ! Temperature Turbulent Scale C.  
+!$OMP TREADPRIVATE(cutsSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   uqs_SV  ! Spec.Humid. Turbulent Scale     
+!$OMP TREADPRIVATE(uqs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   uss_SV  ! Blow.Snow   Turbulent Scale     
+!$OMP TREADPRIVATE(uss_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   usthSV  ! Blowing Snow Erosion Thresh.    
+!$OMP TREADPRIVATE(usthSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rCDmSV  ! Square  Root Contribut. Drag_m  
+!$OMP TREADPRIVATE(rCDmSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rCDhSV  ! Square  Root Contribut. Drag_h  
+!$OMP TREADPRIVATE(rCDhSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0m_SV  ! Momentum     Roughness Length   
+!$OMP TREADPRIVATE(Z0m_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0mmSV  !  z0(Momentum,    Time Mean) [m] 
+!$OMP TREADPRIVATE(Z0mmSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0mnSV  !  z0(Momentum,    instanta.) [m] 
+!$OMP TREADPRIVATE(Z0mnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0roSV  ! Subgrid Topo Roughness Length   
+!$OMP TREADPRIVATE(Z0roSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0SaSV  !  z0(Sastrugi  h)            [m] 
+!$OMP TREADPRIVATE(Z0SaSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0e_SV  !  z0(Snow eroded)            [m] 
+!$OMP TREADPRIVATE(Z0e_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0emSV  !  z0(Snow eroded, Time Mean) [m] 
+!$OMP TREADPRIVATE(Z0emSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0enSV  !  z0(Snow eroded, instanta.) [m] 
+!$OMP TREADPRIVATE(Z0enSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0h_SV  ! Heat         Roughness Length   
+!$OMP TREADPRIVATE(Z0h_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0hmSV  !  z0(Heat,        Time Mean) [m] 
+!$OMP TREADPRIVATE(Z0hmSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0hnSV  !  z0(Heat,        instanta.) [m] 
+!$OMP TREADPRIVATE(Z0hnSV)
+                                                                          
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   snCaSV  ! Canopy  Snow   Thickness        
+!$OMP TREADPRIVATE(snCaSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rrCaSV  ! Canopy  Water  Content          
+!$OMP TREADPRIVATE(rrCaSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   psivSV  ! Leaf    Water  Potential        
+!$OMP TREADPRIVATE(psivSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   TvegSV  ! Vegetation     Temperature      
+!$OMP TREADPRIVATE(TvegSV)
+                                                                        
+      REAL ,ALLOCATABLE,SAVE   ::   TsisSV(:,:)  ! Snow/Ice/Soil-Water Temperature 
+!$OMP TREADPRIVATE(TsisSV)
+      REAL ,ALLOCATABLE,SAVE   ::   ro__SV(:,:)  ! Snow/Ice/Soil-Water VolumicMass 
+!$OMP TREADPRIVATE(ro__SV)
+      REAL,ALLOCATABLE,SAVE    ::   eta_SV(:,:)  ! Snow/Ice/Soil     Water Content 
+!$OMP TREADPRIVATE(eta_SV)
+      REAL,ALLOCATABLE,SAVE    ::   G1snSV(:,:)  ! Snow Dendricity/Sphericity      
+!$OMP TREADPRIVATE(G1snSV)
+      REAL,ALLOCATABLE,SAVE    ::   G2snSV(:,:)  ! Snow Sphericity/Size            
+!$OMP TREADPRIVATE(G2snSV)
+      REAL,ALLOCATABLE,SAVE    ::   dzsnSV(:,:)  ! Snow Layer  Thickness           
+!$OMP TREADPRIVATE(dzsnSV)
+      REAL,ALLOCATABLE,SAVE    ::   agsnSV(:,:)  ! Snow Age                        
+!$OMP TREADPRIVATE(agsnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BufsSV  ! Snow Buffer Layer               
+!$OMP TREADPRIVATE(BufsSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rusnSV  ! Surficial   Water               
+!$OMP TREADPRIVATE(rusnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   SWf_SV  ! Normalized  Decay               
+!$OMP TREADPRIVATE(SWf_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   SWS_SV  ! Surficial Water Status          
+!$OMP TREADPRIVATE(SWS_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   HFraSV  ! Frazil      Thickness           
+!$OMP TREADPRIVATE(HFraSV)
+                                                                            
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   zWE_SV  ! Current   Snow Thickness [mmWE] 
+!$OMP TREADPRIVATE(zWE_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   zWEcSV  ! Compacted Snow Thickness [mmWE] 
+!$OMP TREADPRIVATE(zWEcSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   wem_SV  ! Only Melting             [mmWE] 
+!$OMP TREADPRIVATE(wem_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   wer_SV  ! Refreezing               [mmWE] 
+!$OMP TREADPRIVATE(wer_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   wes_SV  ! Sublimation              [mmWE] 
+!$OMP TREADPRIVATE(wes_SV)
+                                                                             
+                                                                              
+! +--SISVAT OUTPUT       Variables                                            
+! +  -----------------------------                                            
+                                                                               
+      INTEGER,DIMENSION(nb_wri),SAVE ::   no__SV  ! OUTPUT file Unit Number         
+!$OMP TREADPRIVATE(no__SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   i___SV  ! OUTPUT point   i Coordinate    
+!$OMP TREADPRIVATE(i___SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   j___SV  ! OUTPUT point   j Coordinate     
+!$OMP TREADPRIVATE(j___SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   n___SV  ! OUTPUT point   n Coordinate     
+!$OMP TREADPRIVATE(n___SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   lwriSV  ! OUTPUT point vec Index          
+!$OMP TREADPRIVATE(lwriSV)
+!                                                                              
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   ii__SV  ! WORK   point   i Coordinate     
+!$OMP TREADPRIVATE(ii__SV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   jj__SV  ! WORK   point   j Coordinate     
+!$OMP TREADPRIVATE(jj__SV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   nn__SV  ! WORK   point   n Coordinate     
+!$OMP TREADPRIVATE(nn__SV)
+                                                                               
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   IRu_SV  ! UPward    IR Flux (effective)   
+!$OMP TREADPRIVATE(IRu_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   hSalSV  ! Saltating Layer Height          
+!$OMP TREADPRIVATE(hSalSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   qSalSV  ! Saltating Snow  Concentration   
+!$OMP TREADPRIVATE(qSalSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   RnofSV  ! RunOFF    Intensity             
+!$OMP TREADPRIVATE(RnofSV)
+                  
+CONTAINS
+
+
+
+  SUBROUTINE INIT_VARxSV
+  IMPLICIT NONE
+
+      INTEGER                                :: ikl
+
+      ALLOCATE(LSmask(klonv))  ! Land-Sea   Mask                 
+      ALLOCATE(isotSV(klonv))  ! Soil       Type                 
+      ALLOCATE(iWaFSV(klonv))  ! Soil       Drainage:(1,0)=(y,n) 
+      ALLOCATE(ivgtSV(klonv))  ! Vegetation Type                 
+                                                                              
+      ALLOCATE(coszSV(klonv))  ! Cosine of Sun zenithal Angle    
+      ALLOCATE(sol_SV(klonv))  ! Downward  Solar    Radiation    
+      ALLOCATE(IRd_SV(klonv))  ! Downward  Longwave Radiation    
+                                                                                
+      ALLOCATE(drr_SV(klonv))  ! Rain  Intensity       [kg/m2/s] 
+      ALLOCATE(dsn_SV(klonv))  ! Snow  Intensity       [kg/m2/s] 
+      ALLOCATE(dsnbSV(klonv))  ! Idem, from Drift        [kg/m2] 
+      ALLOCATE(esnbSV(klonv))  ! Idem, from Drift        [kg/m2] 
+      ALLOCATE(dbs_SV(klonv))  ! Drift Amount            [kg/m2] 
+      ALLOCATE(BrosSV(klonv))
+      ALLOCATE(BG1sSV(klonv))          
+      ALLOCATE(BG2sSV(klonv))
+      ALLOCATE(dz0_SV(klonv))  ! dz0(Sastrugi dh)            [m] 
+                                                                               
+      ALLOCATE(cld_SV(klonv))  ! Cloudiness (seen from SBL)      
+      ALLOCATE(za__SV(klonv))  ! SBL Height                      
+      ALLOCATE(VV__SV(klonv))  !(SBL Top)  Wind Velocity         
+      ALLOCATE(VVs_SV(klonv))
+      ALLOCATE(RRs_SV(klonv))
+      ALLOCATE(DDs_SV(klonv))
+      ALLOCATE(TaT_SV(klonv))  ! SBL Top   Temperature           
+      ALLOCATE(ExnrSV(klonv))  ! Exner     Potential             
+      ALLOCATE(dSdTSV(klonv))  ! Sensible Heat Flux T Derivat.   
+      ALLOCATE(dLdTSV(klonv))  ! Latent   Heat Flux T Derivat.   
+      ALLOCATE(rhT_SV(klonv))  ! SBL Top   Air  Density          
+      ALLOCATE(QaT_SV(klonv))  ! SBL Top   Specific Humidity     
+      ALLOCATE(dQa_SV(klonv))  ! SBL Flux  Limitation of Qa      
+      ALLOCATE(qsnoSV(klonv))  ! SBL Mean  Snow       Content    
+                                                                            
+      ALLOCATE(LAI0SV(klonv))  ! Nominal Leaf Area Index         
+      ALLOCATE(glf0SV(klonv))  ! Green   Leaf Fraction           
+                                                                               
+      ALLOCATE(alb0SV(klonv))  ! Soil    Albedo                  
+      ALLOCATE(slopSV(klonv))  ! Snow/Ice/Soil-Water Surf. Slope 
+
+                                                                               
+                                                                               
+! +--SISVAT INPUT/OUTPUT Variables                                             
+! +  -----------------------------                                             
+                                                                               
+      ALLOCATE(isnoSV(klonv))  ! Nb of Ice/Snow Layers           
+      ALLOCATE(ispiSV(klonv))  ! Uppermost superimposed ice      
+      ALLOCATE(iiceSV(klonv))  ! Nb of Ice      Layers           
+      ALLOCATE(istoSV(klonv,0:nsno))  ! Snow Layer     History          
+                                                                               
+      ALLOCATE(alb_SV(klonv))  ! Surface-Canopy Albedo           
+      ALLOCATE(emi_SV(klonv))  ! Surface-Canopy Emissivity       
+      ALLOCATE(IRs_SV(klonv))  ! Soil           IR Flux          
+      ALLOCATE(LMO_SV(klonv))  ! Monin-Obukhov  Scale            
+      ALLOCATE(us__SV(klonv))  ! Friction       Velocity         
+      ALLOCATE(uts_SV(klonv))  ! Temperature Turbulent Scale     
+      ALLOCATE(cutsSV(klonv))  ! Temperature Turbulent Scale C.  
+      ALLOCATE(uqs_SV(klonv))  ! Spec.Humid. Turbulent Scale     
+      ALLOCATE(uss_SV(klonv))  ! Blow.Snow   Turbulent Scale     
+      ALLOCATE(usthSV(klonv))  ! Blowing Snow Erosion Thresh.    
+      ALLOCATE(rCDmSV(klonv))  ! Square  Root Contribut. Drag_m  
+      ALLOCATE(rCDhSV(klonv))  ! Square  Root Contribut. Drag_h  
+      ALLOCATE(Z0m_SV(klonv))  ! Momentum     Roughness Length   
+      ALLOCATE(Z0mmSV(klonv))  !  z0(Momentum,    Time Mean) [m] 
+      ALLOCATE(Z0mnSV(klonv))  !  z0(Momentum,    instanta.) [m] 
+      ALLOCATE(Z0roSV(klonv))  ! Subgrid Topo Roughness Length   
+      ALLOCATE(Z0SaSV(klonv))  !  z0(Sastrugi  h)            [m] 
+      ALLOCATE(Z0e_SV(klonv))  !  z0(Snow eroded)            [m] 
+      ALLOCATE(Z0emSV(klonv))  !  z0(Snow eroded, Time Mean) [m] 
+      ALLOCATE(Z0enSV(klonv))  !  z0(Snow eroded, instanta.) [m] 
+      ALLOCATE(Z0h_SV(klonv))  ! Heat         Roughness Length   
+      ALLOCATE(Z0hmSV(klonv))  !  z0(Heat,        Time Mean) [m] 
+      ALLOCATE(Z0hnSV(klonv))  !  z0(Heat,        instanta.) [m] 
+                                                                          
+      ALLOCATE(snCaSV(klonv))  ! Canopy  Snow   Thickness        
+      ALLOCATE(rrCaSV(klonv))  ! Canopy  Water  Content          
+      ALLOCATE(psivSV(klonv))  ! Leaf    Water  Potential        
+      ALLOCATE(TvegSV(klonv)) ! Vegetation     Temperature      
+                                                                        
+      ALLOCATE(TsisSV(klonv,-nsol:nsno))  ! Snow/Ice/Soil-Water Temperature 
+      ALLOCATE(ro__SV(klonv,-nsol:nsno))  ! Snow/Ice/Soil-Water VolumicMass 
+      ALLOCATE(eta_SV(klonv,-nsol:nsno))  ! Snow/Ice/Soil     Water Content 
+      ALLOCATE(G1snSV(klonv,    0:nsno))  ! Snow Dendricity/Sphericity      
+      ALLOCATE(G2snSV(klonv,    0:nsno))  ! Snow Sphericity/Size            
+      ALLOCATE(dzsnSV(klonv,    0:nsno))  ! Snow Layer  Thickness           
+      ALLOCATE(agsnSV(klonv,    0:nsno))  ! Snow Age                        
+      ALLOCATE(BufsSV(klonv))  ! Snow Buffer Layer               
+      ALLOCATE(rusnSV(klonv))  ! Surficial   Water               
+      ALLOCATE(SWf_SV(klonv))  ! Normalized  Decay               
+      ALLOCATE(SWS_SV(klonv))  ! Surficial Water Status          
+      ALLOCATE(HFraSV(klonv))  ! Frazil      Thickness           
+                                                                            
+      ALLOCATE(zWE_SV(klonv))  ! Current   Snow Thickness [mmWE] 
+      ALLOCATE(zWEcSV(klonv))  ! Compacted Snow Thickness [mmWE] 
+      ALLOCATE(wem_SV(klonv)) ! Only Melting             [mmWE] 
+      ALLOCATE(wer_SV(klonv)) ! Refreezing               [mmWE] 
+      ALLOCATE(wes_SV(klonv))  ! Sublimation              [mmWE] 
+                                                                             
+                                                                              
+! +--SISVAT OUTPUT       Variables                                            
+! +  -----------------------------                                            
+                                                                               
+!                                                                              
+      ALLOCATE(ii__SV(klonv))  ! WORK   point   i Coordinate     
+      ALLOCATE(jj__SV(klonv))  ! WORK   point   j Coordinate     
+      ALLOCATE(nn__SV(klonv))  ! WORK   point   n Coordinate     
+                                                                               
+      ALLOCATE(IRu_SV(klonv))  ! UPward    IR Flux (effective)   
+      ALLOCATE(hSalSV(klonv))  ! Saltating Layer Height          
+      ALLOCATE(qSalSV(klonv))  ! Saltating Snow  Concentration   
+      ALLOCATE(RnofSV(klonv))  ! RunOFF    Intensity      
+
+      DO ikl=1,klonv        
+        LSmask(ikl)   = 0
+        isotSV(ikl)   = 0                
+        iWaFSV(ikl)   = 0 
+        ivgtSV(ikl)   = 0
+        isnoSV(ikl)   = 0  
+        ispiSV(ikl)   = 0
+        iiceSV(ikl)   = 0          
+        istoSV(ikl,:) = 0
+        ii__SV(ikl)   = 0
+        jj__SV(ikl)   = 0
+        nn__SV(ikl)   = 0 
+      END DO
+  END SUBROUTINE INIT_VARxSV
+
+
+                                               
+END MODULE VARxSV
Index: LMDZ5/trunk/libf/phylmd/sisvat/VARySV.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/VARySV.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/VARySV.F90	(revision 1865)
@@ -0,0 +1,150 @@
+MODULE VARySV
+
+USE VAR_SV, only : klonv, nsol, nsno
+
+
+IMPLICIT NONE
+
+! +
+      INTEGER, DIMENSION(:),SAVE,ALLOCATABLE ::   NLaysv  ! New   Snow     Layer   Switch   
+!$OMP THREADPRIVATE(NLaysv)
+      INTEGER, DIMENSION(:),SAVE,ALLOCATABLE ::   i_thin  ! Index of the thinest Layer      
+!$OMP THREADPRIVATE(i_thin)
+      INTEGER, DIMENSION(:),SAVE,ALLOCATABLE ::   LIndsv  ! Contiguous Layer relative Index
+!$OMP THREADPRIVATE(LIndsv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   albisv  ! Integrated Surface Albedo
+!$OMP THREADPRIVATE(albisv)
+      !hj prelim                                            
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   alb1sv  ! Surface Albedo VIS      
+!$OMP THREADPRIVATE(alb1sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   alb2sv  ! Surface Albedo NIR      
+!$OMP THREADPRIVATE(alb2sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   alb3sv  ! Surface Albedo FIR      
+!$OMP THREADPRIVATE(alb3sv)
+
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   albssv  ! Soil               Albedo [-]   
+!$OMP THREADPRIVATE(albssv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   SoCasv  ! Canopy  Absorbed Solar Radiat.  
+!$OMP THREADPRIVATE(SoCasv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   SoSosv  !? Surface Absorbed Solar Radiat.  
+!$OMP THREADPRIVATE(SoSosv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   IRv_sv  ! Vegetation IR Flux  [W/m2]      
+!$OMP THREADPRIVATE(IRv_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Evg_sv  ! Emissivity of Vegetation+Snow   
+!$OMP THREADPRIVATE(Evg_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Eso_sv  !? Emissivity of       Soil+Snow   
+!$OMP THREADPRIVATE(Eso_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   tau_sv  ! Transmited Radiation Fraction   
+!$OMP THREADPRIVATE(tau_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   rrMxsv  ! Canopy Maximum Intercepted Rain 
+!$OMP THREADPRIVATE(rrMxsv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   LAIesv  ! effective LAI for transpirati.  
+!$OMP THREADPRIVATE(LAIesv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   LAI_sv  ! corrected LAI in case of snow   
+!$OMP THREADPRIVATE(LAI_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   glf_sv  ! Green  Leaf Fraction            
+!$OMP THREADPRIVATE(glf_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Sigmsv  ! Canopy Ventilation  Factor      
+!$OMP THREADPRIVATE(Sigmsv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   HSv_sv  ! Sensible Heat Flux  [W/m2]      
+!$OMP THREADPRIVATE(HSv_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   HLv_sv  ! Latent   Heat Flux  [W/m2]      
+!$OMP THREADPRIVATE(HLv_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   HSs_sv  !? Sensible Heat Flux (t)          
+!$OMP THREADPRIVATE(HSs_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   HLs_sv  !? Latent   Heat Flux (t)          
+!$OMP THREADPRIVATE(HLs_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   sqrCm0  ! in Neutral Drag Coef.Moment.    
+!$OMP THREADPRIVATE(sqrCm0)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   sqrCh0  ! in Neutral Drag Coef.Heat       
+!$OMP THREADPRIVATE(sqrCh0)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Lx_H2O  ! Latent Heat of Vaporiz./Sublim. 
+!$OMP THREADPRIVATE(Lx_H2O)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   ram_sv  ! Aerodyn.Resistance (Moment.)    
+!$OMP THREADPRIVATE(ram_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   rah_sv  ! Aerodyn.Resistance (Heat)       
+!$OMP THREADPRIVATE(rah_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Fh__sv  ! Stability Function              
+!$OMP THREADPRIVATE(Fh__sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   dFh_sv  ! Stability Function (Deriv.)     
+!$OMP THREADPRIVATE(dFh_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Evp_sv  !x Evaporation        [kg/m2]      
+!$OMP THREADPRIVATE(Evp_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   EvT_sv  !x Evapotranspiration [kg/m2]      
+!$OMP THREADPRIVATE(EvT_sv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   LSdzsv  ! Land/Sea Vert. Discretiz. Fact. 
+!$OMP THREADPRIVATE(LSdzsv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Tsrfsv  ! Surface    Temperature          
+!$OMP THREADPRIVATE(Tsrfsv)
+      REAL,SAVE,ALLOCATABLE  ::   sEX_sv(:,:)  ! Verticaly Integr.Extinct.Coef.  
+!$OMP THREADPRIVATE(sEX_sv)
+      REAL,SAVE,ALLOCATABLE  ::   zzsnsv(:,:)    ! Snow  Pack Thickness      [m]   
+!$OMP THREADPRIVATE(zzsnsv)
+      REAL,SAVE,ALLOCATABLE  ::   psi_sv(:,:)    ! Soil   Water        Potential   
+!$OMP THREADPRIVATE(psi_sv)
+      REAL,SAVE,ALLOCATABLE  ::   Khydsv(:,:)    ! Soil   Hydraulic    Conductiv.  
+!$OMP THREADPRIVATE(Khydsv)
+      REAL,SAVE,ALLOCATABLE  ::   Rootsv(:,:)       ! Root Water Pump      [kg/m2/s]  
+!$OMP THREADPRIVATE(Rootsv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   EExcsv  ! Energy in Excess, current       
+!$OMP THREADPRIVATE(EExcsv)
+
+CONTAINS
+  SUBROUTINE INIT_VARySV
+  IMPLICIT NONE
+      INTEGER                ::   ikl
+
+      ALLOCATE(NLaysv(klonv))  ! New   Snow     Layer   Switch   
+      ALLOCATE(i_thin(klonv))  ! Index of the thinest Layer      
+      ALLOCATE(LIndsv(klonv))  ! Contiguous Layer relative Index
+      ALLOCATE(albisv(klonv))  ! Integrated Surface Albedo
+      !hj prelim                                            
+      ALLOCATE(alb1sv(klonv))  ! Surface Albedo VIS      
+      ALLOCATE(alb2sv(klonv))  ! Surface Albedo NIR      
+      ALLOCATE(alb3sv(klonv))  ! Surface Albedo FIR       
+
+      !
+      ALLOCATE(albssv(klonv))  ! Soil               Albedo [-]   
+      ALLOCATE(SoCasv(klonv))  ! Canopy  Absorbed Solar Radiat.  
+      ALLOCATE(SoSosv(klonv))  !? Surface Absorbed Solar Radiat.  
+      ALLOCATE(IRv_sv(klonv))  ! Vegetation IR Flux  [W/m2]      
+      ALLOCATE(Evg_sv(klonv))  ! Emissivity of Vegetation+Snow   
+      ALLOCATE(Eso_sv(klonv))  !? Emissivity of       Soil+Snow   
+      ALLOCATE(tau_sv(klonv))  ! Transmited Radiation Fraction   
+      ALLOCATE(rrMxsv(klonv))  ! Canopy Maximum Intercepted Rain 
+      ALLOCATE(LAIesv(klonv))  ! effective LAI for transpirati.  
+      ALLOCATE(LAI_sv(klonv))  ! corrected LAI in case of snow   
+      ALLOCATE(glf_sv(klonv))  ! Green  Leaf Fraction            
+      ALLOCATE(Sigmsv(klonv))  ! Canopy Ventilation  Factor      
+      ALLOCATE(HSv_sv(klonv))  ! Sensible Heat Flux  [W/m2]      
+      ALLOCATE(HLv_sv(klonv))  ! Latent   Heat Flux  [W/m2]      
+      ALLOCATE(HSs_sv(klonv))  !? Sensible Heat Flux (t)          
+      ALLOCATE(HLs_sv(klonv))  !? Latent   Heat Flux (t)          
+      ALLOCATE(sqrCm0(klonv))  ! in Neutral Drag Coef.Moment.    
+      ALLOCATE(sqrCh0(klonv))  ! in Neutral Drag Coef.Heat       
+      ALLOCATE(Lx_H2O(klonv))  ! Latent Heat of Vaporiz./Sublim. 
+      ALLOCATE(ram_sv(klonv))  ! Aerodyn.Resistance (Moment.)    
+      ALLOCATE(rah_sv(klonv))  ! Aerodyn.Resistance (Heat)       
+      ALLOCATE(Fh__sv(klonv))  ! Stability Function              
+      ALLOCATE(dFh_sv(klonv))  ! Stability Function (Deriv.)     
+      ALLOCATE(Evp_sv(klonv))  !x Evaporation        [kg/m2]      
+      ALLOCATE(EvT_sv(klonv))  !x Evapotranspiration [kg/m2]      
+      ALLOCATE(LSdzsv(klonv))  ! Land/Sea Vert. Discretiz. Fact. 
+      ALLOCATE(Tsrfsv(klonv))  ! Surface    Temperature          
+      ALLOCATE(sEX_sv(klonv,-nsol:nsno+1))  ! Verticaly Integr.Extinct.Coef.  
+      ALLOCATE(zzsnsv(klonv,    0:nsno))    ! Snow  Pack Thickness      [m]   
+      ALLOCATE(psi_sv(klonv,-nsol:0   ))    ! Soil   Water        Potential   
+      ALLOCATE(Khydsv(klonv,-nsol:0   ))    ! Soil   Hydraulic    Conductiv.  
+      ALLOCATE(Rootsv(klonv,-nsol:0))       ! Root Water Pump      [kg/m2/s]  
+      ALLOCATE(EExcsv(klonv))  ! Energy in Excess, current         
+
+      DO ikl=1,klonv
+        NLaysv(ikl)   = 0
+        i_thin(ikl)   = 0
+        LIndsv(ikl)   = 0
+      END DO
+
+  END SUBROUTINE INIT_VARySV
+
+END MODULE VARySV
+
Index: LMDZ5/trunk/libf/phylmd/sisvat/YOMCST.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/YOMCST.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/YOMCST.F90	(revision 1865)
@@ -0,0 +1,59 @@
+MODULE YOMCST
+
+IMPLICIT NONE
+                !
+! $Header$
+!
+!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
+!                 veillez à n'utiliser que des ! pour les commentaires
+!                 et à bien positionner les & des lignes de continuation
+!                 (les placer en colonne 6 et en colonne 73)
+!
+!
+! A1.0 Fundamental constants
+      REAL,PARAMETER :: RPI=3.141592653589793238462643e0,               &
+     &                  RCLUM=299792458.,   RHPLA=6.6260755E-34,        &
+     &                  RKBOL=1.380658E-23, RNAVO=6.0221367E+23
+
+! A1.1 Astronomical constants
+      REAL,PARAMETER :: RDAY=86400.,REA=149597870000.,REPSM=0.409093,   &
+     &        RSIYEA=365.25*RDAY*2.*RPI/6.283076,                       &
+     &        RSIDAY=RDAY/(1.+RDAY/RSIYEA), ROMEGA=2.*RPI/RSIDAY
+
+! A1.1.bis Constantes concernant l'orbite de la Terre:
+      REAL,PARAMETER :: R_ecc=0.016715,R_peri=102.7,R_incl=23.441
+
+! A1.2 Geoide
+      REAL,PARAMETER :: RG=9.80665, RA=6371229.,R1SA=1.D0/RA
+
+! A1.3 Radiation
+      REAL,PARAMETER :: RSIGMA = 2.*RPI**5 * (RKBOL/RHPLA)**3           &
+     &                   * RKBOL/RCLUM/RCLUM/15.
+!     REAL RSIGMA,RI0
+
+! A1.4 Thermodynamic gas phase
+      REAL,PARAMETER :: R=RNAVO*RKBOL, RMD=28.9644,    RMO3=47.9942,    &
+     &                  RMV=18.0153,   RD=1000.*R/RMD, RV=1000.*R/RMV,  &
+     &                  RCPD=3.5*RD,   RCVD=RCPD-RD,   RCPV=4. *RV,     &
+     &                  RCVV=RCPV-RV,  RKAPPA=RD/RCPD, RETV=RV/RD-1.
+! A1.5,6 Thermodynamic liquid,solid phases
+      REAL,PARAMETER :: RCW=RCPV,      RCS=RCPV
+
+! A1.7 Thermodynamic transition of phase
+      REAL,PARAMETER :: RTT=273.16,    RLVTT=2.5008E+6,RLSTT=2.8345E+6, &
+     &                  RLMLT=RLSTT-RLVTT,             RATM=100000.
+
+! A1.8 Curve of saturation
+      REAL,PARAMETER :: RESTT=611.14,  RGAMW=(RCW-RCPV)/RV,             &
+     &                  RBETW=RLVTT/RV+RGAMW*RTT,                       & 
+     &                  RGAMS=(RCS-RCPV)/RV,                            &    
+     &                  RBETS=RLSTT/RV+RGAMS*RTT,                       &  
+     &                  RGAMD=RGAMS-RGAMW, RBETD=RBETS-RBETW
+      REAL           :: RALPW,RALPS,RALPD
+
+!      RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT) 
+!      RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT) 
+!      RALPD = RALPS-RALPW 
+   
+
+END MODULE YOMCST
Index: LMDZ5/trunk/libf/phylmd/sisvat/sisvat.F
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/sisvat.F	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/sisvat.F	(revision 1865)
@@ -0,0 +1,10186 @@
+      subroutine SISVAT(SnoMod,BloMod,jjtime)
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT                               Mon 04-Apr-2011  MAR |
+!     SubRoutine SISVAT 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                      |
+!              ivgtSV   = 0,...,12:   Vegetation Type                      |
+!              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] |
+!              LAI0SV   : Leaf Area  Index                             [-] |
+!              glf0SV   : Green Leaf Fraction                          [-] |
+!              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-Canopy Albedo                        [-] |
+!     OUTPUT:  emi_SV   : Surface-Canopy 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] |
+!              snCaSV   : Canopy   Snow     Thickness            [mm w.e.] |
+!              rrCaSV   : Canopy   Water    Content                [kg/m2] |
+!              psivSV   : Leaf     Water    Potential                  [m] |
+!              TvegSV   : Canopy   Temperature                         [K] |
+!              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        [-] |
+!              SoCasv   : Absorbed Solar Radiation by Canopy (Normaliz)[-] |
+!              SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
+!              tau_sv   : Fraction of Radiation transmitted by Canopy  [-] |
+!              TBr_sv   : Brightness Temperature                       [K] |
+!              IRupsv   : Upward     IR Flux (-, upw.)              [W/m2] |
+!              IRv_sv   : Vegetation IR Flux                        [W/m2] |
+!              rrMxsv   : Canopy Maximum Intercepted Rain          [kg/m2] |
+!              Sigmsv   : Canopy Ventilation Factor                    [-] |
+!              ram_sv   : Aerodynamic Resistance for Momentum        [s/m] |
+!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!              HSv_sv   : Vegetation Sensible Heat Flux             [W/m2] |
+!              HLv_sv   : Vegetation Latent   Heat Flux             [W/m2] |
+!              Rootsv   : Root Water Pump                        [kg/m2/s] |
+!              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] |
+!              LAI_sv   : Leaf Area  Index (snow included)             [-] |
+!              LAIesv   : Leaf Area  Index (effective / transpiration) [-] |
+!              glf_sv   : Green Leaf Fraction of NOT fallen Leaves     [-] |
+!              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                            [-] |
+!              Evg_sv   : Soil+Vegetation Emissivity                   [-] |
+!              Eso_sv   : Soil+Snow       Emissivity                   [-] |
+!              psi_sv   : Soil       Water    Potential                [m] |
+!              Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
+!                                                                          |
+!              ETVg_d   : VegetationEnergy Power         Forcing    [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] |
+!              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] |
+!                                                                          |
+!              dsn_Ca,snCa_n :     Snow Contribution to the Canopy[m w.e.] |
+!              drr_Ca,rrCa_n,drip: Rain Contribution to the Canopy [kg/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] |
+!              EmiVeg   : Vegetation    Emissivity                     [-] |
+!              EmiSol   : Soil          Emissivity                     [-] |
+!              EmiSno   : Snow          Emissivity                     [-] |
+!              EmiWat   : Water         Emissivity                     [-] |
+!              Z0mSea   :          Sea  Roughness Length               [m] |
+!              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] |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: STANDARD Possibility                          |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^^^^^^^^^^^^                          |
+!     #AE: TURBULENCE: Aerosols Erosion / Turbulent Diffusion Coeff.       |
+!     #BD: TraCer   Aeolian Erosion  Submodel           is turned ON       |
+!     #BS: Explicit Cloud MICROPHYSICS: Blow. *(Snow)         Model)       |
+!     #SN: SNOW Model                               may be turned ON       |
+!     #NP: SNOW Model: Snow Properties may be those of Polar Snow          |
+!     #GL: SNOW Model: ETH-Camp & Greenland 3D simulations                 |
+!     #MB: SNOW Model: Erosion Efficiency (Marticorena & Berga.1995)       |
+!     #SI: SISVAT: Sea-Ice Fraction calculated from prescribed SST         |
+!     #MT: SISVAT: Monin-Obukhov Theory is linearized (Garrat schem)       |
+!     #SH: Soil /Vegetation Model: Hapex-Sahel   Vegetation     DATA       |
+!     #OR: SBL: Orography Roughness included from SL_z0 in MARdom          |
+!     #ZS: SBL: Mom.: Roughn.Length= F(u*) Wang  MWR 129     ,  Sea        |
+!     #TZ: SBL: Mom.: Roughn.Length= Typical value in polar models         |
+!     #SZ: SBL: Mom.: Roughn.Length= F(u*) Andreas &al.(1995)  Snow        |
+!     #ZA: SBL: Mom.: Roughn.Length= F(u*) Andreas &al.(2004), Snow        |
+!     #za: SBL: Mom.: Roughn.Length= F(u*) Andreas &al.(2004), Snow (native|
+!     #RN: SBL: Heat: Roughn.Length= F(u*,z0)  Andreas (1987)  Snow        |
+!     #ZM: SBL: M/H   Roughn.Length: Box Moving Average (in Time)          |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: STANDARD Col de Porte                         |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^                                      |
+!     #CP: Col de Porte  Turbulence        Parameterization                |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option:                                               |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #zs: SBL: Mom.: Roughn.Length= F(u*) Wang  MWR 129 bis ,  Sea        |
+!     #ZN: SBL: Mom.: Roughn.Length= F(u*) Shao  & Lin (1999), Snow        |
+!     #CM: SBL: Z0mL  Roughn.Length= F(glf)                                |
+!     #FL: SISVAT: LAI Assignation and Fallen Leaves Correction            |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # SISVAT_iii_jjj_n     | #E0: OUTPUT on ASCII  File (SISVAT Variables) |
+!   #                      |      Energy Budg. Verif.: Soil+(Sea-Ice)+Snow |
+!   #                      |(#E0  MUST BE PREPROCESSED BEFORE #e1 & #e2 !) |
+!   # SISVAT_iii_jjj_n     | #m0: OUTPUT/Verification: H2O    Conservation |
+!                          |                                               |
+!   # stdout               | #s0: OUTPUT of Snow Buffer Layer              |
+!                          |      unit  6, SubRoutine  SISVAT     **ONLY** |
+!   # stdout               | #s2: OUTPUT of SnowFall, Snow Buffer          |
+!                          |      unit  6, SubRoutine  SISVAT_BSn, _qSn    |
+!   # stdout               | #b0: OUTPUT of Snow Erosion                   |
+!                          |      unit  6, SubRoutine  SISVAT_BSn **ONLY** |
+!   # stdout               | #sf: OUTPUT of SnowFall, Z0 and Drag Coeff.   |
+!                          |      unit  6, SubRoutines PHY_SISVAT, SISVAT  |
+!   # stdout               | #sz: OUTPUT of Roughness Length & Drag Coeff. |
+!                          |      unit  6, SubRoutine  SISVAT     **ONLY** |
+!                                                                          |
+!     SUGGESTIONS of MODIFICATIONS: see lines beginning with "C +!!!"      |
+!     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^                                         |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARlSV
+      USE VARdSV
+      USE VAR0SV
+      USE VARxSV
+      USE VARdCP
+
+      USE VARySV
+
+      IMPLICIT NONE
+
+      logical   SnoMod
+      logical   BloMod
+      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
+c #NP real      BufPro,VV__10                 ! 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
+
+! Energy         Budget
+! ~~~~~~~~~~~~~~~~~~~~~
+! #e1 real      ETVg_d(klonv)                 ! VegetationPower, Forcing
+! #e1 real      ETSo_0(klonv)                 ! Soil/Snow Power, before Forcing
+! #e1 real      ETSo_1(klonv)                 ! Soil/Snow Power, after  Forcing
+! #e1 real      ETSo_d(klonv)                 ! Soil/Snow Power, Forcing
+! #e1 real      EqSn_0(klonv)                 ! Snow Energy, befor Phase Change
+! #e1 real      EqSn_1(klonv)                 ! Snow Energy, after Phase Change
+! #e1 real      EqSn_d(klonv)                 ! Energy in Excess
+
+! OUTPUT/Verification: H2O    Conservation
+! #m0 real      Wats_0(klonv)                 ! Soil Water,  before Forcing
+! #m0 real      Wats_1(klonv)                 ! Soil Water,  after  Forcing
+! #m0 real      Wats_d(klonv)                 ! Soil Water,         Forcing
+
+! OUTPUT/Verification: * Mass Conservation
+! #m1 real      SIsubl(klonv)                 ! Snow Sublimed/Deposed Mass
+! #m1 real      SImelt(klonv)                 ! Snow Melted           Mass
+! #m1 real      SIrnof(klonv)                 ! Local Surficial Water + Run OFF
+
+! OUTPUT/Verification: SeaIce Conservation
+! #m2 real      SIvAcr(klonv)                 ! Sea-Ice      Vertical Acretion
+
+
+! Local
+! -----
+
+c #MT logical      Garrat                     ! SBL     Scheme    Switch
+      character* 1 SepLab                     ! OUTPUT ASCII File Labels
+      character* 6 FilLab                     !
+      character*16 FilNam                     !
+      common/SISVAT_loc_abc/SepLab,FilLab     !
+
+      integer               noUNIT            ! OUTPUT File  Unit Number
+      integer               nwUNIT            ! OUTPUT File  Unit Number (New)
+      common/SISVAT_loc_num/nwUNIT            !
+
+      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      drr_Ca,rrCa_n,drip            ! Rain Contribution to the Canopy
+      real      dsn_Ca,snCa_n,FallOK(klonv)   ! Snow Contribution to the Canopy
+      real      roSMin,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,Por_BS,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      EmiVeg                        ! Emissivity of Vegetation 
+      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      fallen                        ! Fallen   Leaves         Switch
+      real      Z0mSea,Z0hSea                 !          Sea  Roughness Length
+      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                        ! Sea-Ice ISW   Roughness Length
+      real      Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
+      real      SnoWat                        ! Snow Layer    Switch
+c #RN real      rstar,alors                   !
+c #RN 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      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
+
+! Energy       Budget
+! ~~~~~~~~~~~~~~~~~~~
+! #e1 integer             noEBal              ! Energy Imbalances Counter
+! #e1 common/SISVAT__EBal/noEBal              !
+! #e1 real        Enrsvd(klonv)               ! Soil+Vegetat  Power  Forcing
+! #e1 real        EnsBal                      ! Soil+Snow   , Power  Balance
+! #e1 real        EnvBal                      !      Vegetat, Power  Balance
+
+! OUTPUT/Verification: H2O    Conservation
+! #m0 integer             noWBal              ! Water  Imbalances Counter
+! #m0 common/SISVAT__WBal/noWBal              !
+! #m0 real        Watsv0(klonv)               ! Soil+Vegetat, before Forcing
+! #m0 real        Watsvd(klonv)               ! Soil+Vegetat  Water  Forcing
+! #m0 real        Watbal                      ! Soil+Vegetat, Water  Balance
+
+! OUTPUT/Verification: * Mass Conservation
+! #m1 integer             noSBal              ! Water  Imbalances Counter
+! #m1 common/SISVAT__SBal/noSBal              !
+! #m1 real        SIWm_0(klonv),SIWm_1(klonv) ! Snow Initial/Final        Mass
+! #m1 real        SIWa_i(klonv),SIWa_f(klonv) ! Snow Initial/Final ATM Forcing
+! #m1 real        SIWe_i(klonv),SIWe_f(klonv) ! Snow Initial/Final BLS Forcing
+! #m1 real        SnoBal                      ! Snow Pack     Mass   Balance
+
+
+! Internal DATA
+! =============
+
+c #MT data      Garrat /.true. /              ! SBL     Scheme    Switch
+      data      T__Min / 200.00/              ! Minimum realistic Temperature
+      data      TaPole / 263.15/              ! Maximum Polar     Temperature
+      data      roSMin /  30.  /              ! Minimum Snow  Density
+      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      EmiVeg /   0.99999999/        ! 0.98Emissivity of Vegetation
+      data      EmiWat /   0.99999999/        ! Emissivity of a Water Area
+      data      EmiSno /   0.99999999/        ! Emissivity of Snow
+!     DATA      Emissivities                  ! Pielke, 1984, pp. 383,409
+
+      data      fallen /   0.    /            ! Fallen  Leaves         Switch
+      data      Z0mBS0 /   0.5e-6/            ! MINimum Snow Roughness Length 
+                                              ! for Momentum if Blowing Snow
+                                              ! Gall?e et al. 2001 BLM 99 (19)
+      data      Z0m_S0/    0.00005/           ! MINimum Snow Roughness Length
+c #MG data      Z0m_S0/    0.00200/           ! 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)
+      vk2    =  vonKrm  *  vonKrm             ! Square of Von Karman Constant
+c #FL fallen =             1.                 ! Fallen  Leaves         Switch
+
+
+! BEGIN.main.
+! SISVAT Forcing VERIFICATION
+! ===========================
+
+      IF (.not.iniOUT)                                              THEN
+               iniOUT = .true.
+        IF (IRs_SV(1).gt.-eps6)
+     .  write(6,600) 
+ 600    format(/,'### SISVAT ERROR, Soil IR Upward  not defined ###',
+     .         /,'###               Initialize and Store IRs_SV ###')
+        IF (IRs_SV(1).gt.-eps6) THEN
+          write(*,*)'ikl',ikl,'IR',IRs_SV(ikl)
+
+          IRs_SV(ikl)=-IRs_SV(ikl)
+          isn= isnoSV(ikl)
+          write(*,*) isnoSV(ikl),TsisSV(ikl,isn),dzsnSV(ikl,isn) 
+        ENDIF
+
+! OUTPUT
+! ======
+
+                    FilLab              ='SISVAT'
+                    SepLab              ='_'
+                    nwUNIT              = 51
+      END IF
+
+c #E0 DO ikl=1,knonv
+c #E0   IF   (lwriSV(ikl).ne.0.AND.no__SV(lwriSV(ikl)).eq.0)        THEN 
+c #E0                nwUNIT              = nwUNIT+1
+c #E0                no__SV(lwriSV(ikl)) = nwUNIT
+c #E0      write(FilNam,'(a6,a1,2(i3.3,a1),i1)')
+c #E0.           FilLab,SepLab,i___SV(lwriSV(ikl)),
+c #E0.                  SepLab,j___SV(lwriSV(ikl)),
+c #E0.                  SepLab,n___SV(lwriSV(ikl))
+c #E0      open(unit=nwUNIT,status='unknown',file=FilNam)
+c #E0      rewind    nwUNIT
+c #E0   END IF
+c #E0 END DO
+
+c #E0 DO ikl=1,knonv
+c #E0   IF (lwriSV(ikl).ne.0)                                       THEN 
+c #E0           noUNIT=no__SV(lwriSV(ikl)) 
+c #E0     write(noUNIT,5000) daHost,i___SV(lwriSV(ikl)),
+c #E0.                              j___SV(lwriSV(ikl)),
+c #E0.                              n___SV(lwriSV(ikl)),
+c #E0.                                     Z0m_SV(ikl) ,
+c #E0.                                     albisv(ikl)
+ 5000     format(
+     .       /,              a18,'|           Grid Point ',2i4,
+     .                                           ' (',i2,')',
+     .         '    | Z0m =',f12.6,' | Albedo = ',f6.3,' |',
+     .       /,' -------+',7('---------+'),2('--------+'))
+c #E0   END IF
+c #E0 END DO
+
+
+! "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
+
+
+! Vegetation Temperature Limits
+! =============================
+
+          DO ikl=1,knonv
+            TvegSV(ikl) = max(TvegSV(ikl),T__Min)         ! T__Min = 200.K
+
+
+! LAI Assignation and Fallen Leaves Correction (#FL)
+! ==================================================
+
+            LAI0SV(ikl) =     LAI0SV(ikl)*min(1,ivgtSV(ikl)) ! NO LAI if 
+!                                                            ! no vegetation
+            glf_sv(ikl) =     glf0SV(ikl)
+c #FL       glf_sv(ikl) =     1.
+            LAI_sv(ikl) =     LAI0SV(ikl)
+c #FL.               *        glf0SV(ikl) 
+          END DO
+
+
+! LAI in Presence of Snow
+! =======================
+
+!         ASSUMPTION: LAI decreases   when Snow Thickness increases, 
+!         ^^^^^^^^^^      becoming  0 when Snow Thickn. = Displac.Height
+          DO ikl=1,knonv
+            LAI_sv(ikl) =     LAI_sv(ikl)
+     .               * (1.0 - zzsnsv(       ikl, isnoSV(ikl))
+     .                      /(DH_dSV(ivgtSV(ikl))+eps6)      )
+            LAI_sv(ikl) = max(LAI_sv(ikl),zer0)
+            LAI_sv(ikl) = min(LAI_sv(ikl),ea_Max)
+          END DO
+
+
+! Interception of Rain by the Canopy
+! ==================================
+
+! OUTPUT/Verification: H2O    Conservation: Vegetation Forcing
+! #m0     DO ikl=1,knonv
+! #m0       Watsv0(ikl) =      rrCaSV(ikl)           ! Canopy Water Cont.
+! #m0       Watsvd(ikl) =      drr_SV(ikl)           ! Precipitation
+! #m0     END DO
+
+
+! New Canopy Water Content
+! ------------------------
+
+          DO ikl=1,knonv
+            rrMxsv(ikl) = 0.2*max( eps6,LAI_sv(ikl)) ! Precip. Max. Intercept.
+            Sigmsv(ikl) = 1.0-exp(-half*LAI_sv(ikl)) ! Canopy Ventilation Coe.
+!                                                    ! (DR97, eqn 3.6)
+            drr_Ca      = drr_SV(ikl)  *Sigmsv(ikl)  ! Intercepted Rain
+     .                                 *dt__SV       !
+            rrCa_n      = rrCaSV(ikl)  +drr_Ca       ! New Canopy Water Contnt
+                                                     ! (DR97, eqn 3.28)
+            drip        = rrCa_n       -rrMxsv(ikl)  ! Water  Drip
+            drip        =      max(zer0,drip)        !
+            rrCa_n      = rrCa_n       -drip         !
+            drr_SV(ikl) = drr_SV(ikl) +(rrCaSV(ikl)  ! Update Rain  Contribut.
+     .                                 -rrCa_n     ) !
+     .                                 /dt__SV       !
+            rrCaSV(ikl) = rrCa_n                     ! Upd.Canopy Water Contnt
+
+
+! Interception of Snow by the Canopy
+! ==================================
+
+            dsn_Ca      = dsn_SV(ikl)  *Sigmsv(ikl)  ! Intercepted Snow
+     .                                 *dt__SV       !
+            snCa_n      = snCaSV(ikl)  +dsn_Ca       ! New Canopy Snow Thickn.
+            drip        = snCa_n       -rrMxsv(ikl)  !
+            drip        =      max(zer0,drip)        !
+            snCa_n      = snCa_n       -drip         !
+            dsn_SV(ikl) = dsn_SV(ikl) +(snCaSV(ikl)  ! Update Snow  Contribut.
+     .                                 -snCa_n     ) ! 
+     .                                 /dt__SV       !
+            snCaSV(ikl) = snCa_n                     ! Upd.Canopy Snow Thickn.
+          END DO 
+
+
+! Snow Fall from the Canopy
+! =========================
+
+!         ASSUMPTION: snow fall from the canopy, 
+!         ^^^^^^^^^^  when the temperature of the vegetation is positive
+!               (.OR. when snow over the canopy is saturated  with water)
+
+          DO ikl=1,knonv
+            FallOK(ikl) =  max(zer0,sign(un_1,TvegSV(ikl)-Tf_Sno+eps6))
+     .                  *  max(zer0,sign(un_1,snCaSV(ikl)       -eps6))
+            dsn_SV(ikl) =      dsn_SV(ikl)   +snCaSV(ikl)*FallOK(ikl) 
+     .                                       /dt__SV
+            snCaSV(ikl) =      snCaSV(ikl) * (1.         -FallOK(ikl))
+
+
+! Blowing Particles Threshold Friction velocity
+! =============================================
+
+c #AE       usthSV(ikl) =                     1.0e+2
+          END DO
+
+
+! Contribution of Snow to the Surface Snow Pack
+! =============================================
+
+      IF (SnoMod)                                                 THEN
+
+
+! OUTPUT/Verification: * Mass Conservation
+! #m1   DO ikl=1,knonv
+! #m1     SIWa_i(ikl) =(drr_SV(ikl) + dsn_SV(ikl))   *dt__SV         ![mm w.e.]
+! #m1     SIWe_i(ikl) = dbs_SV(ikl)                                  !
+! #m1     SIWm_0(ikl) = BufsSV(ikl) + HFraSV(ikl)    *rhoIce         !
+! #m1   DO isn=1,nsno                                                !
+! #m1     SIWm_0(ikl) = SIWm_0(ikl) + dzsnSV(ikl,isn)*ro__SV(ikl,isn)!
+! #m1   END DO                                                       !
+! #m1   END DO                                                       !
+
+
+! Blowing Snow
+! ------------
+
+!                         **********
+c #SN   IF (BloMod)  call SISVAT_BSn(BloMod)
+!                         **********
+
+!                         **********
+! #ve                call SISVAT_wEq('_BSn  ',1)
+!                         **********
+
+
+! Sea Ice
+! -------
+
+!            **********
+c #SI   call SISVAT_SIc
+! #m2.                 (SIvAcr)
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_SIc  ',0)
+!            **********
+
+
+! Buffer Layer
+! ------------
+
+          DO ikl=1,knonv
+            BufsSV(ikl) =      BufsSV(ikl)              !     [mm w.e.]
+            d_Bufs      =  max(dsn_SV(ikl) *dt__SV,0.)  ! i.e., [kg/m2]
+            dsn_SV(ikl) =      0.                       !
+            Bufs_N      =      BufsSV(ikl) +d_Bufs      !
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Buffer G1, G2 variables
+! #s0       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #s0.          nn__SV(ikl).EQ.nwr_SV)
+! #s0.      write(6,6601)      BufsSV(ikl) ,d_Bufs,Bufs_N
+ 6601       format(/,'Buffer *: ',3e15.6)
+ 
+! Snow Density
+! ^^^^^^^^^^^^
+            Polair      =      0.00
+c #NP       Polair      =  max(zer0,                    !
+c #NP.                         sign(un_1,TaPole         !
+c #NP.                                  -TaT_SV(ikl)))  !
+            Buf_ro      =  max( rosMin,                 ! Fallen Snow Density
+     .      roSn_1+roSn_2*     (TaT_SV(ikl)-Tf_Sno)     ! [kg/m3]
+     .            +roSn_3*sqrt( VV__SV(ikl)))           ! Pahaut    (CEN)
+c #NP       VV__10      =       VV__SV(ikl)             !
+c #NP.         *log(10.        /Z0m_SV(ikl))            !
+c #NP.         /log(za__SV(ikl)/Z0m_SV(ikl))            !
+c #NP       BufPro      =  max( rosMin,                 ! Fallen Snow Density
+c #NP.         104. *sqrt( max( VV__10  -   6.0,0.0)))  ! Kotlyakov (1961)
+            Bros_N      = (1. - Polair) *   Buf_ro      ! Temperate Snow
+c #NP.                        + Polair  *   BufPro      ! Polar     Snow
+ 
+! Instantaneous Density of deposited blown Snow (de Montmollin, 1978)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #BS       PorSno =      1.0d00     -  BSnoRo
+c #BS.                               /  rhoIce
+c #BS       Salt_f =      usthSV(ikl)/  max(eps6,   us__SV(ikl))
+c #BS       Salt_f =  min(Salt_f     ,  un_1)
+c #BS       PorRef =      PorSno     /  max(eps6,1.-PorSno)
+c #BS.               +log(Salt_f)
+c #BS       Por_BS =      PorRef     /          (1.+PorRef)
+c #BS       ro_new =      rhoIce     *          (1.-Por_BS)
+c #BS       ro_new =  max(ro_new     ,  BSnoRo)
+c #BS       Bros_N      = Bros_N     * (1.0-dsnbSV(ikl))
+c #BS.                  + ro_new     *      dsnbSV(ikl)
+ 
+! Instantaneous Density IF deposited blown Snow (Melted* from Canopy)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            Bros_N      = Bros_N     * (1.0-FallOK(ikl))!
+     .                  + 300.       *      FallOK(ikl) !
+
+! Time averaged Density of deposited blown Snow
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            BrosSV(ikl) =(Bros_N     *      d_Bufs      !
+     .                   +BrosSV(ikl)*      BufsSV(ikl))!
+     .                   /         max(eps6,Bufs_N)     !
+
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Buffer G1, G2 variables
+! #s0       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #s0.          nn__SV(ikl).EQ.nwr_SV)
+! #s0.      write(6,6602) Buf_ro,Bros_N,BrosSV(ikl),dsnbSV(ikl)
+ 6602       format('rho    *: ',3e15.6,'    dsnbSV: ',e15.6)
+ 
+!  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                   ))    !
+            Buf_G1      = (1. - Polair) *   Buf_G1      ! Temperate Snow
+     .                        + Polair  *   G1_dSV      ! Polar     Snow
+            Buf_G2      = (1. - Polair) *   Buf_G2      ! Temperate Snow
+     .                        + Polair  *   ADSdSV      ! Polar     Snow
+                G1      =                   Buf_G1      ! NO  Blown Snow
+                G2      =                   Buf_G2      ! NO  Blown Snow
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Buffer G1, G2 variables
+! #s0       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #s0.          nn__SV(ikl).EQ.nwr_SV)
+! #s0.      write(6,6603)       BG1sSV(ikl),BG2sSV(ikl)  
+ 6603       format('G1,G2  *: ',3e15.6)
+ 
+! S.1. Meme  Type  de Neige  / same Grain Type
+!      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #BS       SameOK  =  max(zer0,
+c #BS.                     sign(un_1,    Buf_G1             *G1_dSV
+c #BS.                                 - eps_21                    ))
+c #BS       G1same  = ((1.0-dsnbSV(ikl))*Buf_G1+dsnbSV(ikl) *G1_dSV)
+c #BS       G2same  = ((1.0-dsnbSV(ikl))*Buf_G2+dsnbSV(ikl) *ADSdSV)
+!           Blowing Snow Properties:                         G1_dSV, ADSdSV
+ 
+! S.2. Types differents / differents Types
+!      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #BS       typ__1  =  max(zer0,sign(un_1,eps6-Buf_G1))   ! =1.=> Dendritic
+c #BS       zroNEW  =     typ__1  *(1.0-dsnbSV(ikl))      ! fract.Dendr.Lay.
+c #BS.              + (1.-typ__1) *     dsnbSV(ikl)       !
+c #BS       G1_NEW  =     typ__1  *Buf_G1                 ! G1 of Dendr.Lay.
+c #BS.              + (1.-typ__1) *G1_dSV                 !
+c #BS       G2_NEW  =     typ__1  *Buf_G2                 ! G2 of Dendr.Lay.
+c #BS.              + (1.-typ__1) *ADSdSV                 !
+c #BS       zroOLD  = (1.-typ__1) *(1.0-dsnbSV(ikl))      ! fract.Spher.Lay.
+c #BS.              +     typ__1  *     dsnbSV(ikl)       !
+c #BS       G1_OLD  = (1.-typ__1) *Buf_G1                 ! G1 of Spher.Lay.
+c #BS.              +     typ__1  *G1_dSV                 !
+c #BS       G2_OLD  = (1.-typ__1) *Buf_G2                 ! G2 of Spher.Lay.
+c #BS.              +     typ__1  *ADSdSV                 !
+c #BS       SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV          ! Size  Dendr.Lay.
+c #BS.               +(1.+G1_NEW         /G1_dSV)         !
+c #BS.                  *(G2_NEW  *DScdSV/G1_dSV          !
+c #BS.               +(1.-G2_NEW         /G1_dSV)*DFcdSV) !
+c #BS       SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
+c #BS       SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
+c #BS       SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
+c #BS       Siz_av =     (zroNEW*SizNEW+zroOLD*SizOLD)    ! Averaged Size
+c #BS       Sph_av = min( zroNEW*SphNEW+zroOLD*SphOLD     !
+c #BS.                   ,  un_1)                         ! Averaged Sphericity
+c #BS       Den_av = min((Siz_av -(    Sph_av *DScdSV     !
+c #BS.                            +(1.-Sph_av)*DFcdSV))   !
+c #BS.                 / (DDcdSV -(    Sph_av *DScdSV     !
+c #BS.                            +(1.-Sph_av)*DFcdSV))   !
+c #BS.                   ,  un_1)                         !
+c #BS       DendOK  = max(zer0,                           !
+c #BS.                    sign(un_1,     Sph_av *DScdSV   ! Small   Grains
+c #BS.                              +(1.-Sph_av)*DFcdSV   ! Faceted Grains
+c #BS.                              -    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
+ 
+c #BS       G1diff  =(   -DendOK *Den_av
+c #BS.               +(1.-DendOK)*Sph_av) *G1_dSV
+c #BS       G2diff  =     DendOK *Sph_av  *G1_dSV
+c #BS.               +(1.-DendOK)*Siz_av
+c #BS       G1      =     SameOK *G1same
+c #BS.               +(1.-SameOK)*G1diff
+c #BS       G2      =     SameOK *G2same
+c #BS.               +(1.-SameOK)*G2diff
+ 
+            BG1__N      =((1. - FallOK(ikl))*   G1      !
+     .                        + FallOK(ikl) *   99.)    ! Melted *  from Canopy
+     .                  *       d_Bufs/max(eps6,d_Bufs) !
+            BG2__N      =((1. - FallOK(ikl))*   G2      !
+     .                        + FallOK(ikl) *   30.)    ! Melted *  from Canopy
+     .                  *       d_Bufs/max(eps6,d_Bufs) !
+
+!  S.Buffer  Snow Properties (computed as in SISVAT_zAg)
+!    ^^^^^^^^^^^^^^^^^^^^^^^
+            Buf_G1      =       BG1__N                  ! Falling   Snow
+            Buf_G2      =       BG2__N                  ! Falling   Snow
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Buffer G1, G2 variables
+! #s0       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #s0.          nn__SV(ikl).EQ.nwr_SV)
+! #s0.      write(6,6604)      Buf_G1      ,Buf_G2         ,FallOK(ikl)
+! #s0.                                                     ,TvegSV(ikl)
+ 6604       format('G1,G2 F*: ',3e15.6,'    T__Veg: ',e15.6)
+ 
+! S.1. Meme  Type  de Neige  / same Grain Type
+!      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            SameOK  =  max(zer0,
+     .                     sign(un_1,    Buf_G1 *BG1sSV(ikl)
+     .                                 - eps_21                    ))
+            G1same  = (d_Bufs*Buf_G1+BufsSV(ikl)*BG1sSV(ikl))
+     .                     / max(eps6,Bufs_N)
+            G2same  = (d_Bufs*Buf_G2+BufsSV(ikl)*BG2sSV(ikl))
+     .                     /max(eps6,Bufs_N)
+ 
+! S.2. Types differents / differents Types
+!      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            typ__1  =  max(zer0,sign(un_1,eps6-Buf_G1))   ! =1.=> Dendritic
+            zroNEW  =(    typ__1  *d_Bufs                 ! fract.Dendr.Lay.
+     .              + (1.-typ__1) *BufsSV(ikl))           !
+     .                   /max(eps6,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(eps6,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   !
+     .                  ,   un_1                       )  ! Averaged Sphericity
+            Den_av = min((Siz_av  - (    Sph_av *DScdSV   !
+     .                              +(1.-Sph_av)*DFcdSV)) !
+     .                 / (DDcdSV  - (    Sph_av *DScdSV   !
+     .                              +(1.-Sph_av)*DFcdSV)) !
+     .                  ,   un_1                         )!
+            DendOK  = max(zer0,                           !
+     .                    sign(un_1,     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(eps6,Bufs_N) ! 
+            BG2sSV(ikl) =                       G2      !
+     .                  *       Bufs_N/max(eps6,Bufs_N) ! 
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Buffer G1, G2 variables
+! #s0       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #s0.          nn__SV(ikl).EQ.nwr_SV)
+! #s0.      write(6,6605) Buf_G1     ,typ__1
+! #s0.                   ,DendOK     ,Den_av     ,Sph_av     ,Siz_av
+! #s0.                   ,G1same     ,G1diff     ,G1
+ 6605       format('B1,Typ  : ',2e15.6,11x,'OK,Den,Sph,Siz: ',4e15.6
+     .          ,/,'          ',30x   ,11x,'sam,dif,G1    : ',3e15.6)
+
+! Update of Buffer Layer Content & Decision about creating a new snow layer
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            BufsSV(ikl) =       Bufs_N                  !     [mm w.e.]
+            NLaysv(ikl) = min(un_1,                     !
+     .                    max(zer0,                     ! Allows to create 
+     .                        sign(un_1,BufsSV(ikl)     ! a new snow Layer
+     .                                 -SMndSV     ))   ! if Buffer > SMndSV
+     .                   *max(zer0,                     ! Except if * Erosion
+     .                        sign(un_1,half            ! dominates
+     .                                 -dsnbSV(ikl)))   !
+     .                   +max(zer0,                     ! Allows to create
+     .                        sign(un_1,BufsSV(ikl)     ! a new snow Layer
+     .                                 -SMndSV*3.00)))  ! is Buffer > SMndSV*3
+
+            Bdzssv(ikl) = 1.e-3*BufsSV(ikl)*rhoWat      ! [mm w.e.] -> [m w.e.]
+     .                            /max(eps6,BrosSV(ikl))!& [m w.e.] -> [m]
+ 
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Buffer G1, G2 variables
+! #s0       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #s0.          nn__SV(ikl).EQ.nwr_SV)
+! #s0.      write(6,6606) BG1sSV(ikl),BG2sSV(ikl)
+! #s0.                   ,NLaysv(ikl),BdzsSV(ikl)  
+ 6606       format('G1,G2 N*: ',2e15.6,i15,e27.6)
+
+          END DO
+
+
+! Snow Pack Discretization
+! ========================
+
+!            **********
+        call SISVAT_zSn
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_zSn  ',0)
+!            **********
+
+! OUTPUT in SISVAT for ikl = 1 (preferably for Stand Alone Version)
+! OUTPUT           for SnowFall and Snow Buffer
+! #s2   IF          (isnoSV(1) .GT. 0)
+! #s2.  write(6,6004)isnoSV(1),    dsn_SV(1) *dt__SV + BufsSV(1),
+! #s2.              (dzsnSV(1,isn)*ro__SV(1,isn),isn=1,isnoSV(1))
+ 6004   format(i3,'  dsn+Buf=',f6.2,6x,'z dz *ro =',10f6.2,
+     .                                       (/,35x,10f6.2))
+
+
+! 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
+
+
+! Diffusion of Surficial Water in the Snow Pack
+! ---------------------------------------------
+
+c #sw     DO isn=1,nsno
+c #sw     DO ikl=1,knonv
+c #sw       PorVol      = 1.     - ro__SV(ikl,isn) /  rhoIce          !
+c #sw       PorVol      =      max(PorVol            ,zer0  )         !
+c #sw       rWater      = ws0dSV * PorVol     *rhoWat*dzsnSV(ikl,isn)
+c #sw.                  * max(zer0,
+c #sw.                   sign(un_1,rusnSV(ikl)/rhoWat-zzsnsv(ikl,isn)
+c #sw.                                               +dzsnSV(ikl,isn)))
+c #sw       rusNEW      =      max(rusnSV(ikl)-rWater,zer0  )
+c #sw       rWater      =          rusnSV(ikl)-rusNEW
+c #sw       rdzNEW          =      rWater
+c #sw.                           + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
+c #sw       etaNEW          =      rWater / max(eps6,rdzNEW)
+c #sw       rusnSV(ikl) =          rusNEW
+c #sw       ro__SV(ikl,isn) =      rdzNEW / max(eps6,dzsnSV(ikl,isn))
+c #sw       eta_SV(ikl,isn) =      eta_SV(ikl,isn)  +etaNEW
+c #sw     ENDDO
+c #sw     ENDDO
+
+      END IF
+
+! OUTPUT in SISVAT for ikl = 1 (preferably for Stand Alone Version)
+! OUTPUT           for SnowFall and Snow Buffer
+! #s2   IF (knonv>0) THEN
+! #s2   IF          (isnoSV(1) .GT. 0)
+! #s2.  write(6,6006)isnoSV(1),    dsn_SV(1) *dt__SV + BufsSV(1),
+! #s2.              (dzsnSV(1,isn)*ro__SV(1,isn),isn=1,isnoSV(1))
+! #s2   END IF
+ 6006   format(i3,'  dsn+Buf=',f6.2,6x,'* dz *ro =',10f6.2,
+     .                                       (/,35x,10f6.2))
+
+
+! Blowing Dust
+! ============
+
+c #BD   IF (BloMod)                                               THEN
+
+!         ***************
+c #BD     call SISVAT_BDu
+!         ***************
+
+c #BD   END IF
+
+
+
+! 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
+
+!            **********
+! #ve   call SISVAT_wEq('SnOptP',0)
+!            **********
+
+
+! Solar Radiation Absorption and Effective Leaf Area Index
+! ========================================================
+
+!            ******
+        call VgOptP
+!            ******
+
+
+! Surface-Canopy Emissivity
+! =========================
+
+        DO ikl=1,knonv
+            LSnMsk     =     min( 1,isnoSV(ikl))
+            tau_sv(ikl)=     exp(  -LAI_sv(ikl))           ! Veg Transmit.Frac.
+            Evg_sv(ikl)=  EmiVeg*(1-LSnMsk)+EmiSno*LSnMsk  ! Veg+Sno Emissivity
+            Eso_sv(ikl)=  EmiSol*(1-LSnMsk)+EmiSno*LSnMsk  ! Sol+Sno Emissivity
+            emi_SV(ikl)=
+     .   (((EmiSol*     tau_sv(ikl) 
+     .     +EmiVeg*(1.0-tau_sv(ikl))) *LSmask(ikl))
+     .    + EmiWat                 *(1-LSmask(ikl)))*(1-LSnMsk)
+     .   +  EmiSno                                     *LSnMsk
+        END DO
+
+
+! Soil/Vegetation Forcing/ Upward IR (INPUT, from previous time step)
+! ===================================================================
+
+        DO ikl=1,knonv
+! #e1     Enrsvd(ikl) =    - IRs_SV(ikl)
+          IRupsv(ikl) =      IRs_SV(ikl) *     tau_sv(ikl) ! Upward   IR
+        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
+
+
+! Roughness Length for Momentum
+! -----------------------------
+
+! 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    =     min(iiceSV(ikl),1     )
+          LISmsk    =     max(LSmask(ikl),LISmsk)
+          IceMsk    =     max(0,sign(1   ,IcIndx(ikl)-1)  )
+          SnoMsk    = max(min(isnoSV(ikl)-iiceSV(ikl),1),0)
+
+! Sea  Roughness Length
+! ^^^^^^^^^^^^^^^^^^^^^
+          Z0mSea =       0.0002
+          Z0hSea =       0.000049
+
+c #zs     Z0mSea =       0.0185*us__SV(ikl)*us__SV(ikl) ! Doyle MWR 130
+c #zs.                         *Grav_I                  ! p.3088 2e col 
+
+c #ZS     Z0mSea =       0.016 *us__SV(ikl)*us__SV(ikl) ! Wang  MWR 129
+c #ZS.                         *Grav_I                  ! p.1377 (21)   
+c #ZS.           +       0.11  *A_MolV                  !
+c #ZS.                         /  max(eps6 ,us__SV(ikl))!
+
+c #zs     Z0mSea =       0.0185*us__SV(ikl)*us__SV(ikl) ! Wang  MWR 129
+c #zs.                         *Grav_I                  ! p.1377 (21)   
+c #zs.           +       0.135 *A_MolV                  !   (adapted)
+c #zs.                         /  max(eps6 ,us__SV(ikl))!
+
+c #ZS     Z0hSea =   max(0.000049,                      ! Wang  MWR 129
+c #ZS.                   0.20  *A_MolV                  ! p.1377 (22)   
+c #ZS.                         /  max(eps6 ,us__SV(ikl)))
+
+c #ZS     Z0mSea =   max(Z0mSea,eps6)                   ! 
+
+! Land Roughness Length, Snow Contribution excluded
+! ^^^^^^^^^^^^^^^^^^^^^^ Ice  Contribution included
+!                        ^^^^^^^^^^^^^^^^^^^^^^^^^^
+! If vegetation Seasonal Cycle described by  LAI     :
+          growth      =min(max(0,7-ivgtSV(ikl)),1)
+          Z0mLnd      =     Z0mdSV(ivgtSV(ikl))*LAI_sv(ikl)*growth
+     .                                         /LAIdSV
+     .                +     Z0mdSV(ivgtSV(ikl))*         (1-growth)
+
+! If vegetation Seasonal Cycle described by  GLF only:
+c #CM     Z0mLnd      =     
+c #CM.             fallen * Z0mLnd     
+c #CM.        +(1.-fallen)* Z0mdSV(ivgtSV(ikl))*glf_sv(ikl)*growth
+c #CM.                 +    Z0mdSV(ivgtSV(ikl))*         (1-growth)
+
+! Land Roughness Length, Influence of the Masking by Snow
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0mLnd      =max( Z0mLnd   ,
+     .                      Z0mdSV(0)*(1-IceMsk)
+     .                     +Z0_ICE   *   IceMsk )
+          Z0mLnd      =     Z0mLnd             
+     .                    -(zzsnsv(ikl,    isnoSV(ikl))
+     .                     -zzsnsv(ikl,max(IcIndx(ikl),0)))/7. 
+          Z0mLnd      =max( Z0mLnd    ,    5.e-5  )  ! Min set := Z0 on *
+!         Roughness  disappears under Snow 
+!         Assumption Height/Roughness Length =  7 is used
+
+! Z0 Smooth Regime over Snow (Andreas 1995, CRREL Report 95-16, p. 8)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0m_nu =       5.e-5 ! z0s~(10-d)*exp(-vonKrm/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
+
+! Rough   Snow Surface Roughness Length (Typical Value)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0m_Sn =      25.e-5 ! Andreas 1995, CRREL Report 95-16, fig.1&p.2
+                               ! z0r~(10-d)*exp(-vonKrm/sqrt(1.5e-03))-5.e-5
+c #TZ     Z0m_Sn =       5.e-5 ! Typical Tuning in polar mesoscale models
+
+! 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
+
+c #SZ     Z0Sa_N =                   (us__SV(ikl) -0.2)*0.0050 ! 0050=0.003/0.6
+c #SZ     Z0SaSi = max(zer0,sign(un_1,Z0Sa_N))                 ! 0100=TUNING
+c #SZ     Z0Sa_N = max(zer0,          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
+!         CAUTION: The influence of the sastrugi direction is not yet included
+
+c #SZ     Z0m_Sn =                    Z0SaSV(ikl)              !
+c #SZ.                              - Z0m_nu                   !
+
+! Z0                         (Shao & Lin, 1999, BLM 91 (46)  p.222)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+! Z0 Saltat.Regime over Snow (Shao & Lin, 1999, BLM 91 (46)  p.222)
+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)*Grav_I*0.5
+
+! Z0 Smooth + Saltat. Regime (Shao & Lin, 1999, BLM 91 (46)  p.222)
+c #ZN     Z0enSV(ikl) = (Z0m_nu     **    sqrrZ0 )
+c #ZN.                * (Z0mBSn     **(1.-sqrrZ0))
+c #ZN     Z0enSV(ikl) =  max(Z0enSV(ikl), Z0m_nu)
+
+! Z0                         (Andreas etAl., 2004
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
+! Z0 Smooth Regime over Snow (Andreas etAl., 2004
+c #ZA     Z0m_nu = 0.135*A_MolV / max(us__SV(ikl) , eps6)
+
+! Z0 Saltat.Regime over Snow (Andreas etAl., 2004
+c #ZA     Z0mBSn = 0.035*u2star      *Grav_I
+
+! Z0 Smooth + Saltat. Regime (Andreas etAl., 2004
+c #ZA     Z0enSV(ikl) =  Z0m_nu
+c #ZA.                +  Z0mBSn
+
+! Z0 Rough  Regime over Snow (Andreas etAl., 2004
+! (.NOT. used by Erosion)     ams.confex.com/ams/pdfpapers/68601.pdf)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #ZA     Z0m_90 =(10.-0.025*VVs_SV(ikl)/5.)
+c #ZA.            *exp(-0.4/sqrt(.0020+.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.)
+! #za     u2star =      (us__SV(ikl) -0.1800)     / 0.1
+! #za     Z0m_Sn =A_Fact*Z0mBSn *exp(-u2star*u2star)
+
+! Z0 Rough  Regime over Snow (Andreas etAl., 2004
+c #ZA     u2star =      (us__SV(ikl) -0.1800)     / 0.1
+c #ZA     Z0m_Sn =A_Fact*Z0mBSn *exp(-u2star*u2star)
+
+! Z0 Smooth + Saltat. Regime + Rough  Regime over Snow (Andreas etAl., 2004)
+c #ZA     Z0enSV(ikl) =  Z0enSV(ikl)
+c #ZA.                +  Z0m_Sn
+
+! Z0               over Snow (instantaneous or time average)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0e_SV(ikl) =  Z0enSV(ikl)
+c #ZM     Z0e_SV(ikl) =  Z0emSV(ikl)
+
+! Momentum  Roughness Length
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^                                 ! Contribution of
+          Z0mnSV(ikl) =  Z0mLnd                              ! Vegetation Form
+     .                + (Z0m_Sn                              ! Sastrugi   Form
+     .                +  Z0enSV(ikl))   *SnoMsk              ! Snow    Erosion
+
+! Mom. Roughness Length, Discrimination among Ice/Land  and Ice-Free Ocean
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0mnSV(ikl) =  Z0mnSV(ikl)    *LISmsk              ! Ice and  Land
+     .                  +Z0mSea      *(1-LISmsk)             ! Ice-Free Ocean
+c #OR.                  +Z0roSV(ikl)                         ! Subgrid  Topogr.
+
+! GIS  Roughness Length
+! ^^^^^^^^^^^^^^^^^^^^^
+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.))) !
+
+! Mom. Roughness Length, Instantaneous OR Box Moving Average in Time
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0m_SV(ikl) =  Z0mnSV(ikl)                         ! Z0mnSV  instant.
+c #ZM     Z0m_SV(ikl) =  Z0mmSV(ikl)                         ! Z0mnSV  Average
+
+! Corrected Threshold Friction Velocity before Erosion    ! Marticorena and
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^    ! Bergametti 1995
+c #BS     Z0e_SV(ikl) =   min(Z0m_SV(ikl),Z0e_SV(ikl))       !
+c #MB     f_eff=    log(0.35*(0.1        /Z0e_SV(ikl))**0.8) ! JGR 100
+c #MB     f_eff=1.-(log(      Z0m_SV(ikl)/Z0e_SV(ikl)      ))! (20) p. 16420
+c #MB.            /(max(      f_eff      ,eps6             ))! p.16426 2nd ?
+c #MB     f_eff=    max(      f_eff      ,eps6              )! CONTROL
+! #mB     f_eff=2.0*max(      f_eff      ,eps6              )! TUNING
+c #MB     f_eff=    min(      f_eff      ,un_1              )!
+c #MB     usthSV(ikl) =       usthSV(ikl)/f_eff              !
+
+
+! Roughness Length for Scalars
+! ----------------------------
+
+          Z0hnSV(ikl) =     Z0mnSV(ikl)/  7.4
+c #SH     Z0hnSV(ikl) =     Z0mnSV(ikl)/100.0
+!                           Z0h = Z0m  /100.0   over the Sahel
+!                                              (Taylor & Clark, QJRMS 127,p864)
+
+c #RN     rstar       =     Z0mnSV(ikl) * us__SV(ikl) / A_MolV
+c #RN     rstar       = max(eps6,min(rstar,R_1000))
+c #RN     alors       =          log(rstar)   
+c #RN     rstar0      = 1.250e0 * max(zer0,sign(un_1,0.135e0 - rstar))
+c #RN.                +(1.      - max(zer0,sign(un_1,0.135e0 - rstar)))
+c #RN.                *(0.149e0 * max(zer0,sign(un_1,2.500e0 - rstar)) 
+c #RN.                + 0.317e0 
+c #RN.                *(1.      - max(zer0,sign(un_1,2.500e0 - rstar))))      
+c #RN     rstar1      = 0.      * max(zer0,sign(un_1,0.135e0 - rstar))
+c #RN.                +(1.      - max(zer0,sign(un_1,0.135e0 - rstar)))
+c #RN.                *(-0.55e0 * max(zer0,sign(un_1,2.500e0 - rstar)) 
+c #RN.                - 0.565
+c #RN.                *(1.      - max(zer0,sign(un_1,2.500e0 - rstar))))
+c #RN     rstar2      = 0.      * max(zer0,sign(un_1,0.135e0 - rstar))
+c #RN.                +(1.      - max(zer0,sign(un_1,0.135e0 - rstar)))
+c #RN.                *(0.      * max(zer0,sign(un_1,2.500e0 - rstar)) 
+c #RN.                - 0.183
+c #RN.                *(1.00    - max(zer0,sign(un_1,2.500e0 - rstar))))
+c #RN     Z0hnSV(ikl) = max(zer0
+c #RN.                , sign(un_1,zzsnsv(ikl,isnoSV(ikl))-eps6)) 
+c #RN.                * exp(rstar0+rstar1*alors+rstar2*alors*alors)
+c #RN.                * 0.001e0 + Z0hnSV(ikl) * ( 1. - max(zer0   
+c #RN.                , sign(un_1,zzsnsv(ikl,isnoSV(ikl))-eps6)))
+
+          Z0hnSV(ikl) =     Z0hSea             *(1-LISmsk) ! Ice-free Ocean
+     .                +     Z0hnSV(ikl)        *   LISmsk  ! Ice and  Land
+
+          Z0h_SV(ikl) =     Z0hnSV(ikl)
+c #ZM     Z0h_SV(ikl) =     Z0hmSV(ikl)
+
+
+! Contributions of the Roughness Lenghths to the neutral Drag Coefficient
+! -----------------------------------------------------------------------
+
+c #MT     Z0m_SV(ikl) = max(2.0e-6     ,Z0m_SV(ikl)) ! Min Z0_m (Garrat Scheme)
+          sqrCm0(ikl) = log(za__SV(ikl)/Z0m_SV(ikl))
+          sqrCh0(ikl) = log(za__SV(ikl)/Z0h_SV(ikl))
+
+! OUTPUT of SnowFall, Roughness Length and Drag Coefficients
+! #sf     IF (ikl.EQ.1) write(6,6661) dsn_SV(ikl),us__SV(ikl),Z0SaSi
+! #sf.                        ,Z0Sa_N,Z0SaSV(ikl),Z0m_Sn,Z0m_SV(ikl)
+ 6661     format(20x,7f9.6)
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           of Roughness Length and Drag Coefficients
+! #sz     IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #sz.        nn__SV(ikl).EQ.nwr_SV)
+! #sz.    write(6,6600)  za__SV(ikl) , Z0m_SV(ikl)
+! #sz.                  ,sqrCm0(ikl) , za__SV(ikl)/Z0m_SV(ikl)
+! #sz.                  ,Z0SaSV(ikl) , Z0h_SV(ikl)
+! #sz.                  ,sqrCh0(ikl) , za__SV(ikl)/Z0h_SV(ikl)
+ 6600     format(/,' ** SISVAT     *0  '
+     .            ,'  za__SV  = ',e12.4,'  Z0m_SV  = ',e12.4
+     .            ,'  sqrCm0  = ',e12.4,'  Za/Z0m  = ',e12.4
+     .          ,/,'                   '
+     .            ,'  Z0SaSV  = ',e12.4,'  Z0h_SV  = ',e12.4
+     .            ,'  sqrCh0  = ',e12.4,'  Za/Z0h  = ',e12.4)
+
+
+! Vertical Stability Correction
+! -----------------------------
+
+! Surface/Canopy Temperature
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Tsrfsv(ikl) = Sigmsv(ikl) * TvegSV(ikl)
+     .          + (1. - Sigmsv(ikl))* TsisSV(ikl,isnoSV(ikl))
+        END DO
+
+! Aerodynamic Resistance
+! ^^^^^^^^^^^^^^^^^^^^^^
+c #CP   IF            (SnoMod.AND.ColPrt)                           THEN
+
+!                **********
+c #CP       call ColPrt_SBL
+!                **********
+
+c #CP   ELSE
+c #MT    IF           (Garrat)                                      THEN
+
+!                **********
+c #MT       call SISVAT_SBL
+!                **********
+
+c #MT    ELSE
+
+!                **********
+            call SISVATeSBL
+!                **********
+
+c #MT    END IF
+c #CP   END IF
+
+
+! Canopy Energy Balance
+! =====================
+
+!            **********
+        call SISVAT_TVg
+! #e1.                 (ETVg_d)
+!            **********
+
+
+! Surface/Canopy Temperature
+! ==========================
+
+        DO ikl=1,knonv
+          Tsrfsv(ikl) = Sigmsv(ikl) * TvegSV(ikl)
+     .          + (1. - Sigmsv(ikl))* TsisSV(ikl,isnoSV(ikl))
+        END DO
+
+
+! Soil   Energy Balance
+! =====================
+
+!            **********
+        call SISVAT_TSo
+! #e1.                 (ETSo_0,ETSo_1,ETSo_d)
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_TSo  ',0)
+!            **********
+
+
+! Canopy Water  Balance
+! =====================
+
+! 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
+
+!            **********
+        call SISVAT_qVg
+!            **********
+
+
+! OUTPUT/Verification: H2O    Conservation: Vegetation Forcing
+! #m0   DO ikl=1,knonv
+! #m0     Watsvd(ikl) =     (Watsvd(ikl)           ! Canopy Precip. IN
+! #m0.                      -drr_SV(ikl)           ! Canopy Precip. OUT
+! #m0.                      -Evp_sv(ikl))* dt__SV  ! Canopy Water Evap.
+! #m0   END DO
+
+
+! Melting / Refreezing in the Snow Pack
+! =====================================
+
+      IF (SnoMod)                                                 THEN
+
+!            **********
+        call SISVAT_qSn
+     .                 (
+! #e1.                  EqSn_0,EqSn_1,EqSn_d
+! #m1.                 ,SIsubl,SImelt,SIrnof
+     .                 )
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_qSn  ',0)
+!            **********
+
+! OUTPUT in SISVAT for ikl = 1 (preferably for Stand Alone Version)
+! OUTPUT           for SnowFall and Snow Buffer
+! #s2   IF (knonv>0) THEN
+! #s2   IF          (isnoSV(1) .GT. 0)
+! #s2.  write(6,6007)isnoSV(1),    dsn_SV(1) *dt__SV + BufsSV(1),
+! #s2.              (dzsnSV(1,isn)*ro__SV(1,isn),isn=1,isnoSV(1))
+! #s2   END IF
+ 6007   format(i3,'  dsn+Buf=',f6.2,6x,'q dz *ro =',10f6.2,
+     .                                       (/,35x,10f6.2))
+
+
+! 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
+
+
+! OUTPUT/Verification: * Mass Conservation: Mass (below the Canopy) and Forcing
+! #m1   DO ikl=1,knonv
+! #m1     SIWa_f(ikl) =(drr_SV(ikl) + dsn_SV(ikl))   *dt__SV         ![mm w.e.]
+! #m1     SIWe_f(ikl) = dbs_SV(ikl)                                  !
+! #m1     SIWm_1(ikl) = BufsSV(ikl) + HFraSV(ikl)    *rhoIce         !
+! #m1   DO isn=1,nsno                                                !
+! #m1     SIWm_1(ikl) = SIWm_1(ikl) + dzsnSV(ikl,isn)*ro__SV(ikl,isn)!
+! #m1   END DO                                                       !
+! #m1   END DO                                                       !
+
+      END IF
+
+
+! Soil   Water  Balance
+! =====================
+
+!            **********
+        call SISVAT_qSo
+! #m0.                 (Wats_0,Wats_1,Wats_d)
+!            **********
+
+
+! Surface/Canopy Fluxes
+! =====================
+
+        DO ikl=1,knonv
+          IRdwsv(ikl)=tau_sv(ikl) *IRd_SV(ikl)*Eso_sv(ikl) ! Downward IR
+     .          +(1.0-tau_sv(ikl))*IRd_SV(ikl)*Evg_sv(ikl) ! 
+          IRupsv(ikl) =      IRupsv(ikl)                   ! Upward   IR
+     .                + 0.5 *IRv_sv(ikl) * (1.-tau_sv(ikl))!
+          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) *CpdAir)          !
+          uqs_SV(ikl) =     (HLv_sv(ikl) +HLs_sv(ikl))     ! u*q*
+     .                     /(rhT_SV(ikl) *LhvH2O)          !
+
+! Surface/Canopy Temperature
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Tsrfsv(ikl) = Sigmsv(ikl) * TvegSV(ikl)
+     .          + (1. - Sigmsv(ikl))* TsisSV(ikl,isnoSV(ikl))
+        END DO
+
+
+! Snow Pack Properties (sphericity, dendricity, size)
+! ===================================================
+
+      IF (SnoMod)                                                 THEN
+
+!            **********
+        call SISVAT_GSn
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_GSn  ',0)
+!            **********
+
+
+! Surficial Water Freezing, including that of a Water Surface (isotSV=0)
+! ======================================================================
+
+
+      END IF
+
+
+! OUTPUT
+! ======
+
+c #E0   DO ikl=1,knonv
+c #E0   IF (lwriSV(ikl).ne.0)                                     THEN
+c #E0           noUNIT =  no__SV(lwriSV(ikl))
+c #E0     write(noUNIT,5001)
+c #E0.       (SoSosv(ikl)+SoCasv(ikl))*sol_SV(ikl),
+c #E0.        IRdwsv(ikl),IRu_SV(ikl),
+c #E0.        HSv_sv(ikl)+HSs_sv(ikl),
+c #E0.        HLv_sv(ikl)+HLs_sv(ikl), TaT_SV(ikl),
+c #E0.        dsn_SV(ikl)*3.6e3,       drr_SV(ikl)*3.6e3,
+c #E0.        SoSosv(ikl)             *sol_SV(ikl),
+c #E0.                    IRv_sv(ikl) *0.5,
+c #E0.        HSv_sv(ikl),HLv_sv(ikl), TvegSV(ikl),
+c #E0.                    SoCasv(ikl) *sol_SV(ikl),
+c #E0.        HSs_sv(ikl),HLs_sv(ikl), TsisSV(ikl,isnoSV(ikl)) 
+ 5001     format(
+     .         '        |Net Solar| IR Down | IR Up   | HS/Dwn=+|',
+     .          ' HL/Dwn=+| Temper. |         |  Snow  |  Rain  |',
+     .       /,'        | [W/m2]  | [W/m2]  | [W/m2]  | [W/m2]  |',
+     .          ' [W/m2]  | [K]     |         | [mm/h] | [mm/h] |',
+     .       /,' -------+',7('---------+'),2('--------+'),
+     .       /,' SISVAT |',f8.1,' |',f8.1,' |',f8.1,' |',f8.1,' |',
+     .                     f8.1,' |A',f7.2,' |', 8x ,' |',2(f7.2,' |'),
+     .       /,' Canopy |',f8.1,' |', 8x ,' |',f8.1,' |',f8.1,' |',
+     .                     f8.1,' |',f8.2,' |', 8x ,' |',2( 7x ,' |')
+     .       /,' Soil   |',f8.1,' |', 8x ,' |', 8x ,' |',f8.1,' |',
+     .                     f8.1,' |',f8.2,' |', 8x ,' |',2( 7x ,' |'))
+
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1     Enrsvd(ikl) = Enrsvd(ikl)                            ! Up Surf. IR
+! #e1.                + IRs_SV(ikl)                            ! Offset
+! #e1.        + (      (SoSosv(ikl)                            ! Net   Solar
+! #e1.                 +SoCasv(ikl)) *sol_SV(ikl)              !            
+! #e1.          +                     IRdwsv(ikl)              ! Downward IR
+! #e1.          +                     IRupsv(ikl)              ! Upward   IR
+! #e1.          +                     HSv_sv(ikl)+HSs_sv(ikl)  ! Sensible
+! #e1.          +                     HLv_sv(ikl)+HLs_sv(ikl)) ! Latent
+
+! #e1     write(noUNIT,5002)           Enrsvd(ikl),
+! #e1.                   ETSo_0(ikl),  ETSo_d(ikl),
+! #e1.                   ETSo_0(ikl)+  ETSo_d(ikl), ETSo_1(ikl),
+! #e1.                   EqSn_0(ikl)                            /dt__SV,
+! #e1.                   EqSn_d(ikl)                            /dt__SV,
+! #e1.                  (EqSn_1(ikl)-  EqSn_0(ikl)- EqSn_d(ikl))/dt__SV,
+! #e1.                   EqSn_1(ikl)                            /dt__SV
+ 5002     format(
+     .           ' -----------------+-------------------+', !
+     .            '-----------------+-+-----------------+', !
+     .          '-------------------+',                     !
+     .         /,' SOIL/SNOW/VEGET. |                   |', !
+     .            ' Power,  Forcing |                   |', ! Enrsvd
+     .          '                   |',                     ! 
+! #el.         /,' -----------------+-------------------+', !
+! #el.            '-----------------+-------------------+', !
+! #el.          '-------------------+',                     !
+     .         /,'                  |',   11x ,'        |', !
+     .                f9.2,' [W/m2] |',   11x ,'        |', ! Enrsvd
+     .                11x ,'        |',                     !
+     .         /,' -----------------+-------------------+', !
+     .            '-----------------+-------------------+', !
+     .          '-------------------+',                     ! 
+     .         /,' SOIL/SNOW  (TSo) | Energy/dt, Time 0 |', !        ETSo_0
+     .            ' Power,  Forcing |   Sum Tim.0+Forc. |', ! ETSo_d/ETSo_0+d
+     .          ' Energy/dt, Time 1 |',                     ! ETSo_1
+! #el.         /,' -----------------+-------------------+', !
+! #el.            '-----------------+-------------------+', !
+! #el.          '-------------------+',                     !
+     .         /,'                  |',  f11.2,' [W/m2] |', !        ETSo_0
+     .                f9.2,' [W/m2] |',  f11.2,' [W/m2] |', ! ETSo_d/ETSo_0+d
+     .               f11.2,' [W/m2] |',                     ! ETSo_1
+     .         /,' -----------------+-------------------+', !
+     .            '-----------------+-------------------+', !
+     .          '-------------------+',                     !
+     .         /,'      SNOW  (qSn) | Energy/dt, Time 0 |', ! EqSn_0/dt
+     .            ' Power,  Excess  |   D(Tim.1-0-Forc.)|', ! EqSn_d/dt, 1-0-d
+     .          ' Energy/dt, Time 1 |',                     ! EqSn_1/dt
+! #el.         /,' -----------------+-------------------+', !
+! #el.            '-----------------+-------------------+', !
+! #el.          '-------------------+',                     !
+     .         /,'                  |',  f12.2, '[W/m2] |', ! EqSn_0/dt
+     .                f9.2,' [W/m2] |',  f11.2,' [W/m2] |', ! EqSn_d/dt, 1-0-d
+     .               f12.2, '[W/m2] | ',                    ! EqSn_1/dt
+     .         /,' -----------------+-------------------+', !
+     .            '-----------------+-------------------+', !
+     .          '-------------------+')                     !
+
+! #e1             EnsBal = ETSo_1(ikl)-(ETSo_0(ikl)+Enrsvd(ikl))
+! #e1             EnvBal = Enrsvd(ikl)- ETVg_d(ikl)
+! #e1     IF (abs(EnsBal).gt.5.e-1 
+! #e2.    .OR.lwriSV(ikl).eq.    2 
+! #e1.                            )                                 THEN
+! #e1       write(6,6001) daHost,i___SV(lwriSV(ikl)),
+! #e1.                           j___SV(lwriSV(ikl)),
+! #e1.                           n___SV(lwriSV(ikl)),
+! #e1.                           ETSo_1(ikl),ETSo_0(ikl),ETSo_d(ikl),
+! #e1.                           ETSo_1(ikl)-ETSo_0(ikl)-ETSo_d(ikl),
+! #e1.                           Enrsvd(ikl),ETVg_d(ikl),ETSo_d(ikl),
+! #e1.                           Enrsvd(ikl)-ETVg_d(ikl)-ETSo_d(ikl)
+ 6001       format(a18,3i4,' (EB1'           ,f15.6,
+     .                ')  - [(EB0           ',f15.6,')',
+     .               /,55x,'+(ATM->Snow/Soil',f15.6,')] ',
+     .                     '= EBAL'          ,f15.6,' [W/m2]',
+     .               /,55x,' (ATM->SISVAT'   ,f18.6,
+     .               /,55x,'- Veg. ImBal.',   f18.6,')  ',
+     .               /,55x,'- ATM->SnoSol',   f18.6,')  ',
+     .                     '= ????'          ,f15.6,' [W/m2]')
+! #e1           noEBal = noEBal + 1
+! #e2           noEBal = noEBal - 1
+! #e1       IF (noEBal.GE.       10) stop 'TOO MUCH ENERGY IMBALANCES'
+! #e1     END IF
+
+
+! OUTPUT/Verification: * Mass Conservation: Budget [mm w.e.]
+! #m1     write(noUNIT,5010) 
+! #m1.             SIWm_0(ikl),  SIWa_i(ikl)-SIWa_f(ikl)
+! #m1.            ,SIWm_0(ikl)+  SIWa_i(ikl)-SIWa_f(ikl)
+! #m1.                          +SIWe_i(ikl)-SIWe_f(ikl)
+! #m1.                          +SIsubl(ikl)
+! #m1.                          -SImelt(ikl)
+! #m1.                          -SIrnof(ikl)
+! #m2.                          +SIvAcr(ikl)    
+! #m1.            ,SIWm_1(ikl),  SIWe_i(ikl)-SIWe_f(ikl)
+! #m1.            ,              SIsubl(ikl)
+! #m1.            ,             -SImelt(ikl)
+! #m1.            ,             -SIrnof(ikl)
+! #m2.            ,              SIvAcr(ikl)
+ 5010     format(' SNOW             |   Snow,   Time 0  |',
+     .            ' Snow,   Forcing |           Sum     |',
+     .          '   Snow,   Time 1  |',
+! #el.         /,' -----------------+-------------------+',
+! #el.            '-----------------+-------------------+',
+! #el.          '-------------------+',
+     .         /,'                  |',    f13.3,' [mm] |',
+     .           ' A',  f9.3,' [mm] |',    f13.3,' [mm] |',
+     .                 f13.3,' [mm] |',
+     .         /,'                  |',     13x ,'      |',
+     .           ' E',  f9.3,' [mm] |',     13x ,'      |',
+     .                  13x ,'      |',
+     .         /,'                  |',     13x ,'      |',
+     .           ' S',  f9.3,' [mm] |',     13x ,'      |',
+     .                  13x ,'      |',
+     .         /,'                  |',     13x ,'      |',
+     .           '(M',  f9.3,' [mm])|  (included in A)  |',
+     .                  13x ,'      |',
+     .         /,'                  |',     13x ,'      |',
+     .           ' R',  f9.3,' [mm] |',     13x ,'      |',
+     .                  13x ,'      |',
+! #m2.         /,'                  |',     13x ,'      |',
+! #m2.           ' O',  f9.3,' [mm] |',     13x ,'      |',
+! #m2.                  13x ,'      |',
+     .         /,' -----------------+-------------------+',
+     .            '-----------------+-------------------+',
+     .          '-------------------+')
+! #m1             SnoBal = SIWm_1(ikl)-(SIWm_0(ikl)
+! #m1.                                 +SIWa_i(ikl)-SIWa_f(ikl)
+! #m1.                                 +SIWe_i(ikl)-SIWe_f(ikl))
+! #m1.                                 -SIsubl(ikl)
+! #m1.                                 +SIrnof(ikl)
+! #m2.                                 -SIvAcr(ikl) 
+! #m1     IF (abs(SnoBal).gt.eps6)                                  THEN
+! #m1       write(6,6010) daHost,i___SV(lwriSV(ikl)),
+! #m1.                           j___SV(lwriSV(ikl)),
+! #m1.                           n___SV(lwriSV(ikl)),
+! #m1.                           SIWm_1(ikl),SIWm_0(ikl),
+! #m1.                           SIWa_i(ikl),SIWa_f(ikl),
+! #m1.                           SIWe_i(ikl),SIWe_f(ikl),
+! #m1.                           SIsubl(ikl),SImelt(ikl),
+! #m2.                           SIrnof(ikl),SIvAcr(ikl),
+! #m1.                           SnoBal
+ 6010       format(a18,3i4,' (MB1'        ,f12.6,
+     .                 ') - [(MB0        ',f12.6,        15x,')',
+     .               /,51x,'+(ATM Forcing',f12.6,' - ',f12.6,')',
+     .               /,51x,'+(BLS Forcing',f12.6,' - ',f12.6,')',
+     .               /,51x,'-(Depo/Sublim',f12.6,        15x,')',
+     .               /,51x,' !Melting    ',f12.6,'  included in A!',
+     .               /,51x,'+(Run  OFF   ',f12.6,        15x,')',
+! #m2.               /,51x,'-(Sea-Ice Acr',f12.6,        15x,')',
+     .               /,29x,'= *BAL'       ,f12.6,      ' [mm w.e.]')
+! #m1           noSBal = noSBal + 1
+! #m1       IF (noSBal.GE.       10) stop 'TOO MUCH SNOW MASS IMBALANCE'
+! #m1     END IF
+
+
+! OUTPUT/Verification: H2O    Conservation: Water  Budget
+! #m0     Watsv0(ikl) =  Watsv0(ikl)                    ! Canopy Water Cont.
+! #m0.                 + Wats_0(ikl)                    ! Soil   Water Cont.
+! #m0     Watsvd(ikl) =  Watsvd(ikl)                    ! Canopy Forcing
+! #m0.                 + Wats_d(ikl)                    ! Soil   Forcing
+
+! #m0     write(noUNIT,5003) 
+! #m0.                   Wats_0(ikl),  Wats_d(ikl),
+! #m0.                   Wats_0(ikl)+  Wats_d(ikl),    Wats_1(ikl),
+! #m0.                   Watsv0(ikl),  Watsvd(ikl), 
+! #m0.                   Watsv0(ikl)+  Watsvd(ikl),    Wats_1(ikl)
+! #m0.                                                +rrCaSV(ikl)
+ 5003     format(' SOIL/SNOW  (qSo) |   Water,  Time 0  |',
+     .            ' Water,  Forcing |           Sum     |',
+     .          '   Water,  Time 1  |',
+! #el.         /,' -----------------+-------------------+',
+! #el.            '-----------------+-------------------+',
+! #el.          '-------------------+',
+     .         /,'                  |',    f13.3,' [mm] |',
+     .                 f11.3,' [mm] |',    f13.3,' [mm] |',
+     .                 f13.3,' [mm] |',
+     .         /,' -----------------+-------------------+',
+     .            '-----------------+-------------------+',
+     .          '-------------------+',
+     .         /,' SOIL/SNOW/VEGET. |   Water,  Time 0  |',
+     .            ' Water,  Forcing |           Sum     |',
+     .          '   Water,  Time 1  |',
+! #el.         /,' -----------------+-------------------+',
+! #el.            '-----------------+-------------------+',
+! #el.          '-------------------+',
+     .         /,'                  |',    f13.3,' [mm] |',
+     .                 f11.3,' [mm] |',    f13.3,' [mm] |',
+     .                 f13.3,' [mm] |',
+     .         /,' -----------------+-------------------+',
+     .            '-----------------+-------------------+',
+     .          '-------------------+')
+
+! #m0             WatBal = Wats_1(ikl)+rrCaSV(ikl)
+! #m0.                   -(Watsv0(ikl)+Watsvd(ikl))
+! #m0     IF (abs(WatBal).gt.eps6)                                  THEN
+! #m0       write(6,6002) daHost,i___SV(lwriSV(ikl)),
+! #m0.                           j___SV(lwriSV(ikl)),
+! #m0.                           n___SV(lwriSV(ikl)),
+! #m0.                           Wats_1(ikl),rrCaSV(ikl),
+! #m0.                           Watsv0(ikl),Watsvd(ikl),WatBal,
+! #m0.                           Wats_1(ikl),
+! #m0.                           Wats_0(ikl),Wats_d(ikl),
+! #m0.               Wats_1(ikl)-Wats_0(ikl)-Wats_d(ikl)
+ 6002       format(30x,' NEW Soil Water',3x,' Canopy   Water',3x,
+     .                 ' OLD SVAT Water',4x,' FRC SVAT Water',
+     .           /,a18,3i4,f15.6,' + ' ,f15.6,' - ' ,f15.6,
+     .                           ' -  ',f15.6,'    ', 15x ,'    ',
+     .      /,31x,'= ',f12.6,' [mm] (Water Balance)',
+     .           /,30x,' NEW Soil Water',3x,'               ',3x,
+     .                 ' OLD Soil Water',4x,' FRC Soil Water',
+     .           /,30x,f15.6,'   ' , 15x ,' - ' ,f15.6,
+     .                       ' -  ',f15.6,'    ', 15x ,'    ',
+     .      /,31x,'= ',f12.6,' [mm] (3 terms SUM)')
+! #m0           noWBal = noWBal + 1
+! #m0       IF (noWBal.GE.       10) stop 'TOO MUCH WATER  IMBALANCES'
+! #m0     END IF
+
+
+! Water/Temperature Profiles
+! --------------------------
+
+c #E0       write(noUNIT,5004)
+ 5004       format(' -----+--------+--+-----+--------+----+---+',
+     .  '--------+----+---+--------+------+-+--------+--------+',
+     .           /,'    n |     z  |     dz |     ro |    eta |',
+     .  '     T  |     G1 |     G2 | Extinc |        | HISTORY|',
+     .           /,'      |    [m] |    [m] | [kg/m3]| [m3/m3]|',
+     .  '    [K] |    [-] |    [-] |    [-] |        |   [-]  |',
+     .           /,' -----+--------+--------+--------+--------+',
+     .  '--------+--------+--------+--------+--------+--------+')
+c #E0       write(noUNIT,5005) rusnSV(ikl),albisv(ikl)
+ 5005       format('      |        |        |        |W',f6.3,' |',
+     .  '        |        |        |A',f6.3,' |        |        |')
+c #E0       write(noUNIT,5015)
+c #E0.                    (isn,zzsnsv(ikl,isn),dzsnSV(ikl,isn),
+c #E0.                         ro__SV(ikl,isn),eta_SV(ikl,isn),
+c #E0.                         TsisSV(ikl,isn),
+c #E0.                         G1snSV(ikl,isn),G2snSV(ikl,isn),
+c #E0.                         sEX_sv(ikl,isn),istoSV(ikl,isn),
+c #E0.                     isn=isnoSV(ikl),1,-1)
+ 5015       format((i5,' |',2(f7.3,' |'),               f7.1,' |',
+     .           f7.3,' |' ,  f7.2,' |', 2(f7.1,' |'),  f7.3,' |',
+     .            7x ,' |' ,  i5,'   |'                          ))
+c #E0       write(noUNIT,5006)
+ 5006       format(' -----+--------+--------+--------+--------+',
+     .  '--------+--------+--------+--------+--------+--------+')
+c #E0       write(noUNIT,5007) TBr_sv(ikl),
+c #E0.                         TvegSV(ikl),rrCaSV(ikl)*1.e3,
+c #E0.                         EvT_sv(ikl)*86.4e3
+ 5007       format(' Brgh |',4(8x,'|'),  f7.2,' | [micm] |',4(8x,'|'),
+     .           /,' VEGE |',4(8x,'|'),2(f7.2,' |'),        2(8x,'|'),
+     .                                   f7.3,' |',           8x,'|' )
+c #E0       write(noUNIT,5014)
+ 5014       format(' -----+--------+--------+--------+--------+',
+     .  '--------+--------+--------+--------+--------+--------+',
+     .           /,'    n |        |     dz |        |    eta |',
+     .  '     T  |        |        |        | Root W.| W.Flow |',
+     .           /,'      |        |    [m] |        | [m3/m3]|',
+     .  '    [K] |        |        |        | [mm/d] | [mm/h] |',
+     .           /,' -----+--------+--------+--------+--------+',
+     .  '--------+--------+--------+--------+--------+--------+')
+
+c #E0       write(noUNIT,5008)
+c #E0.                    (isl,    LSdzsv(ikl)*dz_dSV(    isl),
+c #E0.                                         eta_SV(ikl,isl),
+c #E0.                                         TsisSV(ikl,isl),
+c #E0.                                  86.4e3*Rootsv(ikl,isl),
+c #E0.                                   3.6e3*Khydsv(ikl,isl),
+c #E0.                     isl=0,-nsol,-1)
+ 5008       format((i5,' |',   7x ,' |' ,  f7.3,' |' ,   7x ,' |',
+     .           f7.3,' |' ,  f7.2,' |', 2( 7x ,' |'),   7x ,' |',
+     .                                     f7.3,' |' ,  f7.2,' |'))
+c #E0       write(noUNIT,5006)
+c #E0       write(noUNIT,5009) RnofSV(ikl)* 3.6e3
+ 5009       format('      |',9(8x,'|'),f7.3,' |')
+c #E0       write(noUNIT,5006)
+c #E0   END IF
+c #E0   END DO
+
+! END  .main. (SISVAT)
+      return
+      end
+
+
+      subroutine SISVAT_BSn(BloMod)
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_BSn                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_BSn treats Snow Erosion and Deposition             |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: STANDARD Possibility                          |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^^^^^^^^^^^^                          |
+!     #BS: Explicit Cloud MICROPHYSICS: Blow. *(Snow)         Model        |
+!     #EM: Explicit Cloud MICROPHYSICS: de Montmollin Parameterizat.       |
+!     #MA: SNOW Model: Increased polar B* Mobility (Mann et al.2000)       |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option:                                               |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #BA: Budd et al.            1966, Ant.Res.Ser.9    u* BS Threshold   |
+!     #BY: Budd et al. 1966, 2~m Averag Blow. *(Snow)    Properties        |
+!     #AG: Snow Aging Col de Porte     (Brun et al.1991) discard BS at CdP |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # stdout               | #s2: OUTPUT of SnowFall, Snow Buffer          |
+!                          |      unit  6, SubRoutine  SISVAT_BSn, _qSn    |
+!   # stdout               | #b0: OUTPUT of Snow Erosion                   |
+!                          |      unit  6, SubRoutine  SISVAT_BSn **ONLY** |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! General Variables
+! =================
+
+      USE PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VARxSV
+      USE VARySV
+
+      IMPLICIT NONE
+
+      logical  BloMod
+
+
+! Local Variables
+! ===============
+
+      logical           BlowIn
+      common/llocal_BSn/BlowIn
+
+      real              FacSBS,FacUBS        !
+      real              Por_BS               ! Snow       Porosity
+      real              SheaBS               !
+      real              rCd10n               ! GM97:   assumed neutral stabil.
+      common/rlocal_BSn/FacSBS,FacUBS,       !
+     .                  Por_BS,SheaBS,rCd10n !
+
+      integer  ikl   ,isn   ,isnMAX,is2      !
+      integer  Mobilm,Mobiln                 !
+      integer  Mobile(klonv)                 !
+
+      real     DendOK                        ! Dendricity Switch
+      real     SaltOK                        ! Saltation  Switch
+      real     SnowOK                        ! Pack Top   Switch
+      real     SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
+      real     ShearX                        ! Arg. Max Shear Stress
+      real     SaltSU,Salt_U                 !
+      real     ArgFac,Fac_Mo                 !
+      real     FacRBS,FacTBS                 !
+      real     ArguSi                        !
+      real     SaltSI(klonv,nsno)            ! Snow Drift Index
+      real     hdrift                        ! Inverse erodibl.Snow Lay.Thickn.
+      real     h_mmWE                        ! Eroded Snow Layer Min Thickness
+      real     tfv_vk                        ! * Fall Veloc. / Von Karman Cst
+      real     sdrift(klonv,nsno)            !
+      real     xdrift(klonv)                 !
+      real     zdrift(klonv)                 !
+      real     tdepos(klonv)                 !
+      real     zdepos(klonv,nsno)            !
+      real     dbsaux(klonv)                 ! Drift Amount   (Dummy Variable)
+      real     dzweqo,dzweqn,bsno_x          ! 
+      real                   hsno_x          !
+      real     PorSno,Salt_f,PorRef,ro_new   !
+      real     MIN_Mo                        ! Minimum Mobility Fresh Fallen *
+      real     AgBlow                        ! Snow Mobility    Time  Scale
+      real     snofOK                        ! Threshd Snow Fall
+
+      integer  isagr1(klonv)                 ! 1st     Layer History
+      integer  isagr2(klonv)                 ! 2nd     Layer History
+
+      real     WEagre(klonv)                 ! Snow Water Equivalent Thickness
+      real     Agrege(klonv)                 ! 1. when Agregation constrained
+      real     dzagr1(klonv)                 ! 1st     Layer Thickness
+      real     dzagr2(klonv)                 ! 2nd     Layer Thickness
+      real     T_agr1(klonv)                 ! 1st     Layer Temperature
+      real     T_agr2(klonv)                 ! 2nd     Layer Temperature
+      real     roagr1(klonv)                 ! 1st     Layer Density
+      real     roagr2(klonv)                 ! 2nd     Layer Density
+      real     etagr1(klonv)                 ! 1st     Layer Water Content
+      real     etagr2(klonv)                 ! 2nd     Layer Water Content
+      real     G1agr1(klonv)                 ! 1st     Layer Dendricity/Spher.
+      real     G1agr2(klonv)                 ! 2nd     Layer Dendricity/Spher.
+      real     G2agr1(klonv)                 ! 1st     Layer Sphericity/Size
+      real     G2agr2(klonv)                 ! 2nd     Layer Sphericity/Size
+      real     agagr1(klonv)                 ! 1st     Layer Age
+      real     agagr2(klonv)                 ! 2nd     Layer Age
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Snow Erosion Variables
+! #b0 real     Sno0WE,Sno1WE                 ! Snow Mass before/after Erosion
+! #b0 real     SnodWE                        ! Snow Mass              Erosion
+
+
+! DATA
+! ====
+
+      data     AgBlow  / 1.00     /          ! 1 Day (F.Domine, pers.communic.)
+      data     SaltMx  /-5.83e-2  /          !
+      data     FacRBS  / 2.868    /          !
+      data     FacTBS  / 0.085    /          !
+      data     hdrift  / 1.00e+1  /          ! Inverse erodibl.Snow Lay.Thickn.
+      data     h_mmWE  / 0.01e00  /          ! Eroded Snow Layer Min Thickness
+      data     tfv_vk  / 5.10e-1  /          ! tfv (Terminal Fall Veloc. =.216) 
+                                             ! /vk (Von Karman Constant  =.4  )
+                                             ! (Wamser & Lykosov,   1995 
+                                             !  Contr.Atm.Phys. 68, p.90)
+
+! Initialization
+! ==============
+
+      IF (.NOT.BlowIn)                                             THEN
+               BlowIn = .true.
+               FacSBS =  1.             / FacRBS
+               FacUBS =  1.             / FacTBS
+               Por_BS =  1.             - BSnoRo/      rhoIce
+               SheaBS =                   Por_BS/(1.00-Por_BS)
+!              SheaBS =  Arg(sqrt(shear = max shear stress in snow)):
+!              shear  =  3.420d00 * exp(-(Por_BS      +Por_BS)
+!    .                                  /(1.00        -Por_BS))
+!              SheaBS :  see de Montmollin         (1978),
+!                        These Univ. Sci. Medic. Grenoble, Fig. 1 p. 124
+
+             DO ikl=1,knonv             ! Parameterization of u*th
+               rCd10n      =  1./  26.5 ! was developed from observations made
+             END DO                     ! during assumed neutral conditions
+                                         
+               write(6,5000)  1./  rCd10n
+ 5000          format(/,' Blowing Snow Model  Initialization     ',
+     .                /,' Vt / u*t =',f8.2,' (Neutral Assumption)',
+     .                /,'           ', 8x ,' (Budd assumes  26.5)',/)
+      END IF
+
+
+! Snow Age (Influence on Snow Erosion Threshold)
+! ==============================================
+
+c #BS DO isn=1,nsno
+c #BS DO ikl=1,knonv
+c #BS   agsnSV(ikl,isn) = agsnSV(ikl,isn) + dt__SV/86400.
+c #BS END DO
+c #BS END DO
+c #BS DO ikl=1,knonv
+c #BS   isn    = max(1 ,        isnoSV(ikl))
+c #BS   snofOK = max(0.,sign(1.,dsn_SV(ikl)-eps6))      !  Threshold=1.e-6
+c #BS   agsnSV(ikl,isn) =   (1.-snofOK) *agsnSV(ikl,isn)! ~0.1 mm w.e./day
+c #BS END DO
+      IF (.NOT.BloMod)                                     GO TO 1000
+c #AG STOP '?!&~@|@[#@#] --- INCONSISTANT SNOW AGE --- EMERGENCY STOP'
+ 1000 CONTINUE
+
+
+! EROSION
+! =======
+
+      DO isn = 1, nsno
+      DO ikl = 1,knonv
+
+! Below the high Snow Density Threshold  (ro__SV < BSnoRo)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        DendOK   =  max(zer0,sign(un_1,eps6-G1snSV(ikl,isn)  ))  !
+        SaltOK   =  min(1   , max(istdSV(2)-istoSV(ikl,isn),0))  !
+        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   =  SaltOK   * SnowOK
+        SaltM1   = -0.750e-2 * G1snSV(ikl,isn) 
+     .             -0.500e-2 * G2snSV(ikl,isn)+ 0.500e00
+!       SaltM1   :  Guyomarc'h & Merindol, 1997, Ann. Glac.
+!         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
+        SaltMo   = (DendOK   * SaltM1 + (1.-DendOK) *     SaltM2       )
+
+! Increased Mobility of Deposed (blown) Snow (Mann et al., 2000, JGR 105,
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  Fig.2 p.24496 & text below)
+        MIN_Mo   =  0.
+c #MA   MIN_Mo   =  0.6 * exp(-agsnSV(ikl,isn)                  /AgBlow)
+        SaltMo   =                                    max(SaltMo,MIN_Mo)
+
+        SaltMo   =  SaltOK   * SaltMo + (1.-SaltOK) * min(SaltMo,SaltMx)
+!       SaltMo   =  SaltOK   * SaltMo - (1.-SaltOK) *     0.9500 ! Tuning
+        SaltMo   =         max(SaltMo ,  eps6-un_1)
+
+        SaltSU   =     (1.00d0+SaltMo)     *FacSBS
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Snow Erosion Variables
+! #b0   Salt_U   =        -log(SaltSU)     *FacUBS
+! #b0   IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV        .AND.
+! #b0.      nn__SV(ikl).EQ.nwr_SV.AND.isn        .EQ.isnoSV(ikl))
+! #b0.    write(6,6010) isnoSV(ikl),G1snSV(ikl,isn)/G1_dSV
+! #b0.                             ,G2snSV(ikl,isn)/G1_dSV
+! #b0.                             ,ro__SV(ikl,isn),agsnSV(ikl,isn)
+! #b0.                             ,SaltM1, SaltM2, SaltMo, Salt_U
+! #b0.                             ,us__SV(ikl)   / rCd10n
+ 6010     format(/,'SISVAT_BSn',6x
+     .           ,6x,i3,2x,'G1         =',f6.3,'   G2         =',f7.3
+     .           ,      '   ro [kg/m3] =',f9.3,'   Age* [Day] =',f9.3
+     .           ,   /,27x,'SaltM1     =',f6.3,'   SaltM2     =',f7.3
+     .           ,      '   Mobility I.=',f9.3,'   Vt   [m/s] =',f9.3
+     .           ,   /,27x,'            ', 6x ,'               ', 7x
+     .           ,      '               ', 9x ,'   Vn10 [m/s] =',f9.3)
+
+! Above the high Snow Density Threshold  (ro__SV > BSnoRo)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        Por_BS      =  1.000       - ro__SV(ikl,isn)     /rhoIce
+        ShearX      =                Por_BS/max(eps6,un_1-Por_BS) 
+!       ShearX ==> Arg(sqrt(shear)) with shear = max shear stress in snow:
+!       shear       =  3.420d00 * exp(-(Por_BS      +Por_BS)
+!    .                                /max(eps6,un_1-Por_BS))
+!                      see de Montmollin         (1978),
+!                      These Univ. Sci. Medic. Grenoble, Fig. 1 p. 124
+
+! Influence of Density on Shear Stress if ro__SV > BSnoRo
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        ArgFac      =  max(zer0  ,SheaBS-ShearX)     !
+!       Fac_Mo      =  exp(       ArgFac       )     ! ** NOT ** tuned
+        Fac_Mo   =     exp(       ArgFac       )     ! = 1 if ro__SV < BSnoRo
+                                                     ! < 1 if ro__SV > BSnoRo
+! Snow Drift Index
+! ~~~~~~~~~~~~~~~~
+        SaltSU      =  max(eps6  ,    SaltSU)
+        SaltSU      =  exp(Fac_Mo*log(SaltSU))
+        ArguSi      =     -FacTBS              *us__SV(ikl)/rCd10n
+        SaltSI(ikl,isn) = (SaltSU-exp(ArguSi)) *FacRBS
+!       SaltSI          :  Generalization of the Snow Drift Index of                       
+!                          Guyomarc'h & Merindol (1997, Ann.Glaciol.)
+
+! Threshold Friction Velocity
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        SnowOK   =  1 -min(1,iabs(isn-isnoSV(ikl)))
+        Salt_U   =               -log(SaltSU)  *FacUBS
+!       Salt_U   :  Guyomarc'h & Merindol, 1997, Ann. Glac.
+
+        usthSV(ikl) =     SnowOK *   (Salt_U   *rCd10n)
+     .              + (1.-SnowOK)*    usthSV(ikl)
+
+c #BA   usthSV(ikl) =     SnowOK *   (Salt_U   /26.5)
+c #BA.              + (1.-SnowOK)*    usthSV(ikl)
+!       Us(U10)     :  Budd et al.            1966, Ant.Res.Ser.9
+!                 (see Pomeroy & Gray 1995 NHRI Sci.Rep.7(30)p.62)
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Snow Erosion Variables
+! #b0   IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV        .AND.
+! #b0.      nn__SV(ikl).EQ.nwr_SV.AND.isn        .EQ.isnoSV(ikl))
+! #b0.    write(6,6011)     Fac_Mo,Por_BS,SaltSI(ikl,isn),usthSV(ikl)
+ 6011     format(      27x,'Fac_Mo     =',f6.3,'   Por_BS     =',f7.3
+     .           ,      '   Drift    I.=',f9.3,'   ut*_0[m/s] =',f9.3)
+      END DO
+      END DO
+
+
+! Deepest Mobile Snow Layer
+! -------------------------
+
+      DO ikl = 1,knonv
+        Mobile(ikl) = nsno+1
+      END DO
+      DO isn =   nsno ,1,-1
+      DO ikl = 1,knonv
+        isnMAX      =       max(   1,          isnoSV(ikl)             )
+        isnMAX      =       min( isn,          isnMAX                  )
+        Mobiln      = isn * max(zer0,sign(un_1,SaltSI(ikl     ,isnMAX)))
+        Mobilm      =   1 - min(1   ,          Mobile(ikl) -1 -Mobiln)
+!       Mobilm      =   1   ONLY IF   Mobiln = Mobile(ikl) -1 (0 otherwise)
+
+        Mobile(ikl) =                 Mobilm * Mobiln 
+     .              +              (1-Mobilm)* Mobile(ikl)
+      END DO
+      END DO
+
+
+! Weighting the Amount of Snow to erode
+! -------------------------------------
+
+      DO ikl = 1,knonv
+        zdrift(ikl) = 0.0 
+        xdrift(ikl) = 0.0
+        dbsaux(ikl) = dbs_SV(ikl)
+      END DO
+
+      DO isn = 1, nsno
+      DO ikl = 1,knonv
+        zdrift(ikl)     =  zdrift(ikl)
+     .            + 0.50 * dzsnSV(ikl,isn) * (3.25  -SaltSI(ikl,isn))
+        sdrift(ikl,isn) =  SaltSI(ikl,isn)
+     .          *exp(  max(Ea_Min, -zdrift(ikl)     *hdrift     ))
+     .          *min(1,max(0     ,  isn +1          -Mobile(ikl)))
+     .          *min(1,max(0     ,  isnoSV(ikl)     -isn +1     ))
+!                Last 2 Lines force sdrift = 0 outside mobile Snow Layers
+     .          *      max(zer0, sign(un_1,         -dbs_SV(ikl)))
+!                Erosion is allowed only if available Blowing Snow
+        xdrift(ikl)     =           sdrift(ikl,isn) +xdrift(ikl)
+        zdrift(ikl)     =  zdrift(ikl)
+     .            + 0.50 * dzsnSV(ikl,isn) * (3.25  -SaltSI(ikl,isn))
+      END DO
+      END DO
+
+! Normalization
+! ~~~~~~~~~~~~~
+      DO isn = 1, nsno
+      DO ikl = 1,knonv
+        sdrift(ikl,isn) =  sdrift(ikl,isn) /max(eps6,xdrift(ikl))
+      END DO
+      END DO
+
+
+! Weighting the Amount of Snow to depose
+! --------------------------------------
+
+      DO ikl = 1,knonv
+        zdrift(ikl) = 0.0 
+        tdepos(ikl) = 0.0
+      END DO
+
+      DO isn = 1, nsno
+      DO ikl = 1,knonv
+        zdepos(ikl,isn) =      exp(-zdrift(ikl)   )
+     .          *min(1,max(0     ,  isn +1          -Mobile(ikl)))
+     .          *min(1,max(0     ,  isnoSV(ikl    ) -isn +1     ))
+!                Last 2 Lines force zdepos = 0 outside mobile Snow Layers
+        tdepos(ikl) = tdepos(ikl) + zdepos(ikl,isn)
+        zdrift(ikl) = zdrift(ikl) + dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+     .                                              /rhoWat
+      END DO
+      END DO
+
+! Normalization
+! ~~~~~~~~~~~~~
+      DO isn = 1, nsno
+      DO ikl = 1,knonv
+        zdepos(ikl,isn) = zdepos(ikl,isn) / max(eps6,tdepos(ikl))
+      END DO
+      END DO
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Snow Erosion Variables
+! #b0 DO ikl = 1,knonv
+! #b0   IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV        .AND.
+! #b0.      nn__SV(ikl).EQ.nwr_SV                          )        THEN
+! #b0     Sno0WE =   0.
+! #b0   DO isn=1,nsno
+! #b0     Sno0WE =   Sno0WE 
+! #b0.           +   dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+! #b0   END DO
+! #b0     write(6,6005)   Sno0WE                    ,dbs_SV(ikl)
+ 6005     format(
+     .      18x,'MB0',6x,'Sno1WE [mm]=',f9.3,19x,'0  dbs_SV [mm]=',f9.6)
+! #b0     SnodWE =   dbs_SV(ikl)
+! #b0   END IF
+! #b0 END DO
+
+
+! Weighted  Erosion (Erosion amount is distributed       ! dbs_SV decreases
+! -----------------  over the upper Snow Pack)           ! dzsnSV decreases
+
+      DO isn = 1, nsno
+      DO ikl = 1,knonv
+        SnowOK      = min(1,max(isnoSV(ikl)+1-isn ,0))      ! Snow Switch
+        dzweqo      = dzsnSV(ikl,isn) *ro__SV(ikl,isn)      ! [kg/m2, mm w.e.]
+        bsno_x      = dbsaux(ikl)     *sdrift(ikl,isn)
+        dzweqn      = dzweqo          +bsno_x
+        dzweqn  = max(dzweqn,          h_mmWE *SnowOK)
+        dbs_SV(ikl) = dbs_SV(ikl)    +(dzweqo -dzweqn)
+        dzsnSV(ikl,isn) =              dzweqn
+     .                       /max(eps6,ro__SV(ikl,isn))
+      END DO
+      END DO
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Snow Erosion Variables
+! #b0 DO ikl = 1,knonv
+! #b0   IF (ii__SV(ikl).EQ. 1 .AND.  jj__SV(ikl) .EQ. 1)            THEN
+! #b0     SnodWE =   SnodWE         -dbs_SV(ikl)
+! #b0     Sno1WE =   0.
+! #b0   DO isn=1,nsno
+! #b0     Sno1WE =   Sno1WE 
+! #b0.           +   dzsnSV(ikl,isn)*ro__SV(ikl,isn)
+! #b0   END DO
+! #b0     write(6,6006)Sno1WE      , dbs_SV(ikl)
+ 6006     format(
+     .      18x,'MB1',6x,'Sno1WE [mm]=',f9.3,19x,'1  dbs_SV [mm]=',f9.6)
+! #b0     write(6,6007)Sno1WE    ,SnodWE   ,Sno0WE,
+! #b0.                (Sno1WE    -SnodWE   -Sno0WE)     
+ 6007     format(
+     .      18x,'MB ',5x,'(After  [mm]=',f6.0, ')-(Erosion[mm]=', f7.3,
+     .                                         ')-(Before [mm]=', f9.3,
+     .                                         ')= Budget [mm]=', f9.6)
+! #b0   END IF
+! #b0 END DO
+
+
+! ACCUMULATION of BLOWN SNOW                             ! dsn_SV decreases
+! --------------------------                             ! dzsnSV increases
+
+        DO ikl = 1,knonv
+          tdepos(ikl) = dsn_SV(ikl) * dsnbSV(ikl) * dt__SV
+          WEagre(ikl) = 0.
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Snow Erosion Variables
+! #b0     IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV      .AND.
+! #b0.        nn__SV(ikl).EQ.nwr_SV.AND.0          .LT.isnoSV(ikl))
+! #b0.        write(6,6003) tdepos(ikl)  ,Mobile(ikl)
+ 6003         format(/,41x,'tdepos [-] =',f6.3,40x,'Mobil',i3
+     .              ,/,27x,'Salt.Index    sdrift'
+     .              ,      '    zdepos  ro__snow  ro_bsnow  roN_snow'
+     .              ,                '  dz__snow  dz_bsnow  dzN_snow'
+     .              ,                '  d___snow'
+     .              ,/,27x,'             [kg/m3]   [kg/m3]   [kg/m3]'
+     .              ,                '       [m]       [m]       [m]'
+     .              ,                '   [kg/m2]')
+        END DO
+
+      DO isn =     nsno,1,-1
+        DO ikl = 1,knonv
+          WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn)
+          isagr1(ikl) = istoSV(ikl,isn)
+          isagr2(ikl) = 0.
+
+! Density of deposited blown Snow
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          ro_new =                    BSnoRo
+
+! Density of deposited blown Snow (de Montmollin, 1978)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #EM     PorSno =      1.0d00     -  ro__SV(ikl,isn)
+c #EM.                             /  rhoIce
+c #EM     Salt_f =      usthSV(ikl)/  max(eps6,   us__SV(ikl))
+c #EM     Salt_f =  min(Salt_f     ,  un_1)
+c #EM     PorRef =      PorSno     /  max(eps6,1.-PorSno)
+c #EM.             +log(Salt_f)
+c #EM     Por_BS =      PorRef     / (1.0d00 + PorRef)
+c #EM     ro_new =      rhoIce     * (1.0d00 - Por_BS)
+c #EM     ro_new =  max(ro_new     ,  BSnoRo)
+
+          roagr1(ikl) = ro__SV(ikl,isn)
+          roagr2(ikl) = ro_new
+          hsno_x      = tdepos(ikl)*  zdepos(ikl,isn)
+
+          dzagr1(ikl) = dzsnSV(ikl,isn)
+          dzagr2(ikl) = hsno_x     /  ro_new
+!         Conversion    [kg/m2, i.e., mm w.e.] -----> [mSnow]
+
+          dsn_SV(ikl) = dsn_SV(ikl)-  hsno_x / dt__SV
+
+! Other Snow Properties
+! ~~~~~~~~~~~~~~~~~~~~~
+          T_agr1(ikl) =    TsisSV(ikl,isn)
+          T_agr2(ikl) =min(Tf_Sno,TaT_SV(ikl))
+          etagr1(ikl) =    eta_SV(ikl,isn)
+          etagr2(ikl) =    0.0
+          G1agr1(ikl) =    G1snSV(ikl,isn)
+          G1agr2(ikl) =    G1_dSV
+          G2agr1(ikl) =    G2snSV(ikl,isn)
+          G2agr2(ikl) =    ADSdSV
+c #BY     G2agr2(ikl) =    0.87d0
+!         Budd et al. 1966, 2~m Average /Table 5 p. 97
+
+          agagr1(ikl) =    agsnSV(ikl,isn)
+          agagr2(ikl) =    0.
+          Agrege(ikl) =    1.
+        END DO
+
+! Agregation
+! ~~~~~~~~~~
+!            **********
+        call SISVAT_zAg
+     .                 (isagr1,isagr2,WEagre
+     .                 ,dzagr1,dzagr2,T_agr1,T_agr2
+     .                 ,roagr1,roagr2,etagr1,etagr2
+     .                 ,G1agr1,G1agr2,G2agr1,G2agr2
+     .                 ,agagr1,agagr2,Agrege
+     .                 )
+!            **********
+
+        DO ikl = 1,knonv
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! OUTPUT           for Snow Erosion Variables
+! #b0     IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV      .AND.
+! #b0.        nn__SV(ikl).EQ.nwr_SV.AND.isn        .LE.isnoSV(ikl))
+! #b0.        write(6,6004)   isn          ,SaltSI(ikl,isn)
+! #b0.                     ,sdrift(ikl,isn),zdepos(ikl,isn)
+! #b0.                     ,ro__SV(ikl,isn),roagr2(ikl),roagr1(ikl)
+! #b0.                     ,dzsnSV(ikl,isn),dzagr2(ikl),dzagr1(ikl)
+! #b0.                     ,dsn_SV(ikl)
+ 6004         format((27x,i3,f7.2,2f10.6,3f10.3,4f10.6))
+
+          istoSV(ikl,isn) = isagr1(ikl)
+          dzsnSV(ikl,isn) = dzagr1(ikl)
+          TsisSV(ikl,isn) = T_agr1(ikl)
+          ro__SV(ikl,isn) = roagr1(ikl)
+          eta_SV(ikl,isn) = etagr1(ikl)
+          G1snSV(ikl,isn) = G1agr1(ikl)
+          G2snSV(ikl,isn) = G2agr1(ikl)
+          agsnSV(ikl,isn) = agagr1(ikl)
+
+        END DO
+
+      END DO
+
+! OUTPUT in SISVAT for ikl = 1 (preferably for Stand Alone Version)
+! OUTPUT           for SnowFall and Snow Buffer
+! #s2   IF          (isnoSV(1) .GT. 0)
+! #s2.  write(6,6008)isnoSV(1),    dsn_SV(1) *dt__SV + BufsSV(1),
+! #s2.              (dzsnSV(1,isn)*ro__SV(1,isn),isn=1,isnoSV(1))
+ 6008   format(i3,'  dsn+Buf=',f6.2,6x,'A dz *ro =',10f6.2,
+     .                                       (/,35x,10f6.2))
+
+        DO ikl = 1,knonv
+          hdrift      =  tdepos(ikl)/dt__SV
+          esnbSV(ikl) = (dsnbSV(ikl)-1.00)*hdrift/max(dsn_SV(ikl),eps6)
+     .                  +dsnbSV(ikl)
+          dsnbSV(ikl) =          min(un_1,   max(zer0,esnbSV(ikl) )   )
+!         dsnbSV is now the Blown Snow fraction of precipitating snow
+!                will be used for characterizing the Buffer Layer
+!               (see update of  Bros_N, G1same, G2same, zroOLD, zroNEW)
+        END DO
+
+      return
+      END
+
+
+      subroutine SISVAT_BDu
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_BDu                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_BDu treats Dust Erosion                            |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     OUTPUT:  usthSV   : Blowing Snow Erosion   Threshold           [m/s] |
+!     ^^^^^^                                                               |
+!                                                                          |
+!     REFER. : Fecan, F., B. Marticorena and G. Bergametti, 1999   (Fal99) |
+!     ^^^^^^^^ Ann. Geophysicae 17, 149--157                               |
+!              u* threshold: adapted from Fig. 4 p. 153                    |
+!              Clay Content:         from Tab. 2 p. 155                    |
+!                                                                          |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! General Variables
+! =================
+
+      USE PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VARxSV
+
+      IMPLICIT NONE
+
+! Local   Variables
+! =================
+
+      integer              ikl   ,  isot
+      real                 ustdmn(0:nsot)
+      real                 claypc(0:nsot)
+      real                 f__ust(0:nvgt)
+      real                 etaust(0:nsot)
+      common /SISVAT_BDu_r/etaust
+      logical              logust
+      common /SISVAT_BDu_L/logust
+      real                 eta_Du,usthDu
+
+
+! DATA
+! ====
+
+      data         (ustdmn(isot),
+     .                        claypc(isot),
+     .                                                   isot=0,nsot)
+     .             /10.000,  0.0000, !  0 WATER           !
+     .               0.300,  0.0000, !  1 SAND            !
+     .               0.300,  0.0920, !  2 LOAMY      SAND ! Fal99, Table 2
+     .               0.300,  0.1420, !  3 SANDY      LOAM ! Fal99, Table 2
+     .               0.300,  0.1630, !  4 SILT       LOAM ! Guess (Interpol.)
+     .               0.300,  0.1840, !  5            LOAM ! Fal99, Table 2
+     .               0.300,  0.2280, !  6 SANDY CLAY LOAM ! Guess (Interpol.)
+     .               0.300,  0.2720, !  7 SILTY CLAY LOAM ! Guess (Interpol.)
+     .               0.300,  0.3160, !  8       CLAY LOAM ! Fal99, Table 2
+     .               0.300,  0.3750, !  9 SANDY CLAY      ! Guess (Interpol.)
+     .               0.300,  0.4340, ! 10 SILTY CLAY      ! Guess (Interpol.)
+     .               0.300,  0.4920, ! 11       CLAY      ! Fal99, Table 2
+     .              10.000,  0.0000/ ! 12       ICE       !
+      data          (f__ust(isot),                       isot=0,nvgt)
+     .              /1.00,           !  0 NO     VEGETATION
+     .               1.20,           !  1 CROPS      LOW
+     .               5.00,           !  2 CROPS      MEDIUM
+     .              10.00,           !  3 CROPS      HIGH
+     .               1.20,           !  4 GRASS      LOW
+     .               5.00,           !  5 GRASS      MEDIUM
+     .              10.00,           !  6 GRASS      HIGH
+     .               5.00,           !  7 BROADLEAF  LOW
+     .              10.00,           !  8 BROADLEAF  MEDIUM
+     .              12.00,           !  9 BROADLEAF  HIGH
+     .              10.00,           ! 10 NEEDLELEAF LOW
+     .              12.00,           ! 11 NEEDLELEAF MEDIUM
+     .              50.00          / ! 12 NEEDLELEAF HIGH
+
+      IF (.NOT.logust)                                              THEN
+        DO isot=1,nsot
+               etaust(isot) = 0.0014 * claypc(isot) * claypc(isot) ! Fal99
+     .                      + 0.17   * claypc(isot)                ! Eqn.(14)
+        END DO                                                     !  p. 154
+               logust = .true.
+      END IF
+
+
+! Soil Erodibility
+! ----------------
+
+      DO ikl = 1,knonv
+        eta_Du      =  max(     eta_SV(ikl,0),etaust(isotSV(ikl))) ! Fal99
+        eta_Du      =  max(eps6,eta_SV(ikl,0)-eta_Du             ) ! Eqn.(15)
+        usthDu      = sqrt(un_1+1.21*exp(0.68*   log(eta_Du)    )) ! p.  155
+     .              *                         ustdmn(isotSV(ikl))  !
+     .              *                         f__ust(ivgtSV(ikl))  !
+        usthSV(ikl) = 
+     .                 usthSV(ikl)*(1-max(0,1-isnoSV(ikl))) +
+     .                 usthDu     *   max(0,1-isnoSV(ikl))
+      END DO
+
+      return
+      END
+
+
+      subroutine SISVAT_SIc
+! #m2.                     (SIvAcr)
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_SIc                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_SIc treats Sea-Ice and Ocean Latent Heat Exchanges |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     INPUT:   TaT_SV   : SBL Top    Temperature                       [K] |
+!     ^^^^^    isnoSV   : total Nb of Ice/Snow Layers                  [-] |
+!              LSmask   : Land-Sea   Mask                              [-] |
+!              dsn_SV   : Snow  Intensity                      [mm w.e./s] |
+!                                                                          |
+!     INPUT /  TsisSV   : Snow/Ice/Soil-Water Temperature              [K] |
+!     OUTPUT:  eta_SV   : Soil/Snow Water   Content                [m3/m3] |
+!     ^^^^^^   dzsnSV   : Snow Layer        Thickness                  [m] |
+!                                                                          |
+!     OUTPUT:  HFraSV   : Frazil            Thickness                  [m] |
+!     ^^^^^^                                                               |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option:                                               |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #IA: Sea-Ice Bottom   accretion  and  ocean cooling                  |
+!                                                                          |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! General Variables
+! =================
+
+      USE PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+
+
+! INPUT/OUTPUT
+! ------------
+
+      USE VARxSV
+
+
+      IMPLICIT NONE
+
+! OUTPUT/Verification: SeaIce Conservation
+! #m2 real      SIvAcr(klonv)                 ! Sea-Ice      Vertical Acretion
+
+
+! Local Variables
+! ===============
+
+      integer             ikl   ,isn
+      real                OCN_OK
+      real                SIceOK
+      real                SIcFrz
+      real                Twat_n
+      real                Crodzw,Lro__I
+      common/SISVAT_SIc_R/Crodzw,Lro__I
+      logical             SIcINI
+      common/SISVAT_SIc_L/SIcINI
+
+      real                SalIce              ! Sea-Ice   Salinity
+      real                SalWat              ! Sea-Water Salinity
+
+
+! DATA
+! ====
+
+      data                SalIce /10./        ! Sea-Ice   Salinity
+      data                SalWat /35./        ! Sea-Water Salinity
+!                         Typical Salinities in Terra Nova Bay
+!                         (Bromwich and Kurtz,   1984, JGR, p.3568;
+!                          Cavalieri and Martin, 1985,      p. 248)
+
+
+! Initialisation
+! ==============
+
+      IF (.NOT.SIcINI)                                              THEN
+               SIcINI =  .true.
+               Crodzw =  hC_Wat*rhoWat *          dz_dSV(0)   ! [J/m2/K]
+               Lro__I =  LhfH2O*rhoIce *(1.-1.e-3*SalIce      ! [J/m3]
+     .                 -(SalIce/SalWat)*(1.-1.e-3*SalWat) )   !
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1          Lro__I =  LhfH2O*rhoIce
+
+      END IF
+
+
+! Snow Fall cools Sea Water
+! =========================
+
+      DO ikl=1,knonv
+        OCN_OK        =  (1   -LSmask(ikl)   )                ! Free Ocean
+     .             *max(0,1   -isnoSV(ikl)   )                !
+c #IA   TsisSV(ikl,0) =        TsisSV(ikl,0)                  ! [K]
+c #IA. -OCN_OK*(Cn_dSV*(Tf_Sno-TaT_SV(ikl)   )                ! [J/kg]
+c #IA.         +LhfH2O*(1.    -eta_SV(ikl,0)))                ! [J/kg]
+c #IA.        * dsn_SV(ikl)   *dt__SV          / Crodzw       ! [kg/m2]
+
+
+! Sea-Ice Formation
+! =================
+
+c #IA   Twat_n      =      max(TsisSV(ikl,0  )  ,Tf_Sea)      ! [K]
+c #IA   SIcFrz      =  (Twat_n-TsisSV(ikl,0  ) )*Crodzw/Lro__I! [m]
+c #IA.                              * 0.75
+!  ***  Hibler (1984), Ocean Heat Flux: 25% of cooling (ANTARCTIC Ocean)
+!      (Hansen and Takahashi Eds) 
+!       Geophys. Monogr. 29, M. Ewing Vol. 5, AGU, p. 241
+
+
+! Frazil  Formation
+! -----------------
+
+c #IA   HFraSV(ikl) =          SIcFrz           *OCN_OK
+
+
+! Growth of the Sea-Ice First Ice Floe
+! ------------------------------------
+
+c #IA   SIceOK        =  (1   -LSmask(ikl)     )              ! Ice Cover.Ocean
+c #IA.             *min(  1   ,isnoSV(ikl)     )              !
+c #IA   dzsnSV(ikl,1) =        dzsnSV(ikl,1)                  ! Vertical Acret.
+c #IA.                +        SIcFrz           *SIceOK       !
+
+
+! OUTPUT/Verification: SeaIce Conservation: Diagnostic of Surface Mass Balance
+! #m2   SIvAcr(ikl) = rhoIce*SIcFrz     *(OCN_OK+SIceOK)
+! #m2.              - dt__SV*dsn_SV(ikl)* OCN_OK
+
+
+! Water Fluxes Update
+! -------------------
+
+        RnofSV(ikl) =          RnofSV(ikl)
+     .              +          dsn_SV(ikl) *     OCN_OK
+        dsn_SV(ikl) =          dsn_SV(ikl) * (1.-OCN_OK)
+
+      END DO
+
+      return
+      end
+      subroutine SISVAT_zSn
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_zSn                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_zSn manages the Snow Pack vertical Discretization  |
+!                                                                          |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: 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  |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # SISVAT_zSn.vz        | #vz: OUTPUT/Verification: Snow Layers Agrega. |
+!                          |      unit 41, SubRoutine  SISVAT_zSn **ONLY** |
+!   # SISVAT_GSn.vp        | #vp: OUTPUT/Verification: Snow   Properties   |
+!                          |      unit 47, SubRoutines SISVAT_zSn, _GSn    |
+!   # stdout               | #s1: OUTPUT of Snow Layers Agregation         |
+!                          |      unit  6, SubRoutine  SISVAT_zSn, _zAg    |
+!--------------------------------------------------------------------------+
+      USE PHY_SV 
+                                 
+      USE VAR_SV
+      USE VARdSV
+                       
+      USE VARxSV 
+      USE VARySV
+                                 
+      USE VAR0SV                                                 
+!      USE VARphy 
+
+      IMPLICIT NONE
+
+
+! Global Variables
+! ================
+
+!      include  'PHY_SV.h'
+!
+!      include  'MAR_SV.inc'
+!      include  'MARdSV.inc'
+!      include  'MAR0SV.inc'
+!
+!      include  'MARxSV.inc'
+!
+
+! Internal Variables
+! ==================
+
+      integer   ikl   ,isn   ,i               !
+
+!      include  'MARySV.inc'
+      integer   NLay_s(klonv)                 ! Split Snow Layer         Switch
+      integer   isagr1(klonv)                 ! 1st     Layer History
+      integer   isagr2(klonv)                 ! 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  (klonv)                 ! 1st layer to stagger
+      real      staggr                        !              stagger  Switch
+
+      real      WEagre(klonv)                 ! Snow Water Equivalent Thickness
+      real      dzthin(klonv)                 ! 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(klonv)                 ! 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(klonv)                 ! 1st     Layer Thickness
+      real      dzagr2(klonv)                 ! 2nd     Layer Thickness
+      real      T_agr1(klonv)                 ! 1st     Layer Temperature
+      real      T_agr2(klonv)                 ! 2nd     Layer Temperature
+      real      roagr1(klonv)                 ! 1st     Layer Density
+      real      roagr2(klonv)                 ! 2nd     Layer Density
+      real      etagr1(klonv)                 ! 1st     Layer Water Content
+      real      etagr2(klonv)                 ! 2nd     Layer Water Content
+      real      G1agr1(klonv)                 ! 1st     Layer Dendricity/Spher.
+      real      G1agr2(klonv)                 ! 2nd     Layer Dendricity/Spher.
+      real      G2agr1(klonv)                 ! 1st     Layer Sphericity/Size
+      real      G2agr2(klonv)                 ! 2nd     Layer Sphericity/Size
+      real      agagr1(klonv)                 ! 1st     Layer Age
+      real      agagr2(klonv)                 ! 2nd     Layer Age
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz logical         as_opn                  ! IO   Switch
+! #vz common/SI_zSn_L/as_opn                  !
+! #vz real      dz_ref(            nsno)      ! Snow Reference Discretization
+! #vz real      dzwdif(            nsno)      !
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp logical         VP_opn                  ! IO   Switch
+! #vp common/SI_GSn_L/VP_opn                  !
+
+
+! DATA
+! ====
+
+!      data      icemix /   0    /             ! 0 ====> Agregated Snow+Ice=Snow
+!      data      dzepsi /   0.0015/            ! Min single Layer Thickness 
+!      data      dzxmin /   0.0020/            ! Min accept.Layer Thickness 
+!      data      dz_min /   0.0050/            ! Min Local  Layer Thickness 
+!      data      dz_max /   0.0300/            ! Min Gener. Layer Thickness 
+!hjp250711
+      data      dzepsi /   0.0045/            ! Min single Layer Thickness 
+      data      dzxmin /   0.0060/            ! Min accept.Layer Thickness 
+      data      dz_min /   0.0150/            ! Min Local  Layer Thickness 
+      data      dz_max /   0.0900/            ! Min Gener. Layer Thickness 
+!     CAUTION:  dz_max > dz_min*2 is required ! Otherwise re-agregation is
+                                              ! activated  after splitting
+
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz IF (.NOT.as_opn)                                              THEN
+! #vz          as_opn=.true.
+! #vz     open(unit=41,status='unknown',file='SISVAT_zSn.vz')
+! #vz     rewind    41
+! #vz END IF
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp IF (.NOT.VP_opn)                                              THEN
+! #vp          VP_opn=.true.
+! #vp     open(unit=47,status='unknown',file='SISVAT_GSn.vp')
+! #vp     rewind    47
+! #vp END IF
+
+
+! Constrains Agregation         of too thin  Layers
+! =================================================
+
+! Search the thinest  non-zero Layer
+! ----------------------------------
+
+        DO ikl=1,klonv
+          dzthin(ikl) = 0.                              ! Arbitrary unrealistic
+        END DO                                          !       Layer Thickness 
+      DO   isn=1,nsno
+        DO ikl=1,klonv
+          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
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #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(zer0,                       ! Actual      Profile
+     .          dz_min                                  !
+     .                 *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+     .                 +    iiceOK *2.   **iice_n)      !
+     .        - dzsnSV(ikl, isn)                    )   ! Actual      Profile
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz     dzwdif(isn) =     dz_dif                      !
+
+          OKthin      = max(zer0,                       !
+     .                      sign(un_1,                  !
+     .                           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(un_1,                                !
+!
+!                       1st additional Condition to accept OKthin
+     .                  max(zer0,                                ! combination
+     .                      sign(un_1,G1snSV(ikl,      isn  )    ! G1 with same
+     .                               *G1snSV(ikl,max(1,isn-1)))) !  sign => OK
+!
+!                       2nd additional Condition to accept OKthin
+     .                + max(zer0,                                ! G1>0
+     .                      sign(un_1,G1snSV(ikl,      isn   ))) !  =>OK
+!
+!                       3rd additional Condition to accept OKthin
+     .                + max(zer0,                                ! dz too small
+     .                      sign(un_1,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
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz     write(41,4150) daHost   ,n___SV(  lwriSV(1))
+! #vz.                  ,i_thin(1),dzsnSV(1,i_thin(1))
+ 4150     format(/,'-',a18,i5,' ',70('-'),
+     .           /,' Thinest ',i3,':',f9.3)
+
+      DO   isn=1,nsno
+        DO ikl=1,klonv
+          OKthin =      max(zer0,                       !
+     .                      sign(un_1,                  !
+     .                           dzxmin                 !
+     .                          -dzsnSV(ikl,isn)))      !
+     .                * max(zer0,                       ! ON if dz > 0
+     .                      sign(un_1,                  !
+     .                           dzsnSV(ikl,isn)-eps6)) !
+     .           *min(1,max(0,                          ! Multiple Snow    Lay.
+     .                      min (1,                     ! Switch = 1
+     .                           isnoSV(ikl)            !   if isno > iice + 1
+     .                          -iiceSV(ikl)-1))        !
+                                                        !
+     .             +int(max(zer0,                       !
+     .                      sign(un_1,                  !
+     .                           dzepsi                 ! Minimum accepted for
+     .                          -dzsnSV(ikl,isn))))     ! 1 Snow Layer over Ice
+     .             *int(max(zer0,                       ! ON if dz > 0
+     .                      sign(un_1,                  !
+     .                           dzsnSV(ikl,isn)-eps6)))!
+     .                 *(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(un_1,                                    !
+     .                  max(zer0,                                ! combination
+     .                      sign(un_1,G1snSV(ikl,      isn  )    ! G1>0 + G1<0
+     .                               *G1snSV(ikl,max(1,isn-1)))) ! NO
+     .                + max(zer0,                                !
+     .                      sign(un_1,G1snSV(ikl,      isn   ))) !
+     .                + max(zer0,                                !
+     .                      sign(un_1,dzxmin                     !
+     .                               -dzsnSV(ikl,      isn   ))))!
+          i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) ! Update   thinest Lay.
+     .                         + OKthin   * isn         !                Index
+        END DO
+      END DO
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz     write(41,4151) i_thin(1),dzsnSV(1,i_thin(1))
+! #vz.                  ,isnoSV(1),dzsnSV(1,isnoSV(1))
+ 4151     format(' Thinest ',i3,':',f9.3,'   Max   =',i3,f12.3)
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp   write(47,470)(G1snSV(1,isn),isn=1,isnoSV(1))
+ 470    format('Before _zCr1: G1 = ',10f8.1,(/,19x,10f8.1))
+! #vp   write(47,472)(G2snSV(1,isn),isn=1,isnoSV(1))
+ 472    format('              G2 = ',10f8.1,(/,19x,10f8.1))
+
+
+! Index of the contiguous Layer to agregate
+! -----------------------------------------
+
+!          **********
+      call SISVAT_zCr
+!          **********
+
+
+! Assign the 2 Layers to agregate
+! -------------------------------
+
+        DO ikl=1,klonv
+          isn         =    i_thin(ikl)
+          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(zer0,                       ! if downmost  Layer
+     .                      sign(un_1,eps_21            ! <  1.e-21 m
+     .                               -dzsnSV(ikl,1)))   !
+          isnoSV(ikl) = max(   0,     isnoSV(ikl)   )   !
+          Agrege(ikl) = max(zer0,                       !
+     .                      sign(un_1,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 isn=1,nsno
+        DO ikl=1,klonv
+          WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn)
+     .                                *min(1,max(0,i_thin(ikl)+1-isn))
+        ENDDO
+        ENDDO
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz write(41,410)
+ 410  format(/,' Agregation of too THIN Layers')
+! #vz write(41,411) (100.*dz_ref(  isn),isn=1,nsno)
+! #vz write(41,412) (100.*dzwdif(  isn),isn=1,nsno)
+! #vz write(41,413) (100.*dzsnSV(1,isn),isn=1,nsno)
+! #vz write(41,414) (              isn ,isn=1,nsno)
+ 411  format(' dz_ref [cm]:',10f8.2   ,/,('             ',10f8.2) )
+ 412  format(' dz_dif [cm]:',10f8.2   ,/,('             ',10f8.2) )
+ 413  format(' dzsnSV [cm]:',10f8.2   ,/,('             ',10f8.2) )
+ 414  format('             ',10(i5,3x),/,('             ',10(i5,3x)))
+! #vz write(41,4111)      isnoSV(1    )
+! #vz write(41,4112)      i_thin(1    )
+! #vz write(41,4113)      LIndsv(1    )
+! #vz write(41,4114)      Agrege(1    )
+! #vz write(41,4115) 1.e2*dzagr1(1    )
+! #vz write(41,4116) 1.e2*dzagr2(1    )
+ 4111 format(' isnoSV     :',  i8  )
+ 4112 format(' i_thin     :',  i8  )
+ 4113 format(' LIndsv     :',  i8  )
+ 4114 format(' Agrege     :',  f8.2)
+ 4115 format(' dzagr1     :',  f8.2)
+ 4116 format(' dzagr2     :',  f8.2)
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp   write(47,471)(G1snSV(1,isn),isn=1,isnoSV(1))
+ 471    format('Before _zAg1: G1 = ',10f8.1,(/,19x,10f8.1))
+! #vp   write(47,472)(G2snSV(1,isn),isn=1,isnoSV(1))
+
+
+! 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,klonv
+          isn     =             i_thin(ikl)
+          isn     = min(isn,isn+LIndsv(ikl))
+          isnoSV(ikl) =         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,klonv
+          isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
+        END DO
+        DO i=  1,nsno-1
+        DO ikl=1,klonv
+            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,klonv
+          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
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! #s1   IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV        .AND.
+! #s1.      nn__SV(ikl).EQ.nwr_SV                          )        THEN
+! #s1     write(6,5991) i_thin(ikl)
+ 5991     format(/,'First Agregation / Layer',i3,
+     .           /,'  i',11x,'T',9x,'rho',10x,'dz',11x,'H')
+! #s1     write(6,5995) (isn,TsisSV(ikl,isn),ro__SV(ikl,isn)
+! #s1.                      ,dzsnSV(ikl,isn),istoSV(ikl,isn),
+! #s1.                   isn=isnoSV(ikl),1,-1)
+ 5995     format(i3,3f12.3,i12)
+! #s1   END IF
+
+
+! Constrains Splitting          of too thick Layers
+! =================================================
+
+
+! Search the thickest non-zero Layer
+! ----------------------------------
+
+        DO ikl=1,klonv
+          dzthin(ikl) =   0.                            ! Arbitrary unrealistic
+        END DO                                          !       Layer Thickness 
+      DO   isn=1,nsno
+        DO ikl=1,klonv
+          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),eps6)       !
+          OKthin      = max(zer0,                       !
+     .                      sign(un_1,                  !
+     .                           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
+      END DO
+
+      DO   ikl=1,klonv
+          ThickL      = max(zer0,                       ! 1. => a too   thick
+     .                      sign(un_1,dzthin(ikl)       !         Layer exists
+     .                               -eps6       ))     !
+     .        * max(0,1-max(0   ,     isnoSV(ikl)       ! No spliting allowed
+     .                               -nsno+3     ))     ! if isno > nsno - 3
+          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
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz     write(41,4152) i_thin(1),dzthin(1),ThickL
+ 4152     format(/,' Thickest',i3,':',f9.3,'   Split =',f4.0)
+
+
+! Rearranges the Layers
+! ---------------------
+
+      DO isn=nsno,2,-1
+      DO ikl=1,klonv
+        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,klonv
+          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)     =     Agrege(ikl) +isnoSV(ikl)
+          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
+! -----------------------------------
+
+! OUTPUT/Verification: Snow Thinest Layer  
+! #sd     write( 6,*)   ' '
+! #sd     write( 6,*)   'Agregation 2'
+! #sd     write( 6,6000) NLaysv(1)
+ 6000     format(i3,6x,
+     .          'dzsnSV      dz_min      dz_dif      ',
+     .          'OKthin      dzthin   i_thin')
+
+        DO ikl=1,klonv
+          dzthin(ikl) =   0.                            ! Arbitrary unrealistic
+        END DO                                          !       Layer Thickness 
+      DO   isn=1,nsno
+        DO ikl=1,klonv
+          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
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #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(eps6,((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+     .                 +    iiceOK *2.   **iice_n))     !
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz     dzwdif(isn) =     dz_dif                      !
+
+          OKthin      = max(zer0,                       !
+     .                      sign(un_1,                  !
+     .                           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       !
+
+! OUTPUT/Verification: Snow Thinest Layer  
+! #sd   IF(isn.LE.isnoSV(1).AND.ikl.EQ.1)
+! #sd.    write( 6,6001) isn,dzsnSV(ikl,isn),dz_min*isno_n*isno_n,dz_dif
+! #sd.               ,OKthin,dzthin(ikl),    i_thin(ikl)
+ 6001     format(i3,5f12.6,i9)
+
+        END DO
+      END DO
+
+! OUTPUT/Verification: Snow Thinest Layer  
+! #sd     write( 6,*)   ' '
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz     write(41,4153) i_thin(1),dzsnSV(1,i_thin(1))
+ 4153     format(/,' Thinest ',i3,':',f9.3)
+! #vz     write(41,4151) i_thin(1),dzsnSV(1,i_thin(1))
+! #vz.                  ,isnoSV(1),dzsnSV(1,isnoSV(1))
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp   write(47,473)(G1snSV(1,isn),isn=1,isnoSV(1))
+ 473    format('Before _zCr2: G1 = ',10f8.1,(/,19x,10f8.1))
+! #vp   write(47,472)(G2snSV(1,isn),isn=1,isnoSV(1))
+
+
+! Index of the contiguous Layer to agregate
+! -----------------------------------------
+
+!          **********
+      call SISVAT_zCr
+!          **********
+
+
+! Assign the 2 Layers to agregate
+! -------------------------------
+
+        DO ikl=1,klonv
+          isn         =    i_thin(ikl)
+          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           )
+          isnoSV(ikl) =                    isnoSV(ikl)
+     .     -(1-LstLay)*max(zer0,
+     .                     sign(un_1,      eps_21
+     .                                    -dzsnSV(ikl,1)   ))
+          isnoSV(ikl) =max(   0,           isnoSV(ikl)      )
+
+          WEagre(ikl) = 0.
+        END DO
+
+        DO isn=1,nsno
+        DO ikl=1,klonv
+          WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn)
+     .                                *min(1,max(0,i_thin(ikl)+1-isn))
+        ENDDO
+        ENDDO
+
+! OUTPUT/Verification: Snow Layers Agregation
+! #vz write(41,4120)
+ 4120 format(' Agregation of too MUCH Layers')
+! #vz write(41,411) (100.*dz_ref(  isn),isn=1,nsno)
+! #vz write(41,412) (100.*dzwdif(  isn),isn=1,nsno)
+! #vz write(41,413) (100.*dzsnSV(1,isn),isn=1,nsno)
+! #vz write(41,414) (              isn ,isn=1,nsno)
+! #vz write(41,4111)      isnoSV(1    )
+! #vz write(41,4112)      i_thin(1    )
+! #vz write(41,4113)      LIndsv(1    )
+! #vz write(41,4114)      Agrege(1    )
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp   write(47,474)(G1snSV(1,isn),isn=1,isnoSV(1))
+ 474    format('Before _zAg2: G1 = ',10f8.1,(/,19x,10f8.1))
+! #vp   write(47,472)(G2snSV(1,isn),isn=1,isnoSV(1))
+
+
+! 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,klonv
+          isn     =             i_thin(ikl)
+          isn     = min(isn,isn+LIndsv(ikl))
+          isnoSV(ikl) =         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,klonv
+          isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
+        END DO
+        DO i=  1,nsno-1
+        DO ikl=1,klonv
+            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,klonv
+          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
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp   write(47,475)(G1snSV(1,isn),isn=1,isnoSV(1))
+ 475    format('At End _zSn : G1 = ',10f8.1,(/,19x,10f8.1))
+! #vp   write(47,472)(G2snSV(1,isn),isn=1,isnoSV(1))
+
+
+! Search new Ice/Snow Interface
+! =============================
+
+c #II   DO ikl=1,klonv
+c #II     iiceSV(ikl) =  0
+c #II   END DO
+
+c #II   DO isn=1,nsno
+c #II   DO ikl=1,klonv
+c #II     OK_ICE      = max(zer0,sign(un_1,ro__SV(ikl,isn)-850.))
+c #II.                * max(zer0,sign(un_1,dzsnSV(ikl,isn)-eps6))
+c #II     iiceSV(ikl) = (1.-OK_ICE)       *iiceSV(ikl)
+c #II.                +     OK_ICE        *isn
+c #II   END DO
+c #II   END DO
+
+      return 
+      end
+
+                                                            
+                                                            
+      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 +                                                                             
+      USE VAR_SV
+      USE VARdSV
+ 
+      USE VARySV                      
+      USE VARxSV 
+                                 
+      USE VAR0SV                                                 
+      USE VARphy         
+
+      IMPLICIT NONE                                                       
+C +                                                                             
+C +                                                                             
+C +--Global Variables                                                           
+C +  ================                                                           
+C +                                                                             
+c      include  "LMDZphy.inc"                                                     
+c      include  "LMDZ_SV.inc"                                                     
+c      include  "LMDZdSV.inc"                                                     
+c      include  "LMDZ0SV.inc"                                                     
+C +                                                                             
+c      include  "LMDZxSV.inc"                                                     
+c      include  "LMDZySV.inc"                                                     
+C +                                                                             
+C +                                                                             
+C +--Internal Variables                                                         
+C +  ==================                                                         
+C +                                                                             
+      integer   ikl   ,isn   ,is0   ,is1                                        
+      integer   isno_1                        ! Switch:  ! Snow Layer over Ice  
+      real*8    Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure  
+      real*8    DenSph                        ! 1. when contiguous spheric      
+C +                                           !     and dendritic  Grains       
+      real*8    DendOK                        ! 1. when dendritic  Grains       
+      real*8    dTypMx                        ! Grain Type Differ.              
+      real*8    dTypSp                        ! Sphericity Weight               
+      real*8    dTypRo                        ! Density    Weight               
+      real*8    dTypDi                        ! Grain Diam.Weight               
+      real*8    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                                                                       
+                                                                                
+                                                                                
+      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                                            17-06-2004  MAR |    
+C |   SubRoutine SISVAT_zAg aggregates two contiguous snow layers          |    
+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:   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 +------------------------------------------------------------------------+    
+            
+      USE VAR_SV
+      USE VARdSV                      
+      USE VARxSV                 
+      USE VAR0SV                                                 
+      USE VARphy                                                                    
+                                                                                
+      IMPLICIT NONE                                                             
+                                                                                
+                                                                                
+C +--Global Variables                                                           
+C +  ================                                                           
+                                                                                
+c      include  "LMDZphy.inc"                                                     
+c      include  "LMDZ_SV.inc"                                                     
+c      include  "LMDZdSV.inc"                                                     
+c      include  "LMDZ0SV.inc"                                                     
+c      include  "LMDZxSV.inc"                                                     
+                                                                                
+                                                                                
+C +--INPUT                                                                      
+C +  -----                                                                      
+                                                                                
+      integer   isagrb(klonv)                 ! 2nd Layer History               
+      real*8    dzagrb(klonv)                 ! 2nd Layer Thickness             
+      real*8    T_agrb(klonv)                 ! 2nd Layer Temperature           
+      real*8    roagrb(klonv)                 ! 2nd Layer Density               
+      real*8    etagrb(klonv)                 ! 2nd Layer Water Content         
+      real*8    G1agrb(klonv)                 ! 2nd Layer Dendricity/Spher.     
+      real*8    G2agrb(klonv)                 ! 2nd Layer Sphericity/Size       
+      real*8    agagrb(klonv)                 ! 2nd Layer Age                   
+                                                                                
+                                                                                
+C +--INPUT/OUTPUT                                                               
+C +  ------------                                                               
+                                                                                
+      integer   isagra(klonv)                 ! 1st Layer History               
+      real*8    WEagra(klonv)                 ! 1st Layer Height    [mm w.e.]   
+      real*8    Agreg1(klonv)                 ! 1. ===>   Agregates             
+      real*8    dzagra(klonv)                 ! 1st Layer Thickness             
+      real*8    T_agra(klonv)                 ! 1st Layer Temperature           
+      real*8    roagra(klonv)                 ! 1st Layer Density               
+      real*8    etagra(klonv)                 ! 1st Layer Water Content         
+      real*8    G1agra(klonv)                 ! 1st Layer Dendricity/Spher.     
+      real*8    G2agra(klonv)                 ! 1st Layer Sphericity/Size       
+      real*8    agagra(klonv)                 ! 1st Layer Age                   
+                                                                                
+                                                                                
+C +--Internal Variables                                                         
+C +  ==================                                                         
+                                                                                
+      integer   ikl                                                             
+      integer   nh                            ! Averaged    Snow History        
+      integer   nh__OK                        ! 1=>Conserve Snow History        
+      real*8    rh                            !                                 
+      real*8    dz                            ! Thickness                       
+      real*8    dzro_1                        ! Thickness X Density, Lay.1      
+      real*8    dzro_2                        ! Thickness X Density, Lay.2      
+      real*8    dzro                          ! Thickness X Density, Aver.      
+      real*8    ro                            ! Averaged    Density             
+      real*8    wn                            ! Averaged    Water Content       
+      real*8    tn                            ! Averaged    Temperature         
+      real*8    ag                            ! Averaged    Snow Age            
+      real*8    SameOK                        ! 1. => Same Type of Grains       
+      real*8    G1same                        ! Averaged G1,  same Grains       
+      real*8    G2same                        ! Averaged G2,  same Grains       
+      real*8    typ__1                        ! 1. => Lay1 Type: Dendritic      
+      real*8    zroNEW                        ! dz X ro, if fresh Snow          
+      real*8    G1_NEW                        ! G1,      if fresh Snow          
+      real*8    G2_NEW                        ! G2,      if fresh Snow          
+      real*8    zroOLD                        ! dz X ro, if old   Snow          
+      real*8    G1_OLD                        ! G1,      if old   Snow          
+      real*8    G2_OLD                        ! G2,      if old   Snow          
+      real*8    SizNEW                        ! Size,    if fresh Snow          
+      real*8    SphNEW                        ! Spheric.,if fresh Snow          
+      real*8    SizOLD                        ! Size,    if old   Snow          
+      real*8    SphOLD                        ! Spheric.,if old   Snow          
+      real*8    Siz_av                        ! Averaged    Grain Size          
+      real*8    Sph_av                        ! Averaged    Grain Spher.        
+      real*8    Den_av                        ! Averaged    Grain Dendr.        
+      real*8    DendOK                        ! 1. => Average is  Dendr.        
+      real*8    G1diff                        ! Averaged G1, diff. Grains       
+      real*8    G2diff                        ! Averaged G2, diff. Grains       
+      real*8    G1                            ! Averaged G1                     
+      real*8    G2                            ! Averaged G2                     
+                                                                                
+C +--OUTPUT of Snow Agregat.Statistics (see assignation in PHY_SISVAT)          
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                                          
+c #EV integer                iEVwri,jEVwri,nEVwri,kEVwri,lEVwri                 
+c #EV common  /SISVAT_EV/    iEVwri,jEVwri,nEVwri,kEVwri,lEVwri                 
+                                                                                
+                                                                                
+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)-WEagra(ikl)))               
+          nh__OK  =  rh                                                         
+          nh      =  nh__OK *       max(isagra(ikl),isagrb(ikl))                
+     .          + (1-nh__OK)*       min(isagra(ikl),isagrb(ikl))                
+                                                                                
+C +--OUTPUT of Snow Agregation Statistics                                       
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                                       
+c #EV   IF (ikl .EQ. kEVwri .AND. lEVwri .EQ. 3)                    THEN        
+c #EV     write(6,5995) zWEcSV(ikl),WEagra(ikl)                                 
+c #EV.                 ,isagra(ikl),isagrb(ikl)                                 
+c #EV.                 ,nh__OK     ,nh                                          
+ 5995     format(' WE2,WEa =',2f9.1,'  nha,b =',2i2,'  nh__OK,nh =',2i2)        
+c #EV   END IF                                                                  
+                                                                                
+                                                                                
+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                                             
+
+
+
+      subroutine SnOptP(jjtime)
+
+!--------------------------------------------------------------------------+
+!   MAR/SISVAT   SnOptP                               Sat 12-Feb-2012  MAR |
+!     SubRoutine SnOptP computes the Snow Pack optical Properties          |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     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                      |
+!     ^^^^^    ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+!                                                                          |
+!              ivgtSV   = 0,...,12:   Vegetation Type                      |
+!                         0:          Water, Solid or Liquid               |
+!                                                                          |
+!     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      |
+!                                                                          |
+!     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                                     |
+!                                                                          |
+!     CAUTION: Vegetation is not taken into account in albedo computations |
+!     ^^^^^^^  Suggestion: 1) Reduce the displacement height  and/or LAI   |
+!              (when snow)    for radiative transfert through vegetation   |
+!                          2) Adapt leaf optical parameters                |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: STANDARD Possibility                          |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^^^^^^^^^^^^                          |
+!     #CZ: Albedo Correction (Zenith Angle) (Warren,      1982)            |
+!     #cz: Albedo Correction (Zenith Angle) (Segal etAl., 1991) (obsolete) |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: STANDARD Col de Porte                         |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^                                      |
+!     #cp: Col de Porte Integrated Snow/Ice Albedo                         |
+!     #AG: Snow Aging Col de Porte     (Brun et al.1991)                   |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # SnOptP____.va        | #va: OUTPUT/Verification: Albedo Parameteriz. |
+!                          |      unit 46, SubRoutine  SnOptP     **ONLY** |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VARdCP
+
+      USE VARxSV
+      USE VARySV
+
+      IMPLICIT NONE
+
+! Internal Variables
+! ==================
+
+      real      coalb1(klonv)                      ! weighted Coalbedo, Vis.
+      real      coalb2(klonv)                      ! weighted Coalbedo, nIR 1
+      real      coalb3(klonv)                      ! weighted Coalbedo, nIR 2
+      real      coalbm                             ! weighted Coalbedo, mean
+      real      sExt_1(klonv)                      ! Extinction Coeff., Vis.
+      real      sExt_2(klonv)                      ! Extinction Coeff., nIR 1
+      real      sExt_3(klonv)                      ! Extinction Coeff., nIR 2
+      real      SnOpSV(klonv,      nsno)           ! Snow Grain optical Size
+c #AG real      agesno
+
+      integer   isn   ,ikl   ,isn1  ,jjtime
+      real      sbeta1,sbeta2,sbeta3,sbeta4,sbeta5
+      real      AgeMax,AlbMin,HSnoSV,HIceSV,doptmx,SignG1,Sph_OK
+      real      dalbed,dalbeS,dalbeW
+c #CZ real      bsegal,czemax,csegal
+      real      RoFrez,DiffRo,SignRo,SnowOK,OpSqrt
+      real      albSn1,albIc1,a_SnI1,a_SII1!,alb1sv(klonv)
+      real      albSn2,albIc2,a_SnI2,a_SII2!,alb2sv(klonv)
+      real      albSn3,albIc3,a_SnI3,a_SII3!,alb3sv(klonv)
+      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
+      real      ro_ave,dz_ave
+
+! OUTPUT/Verification: Albedo Parameteriz.
+! #va logical         aw_opn                       ! IO       Switch
+! #va common/SnOptP_L/aw_opn                       !
+
+
+! 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]
+!      
+c #CZ data      czeMAX  /0.173648178/  ! 80.deg (Segal et al., 1991 JAS)  
+c #CZ data      bsegal  /4.00       /  !
+      data      albmax  /0.99       /  ! Albedo max
+
+
+! Snow Grain optical Size
+! =======================
+
+      DO   isn=1,nsno
+        DO ikl=1,knonv
+
+          G2snSV(ikl,isn) =  max(eps6,G2snSV(ikl,isn))
+!         Avoid non physical Values
+
+          SignG1          = sign(un_1,G1snSV(ikl,isn))
+          Sph_OK          =  max(zer0,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(half*G2snSV(ikl,isn),DFcdSV)
+     .                 *(1.00-G1snSV(ikl,isn)                /G1_dSV))
+
+
+! Contribution of     Dendritic Snow
+! ----------------------------------
+
+     .    +(1.-Sph_OK)*(     -G1snSV(ikl,isn)*DDcdSV         /G1_dSV
+     .                 +(1.00+G1snSV(ikl,isn)                /G1_dSV)
+     .                  *    (G2snSV(ikl,isn)*DScdSV         /G1_dSV
+     .                 +(1.00-G2snSV(ikl,isn)                /G1_dSV)
+     .                                       *DFcdSV                 )))
+          SnOpSV(ikl,isn) =  max(zer0,SnOpSV(ikl,isn))
+        END DO
+      END DO
+
+
+! Snow/Ice Albedo
+! ===============
+
+! Snow Age (Influence on Albedo)
+! ------------------------------
+
+c #AG IF (iabs(mod(jjtime,86400)).lt.dt__SV)                        THEN
+c #AG   DO isn=1,nsno
+c #AG   DO ikl=1,knonv
+c #AG     agsnSV(ikl,isn) = agsnSV(ikl,isn) + 1.
+c #AG.           + max(zer0,DH_dSV(ivgtSV(ikl))-DH_dSV(4)) ! High Vegetation
+!                                                          ! Impurities
+!                           CAUTION: crude parameterization
+!                           ^^^^^^^       
+c #AG   END DO
+c #AG   END DO
+c #AG END IF
+
+
+! Uppermost effective Snow Layer
+! ------------------------------
+
+        DO ikl=1,knonv
+
+           isn   =  max(1,isnoSV(ikl))
+
+          SignRo = sign(un_1, rocdSV - ro__SV(ikl,isn))
+          SnowOK =  max(zer0,SignRo) ! Ice Density Threshold
+
+          OpSqrt = sqrt(SnOpSV(ikl,isn))
+
+          albSn1 =  0.96-1.580*OpSqrt
+          albSn1 =  max(albSn1,AlbMin)
+
+          albSn1 =  max(albSn1,zer0)
+          albSn1 =  min(albSn1,un_1)
+
+          albSn2 =  0.95-15.40*OpSqrt
+          albSn2 =  max(albSn2,zer0)
+          albSn2 =  min(albSn2,un_1)
+
+          doptic =  min(SnOpSV(ikl,isn),doptmx)
+          albSn3 =  346.3*doptic -32.31*OpSqrt +0.88
+          albSn3 =  max(albSn3,zer0)
+          albSn3 =  min(albSn3,un_1)
+
+          albSno =  So1dSV*albSn1
+     .           +  So2dSV*albSn2
+     .           +  So3dSV*albSn3
+
+          SnowOK =  SnowOK*max(zer0,sign(un_1,albSno-aI3dSV))
+                 !  Minimum snow albedo is aI3dSV
+
+          albSn1 =  SnowOK*albSn1+(1.0-SnowOK)*max(albSno,aI3dSV)
+          albSn2 =  SnowOK*albSn2+(1.0-SnowOK)*max(albSno,aI3dSV)
+          albSn3 =  SnowOK*albSn3+(1.0-SnowOK)*max(albSno,aI3dSV)
+
+
+! 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(un_1,  SnownH)
+          SIcenH =  SIce_H  / (HIceSV
+     .           +  max(zer0,Z0mdSV(ivgtSV(ikl))
+     .           -           Z0mdSV(4)         ))
+          SIcenH =  min(un_1,  SIcenH)
+ 
+!      The value of SnownH is set to 1 in case of ice lenses above 
+!      1m of dry snow (ro<700kg/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(zer0,sign(un_1,1.-dz_ave))
+       enddo
+
+          ro_ave =  ro_ave / max(dz_ave,eps6)
+          SnowOK =  max(zer0,sign(un_1,700.-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)                           !
+
+          SignRo = sign(un_1,rhoIce-1.-ro__SV(ikl,isn))    ! RoSN<920kg/m3
+          SnowOK =  max(zer0,SignRo)
+
+          albWIc = (1. - SnowOK) * albWIc + SnowOK   
+     .           * (aI2dSV + (aI3dSV -aI2dSV) 
+     .           * (ro__SV(ikl,isn)-rhoIce)/(rocdSV-rhoIce))
+  
+!    rocdSV < ro < rhoIce | aI2dSV< al >aI3dSV (fct of density)) 
+!             ro > rhoIce | aI1dSV< al >aI2dSV (fct of superficial water content)s
+
+
+! 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)
+
+c #AG     agesno =      min(agsnSV(ikl,isn)          ,AgeMax)
+c #AG     a_SII1      =     a_SII1      -0.175*agesno/AgeMax
+!                                        Impurities: Col de Porte Parameter.
+
+
+!    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
+c #CZ     csegal = max(czemax                   ,coszSV(ikl))
+c #cz     dalbeS =   ((bsegal+1.00)/(1.00+2.0*bsegal*csegal)
+c #cz.                -       1.00                          )*0.32
+c #cz.              /  bsegal
+c #cz     dalbeS = max(dalbeS,zer0)
+c #cz     dalbed =     dalbeS      *       min(1,isnoSV(ikl))
+
+c #CZ     dalbeW =(0.64 - csegal  )*0.0625  ! Warren 1982, RevGeo, fig.12b
+                                            ! 0.0625 = 5% * 1/0.8,   p.81
+                                            ! 0.64   = cos(50)
+c #CZ     dalbed =     dalbeW      *       min(1,isnoSV(ikl))
+
+! Col de Porte Integrated Snow/Ice Albedo
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #cp     IF (ColPrt.AND.TotSol.gt.0.)                              THEN
+c #cp       albSII =  (((Dr_1SN*a_SII1+Dr_2SN*a_SII2+Dr_3SN*a_SII3)
+c #cp.                  +dalbed                                    )
+c #cp.                  *DirSol
+c #cp.                 +(Df_1SN*a_SII1+Df_2SN*a_SII2+Df_3SN*a_SII3)
+c #cp.                  *DifSol*(1.   -cld_SV(ikl))
+c #cp.                 +(Dfc1SN*a_SII1+Dfc2SN*a_SII2+Dfc3SN*a_SII3)
+c #cp.                  *DifSol*       cld_SV(ikl)                  )
+c #cp.                 / TotSol
+
+! Elsewhere    Integrated Snow/Ice Albedo
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #cp     ELSE
+            albSII =     So1dSV*a_SII1
+     .                 + So2dSV*a_SII2
+     .                 + So3dSV*a_SII3
+c #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)
+
+
+! Integrated Snow/Ice/Soil Albedo: Clouds Correction! Greuell & all., 1994
+! --------------------------------------------------! Glob.&t Planet.Change
+                                                    ! (9):91-114
+c #cp     IF (.NOT.ColPrt)                                          THEN
+            alb1sv(ikl) = alb1sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+c #CZ.                  + dalbed      *    (1.-cld_SV(ikl))
+            alb2sv(ikl) = alb2sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+c #CZ.                  + dalbed      *    (1.-cld_SV(ikl))
+            alb3sv(ikl) = alb3sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+c #CZ.                  + dalbed      *    (1.-cld_SV(ikl))
+            albisv(ikl) = albisv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+c #CZ.                  + dalbed      *    (1.-cld_SV(ikl))
+c #cp     END IF
+
+
+! Integrated Snow/Ice/Soil Albedo: Minimum snow albedo = 40%
+! ----------------------------------------------------------
+
+            albedo_old  = albisv(ikl)
+
+            albisv(ikl) = max(albisv(ikl),0.400    * 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
+
+
+! Integrated Snow/Ice/Soil Albedo: Maximum albedo = 99%
+! -----------------------------------------------------
+
+            albedo_old  = albisv(ikl)
+            albisv(ikl) = min(albisv(ikl),0.99)
+            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
+
+            alb1sv(ikl) = min(max(zer0,alb1sv(ikl)),albmax)  
+            alb2sv(ikl) = min(max(zer0,alb2sv(ikl)),albmax)
+            alb3sv(ikl) = min(max(zer0,alb3sv(ikl)),albmax)
+
+        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
+
+      DO   isn=nsno,1,-1
+        DO ikl=1,knonv
+
+          SignRo = sign(un_1, rocdSV - ro__SV(ikl,isn))
+          SnowOK =  max(zer0,SignRo) ! Ice Density Threshold
+
+          RoFrez =  1.e-3      * ro__SV(ikl,isn) * (1.0-eta_SV(ikl,isn))
+
+          OpSqrt = sqrt(max(eps6,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
+
+! Col de Porte Snow Extinction Coefficient
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #cp     IF (ColPrt.AND.TotSol.gt.0.)                              THEN
+c #cp       exarg1 = exarg1*(Dr_1SN*DirSol
+c #cp.                      +Df_1SN*DifSol*(1.-cld_SV(ikl))
+c #cp.                      +Dfc1SN*DifSol*    cld_SV(ikl) )
+c #cp.                     /(Dr_1SN*TotSol)
+c #cp       exarg2 = exarg2*(Dr_2SN*DirSol
+c #cp.                      +Df_2SN*DifSol*(1.-cld_SV(ikl))
+c #cp.                      +Dfc2SN*DifSol*    cld_SV(ikl) )
+c #cp.                     /(Dr_2SN*TotSol)
+c #cp       exarg3 = exarg3*(Dr_3SN*DirSol
+c #cp.                      +Df_3SN*DifSol*(1.-cld_SV(ikl))
+c #cp.                      +Dfc3SN*DifSol*    cld_SV(ikl) )
+c #cp.                     /(Dr_3SN*TotSol)
+c #cp     END IF
+
+
+! Integrated Extinction of Solar Irradiance (Normalized Value)
+! ============================================================
+
+          sExt_1(ikl) = sExt_1(ikl)
+     .                          * exp(min(0.0,-exarg1 *dzsnSV(ikl,isn)))
+          sign_0      =              sign(un_1,epsn   -sExt_1(ikl))
+          sExt_0      =               max(zer0,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(un_1,epsn   -sExt_2(ikl))
+          sExt_0      =               max(zer0,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(un_1,epsn   -sExt_3(ikl))
+          sExt_0      =               max(zer0,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
+
+
+! Albedo: IO
+! ==========
+
+! #va IF (.NOT.aw_opn)                                              THEN
+! #va          aw_opn = .true.
+! #va          open(unit=46,status='unknown',file='SnOptP____.va')
+! #va          rewind(   46)
+! #va END IF
+
+! #va     ikl=1
+! #va     write(46,460)daHost
+ 460      format('---------------------------------+----+',
+     .          '-------+-------+-------+-------+-------+-------+',
+     .                                  '-------+-------+-------+',
+     .         /,'Snow/Ice Pack ',a18,' |    |',
+     .          ' z [m] |0.3/0.8|0.8/1.5|1.5/2.8| Full  |Opt[mm]|',
+     .                                  ' G1    | G2    | ro    |',
+     .         /,'---------------------------------+----+',
+     .          '-------+-------+-------+-------+-------+-------+',
+     .                                  '-------+-------+-------+')
+!         ______________________________________________________________
+! #va     write(46,461)            SIce_H,
+! #va.                             alb1sv(ikl),alb2sv(ikl),alb3sv(ikl),
+! #va.                             albisv(ikl)
+ 461      format('Integrated Snow/Ice/Soil  Albedo |',
+     .            3x,' |',  f6.3,' |' ,4(f6.3,' |'), 6x ,' |',
+     .                                            3( 6x ,' |'))
+!         ______________________________________________________________
+! #va     write(46,462)ispiSV(ikl),a_SII1,a_SII2,a_SII3,albSII
+ 462      format('Integrated Snow/Ice       Albedo |',
+     .            i3,' |',   6x ,' |' ,4(f6.3,' |'), 6x ,' |',
+     .                                            3( 6x ,' |'))
+!         ______________________________________________________________
+! #va     write(46,463)            rusnSV(ikl),         albWIc,
+! #va.                             SWS_SV(ikl)
+ 463      format('Integrated Water/Bare Ice Albedo |',
+     .            3x,' |',  f6.3,'w|' ,3( 6x, ' |'),  
+     .                                   f6.3,' |' ,f6.3,' |',
+     .                                            3( 6x ,' |'))
+!         ______________________________________________________________
+! #va     write(46,465)isn1       ,zzsnsv(ikl,isn1),
+! #va.                             albIc1,albIc2,albIc3,albIce,
+! #va.                        1.e3*SnOpSV(ikl,max(1,isnoSV(ikl)-1)),
+! #va.                             G1snSV(ikl,max(1,isnoSV(ikl)-1)),
+! #va.                             G2snSV(ikl,max(1,isnoSV(ikl)-1)),
+! #va.                             ro__SV(ikl,max(1,isnoSV(ikl)-1))
+! #va.                      *(1. - eta_SV(ikl,max(1,isnoSV(ikl)-1)))
+ 465      format('Surficial       Ice Lense        |',
+     .            i3,' |', (f6.3,'i|'),4(f6.3,' |'),f6.3,' |',
+     .                                            3(f6.1,' |'))
+!         ______________________________________________________________
+! #va     write(46,466)isnoSV(ikl),zzsnsv(ikl,isnoSV(ikl)),
+! #va.                             albSn1,albSn2,albSn3,albSno,
+! #va.                        1.e3*SnOpSV(ikl,isnoSV(ikl)),
+! #va.                             G1snSV(ikl,isnoSV(ikl)),
+! #va.                             G2snSV(ikl,isnoSV(ikl)),
+! #va.                             ro__SV(ikl,isnoSV(ikl))
+! #va.                      *(1. - eta_SV(ikl,isnoSV(ikl)))
+ 466      format('Uppermost  Effective Snow Layer  |',
+     .            i3,' |', (f6.3,'*|'),4(f6.3,' |'),f6.3,' |',
+     .                                            3(f6.1,' |'))
+
+      return
+      end
+
+
+      subroutine VgOptP
+
+!--------------------------------------------------------------------------+
+!   MAR/SISVAT   VgOptP                               Sat 12-Feb-2012  MAR |
+!     SubRoutine VgOptP computes the Canopy    optical Properties          |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: Total Number of columns =                        |
+!     ^^^^^^^^^^        = Total Number of continental     Grid Boxes       |
+!                       X       Number of Mosaic Cell per Grid Box         |
+!                                                                          |
+!     INPUT:   ivgtSV   = 0,...,12:   Vegetation Type                      |
+!     ^^^^^               0:          Water, Solid or Liquid               |
+!                                                                          |
+!     INPUT:   coszSV   : Cosine of the Sun Zenithal Distance          [-] |
+!     ^^^^^    sol_SV   : Surface Downward  Solar   Radiation       [W/m2] |
+!              snCaSV   : Canopy     Snow      Thickness         [mm w.e.] |
+!                                                                          |
+!              LAI_sv   : Leaf Area  Index      (snow included)        [-] |
+!              glf_sv   : Green Leaf Fraction of NOT fallen Leaves     [-] |
+!              albisv   : Snow/Ice/Water/Soil Integrated Albedo        [-] |
+!                                                                          |
+!     OUTPUT:  alb_SV   : Surface-Canopy Albedo                        [-] |
+!     ^^^^^^   SoCasv   : Absorbed Solar Radiation by Canopy (Normaliz)[-] |
+!              SoSosv   : Absorbed Solar Radiation by Surfac (Normaliz)[-] |
+!              LAIesv   : Effective Leaf Area  Index for Transpiration [-] |
+!                                                                          |
+!     Internal Variables: Normalized Values:                               |
+!     ^^^^^^^^^^^^^^^^^^                                                   |
+!              u0_Vis   : Upward   Visible Radiation at Top Canopy     [-] |
+!              absg_V   : Absorbed Visible Radiation by the Ground     [-] |
+!              absv_V   : Absorbed Visible Radiation by the Canopy     [-] |
+!              u0_nIR   : Upward   Near IR Radiation at Top Canopy     [-] |
+!              absgnI   : Absorbed Near IR Radiation by the Ground     [-] |
+!              absv_V   : Absorbed Near IR Radiation by the Canopy     [-] |
+!                                                                          |
+!     REFERENCE:   De Ridder, 1997, unpublished thesis, chapter 2 (DR97,2) |
+!     ^^^^^^^^^                                                            |
+!                                                                          |
+!     ASSUMPTIONS: Leaf Inclination Index chi_l (eqn2.49 DR97) set to zero |
+!     ^^^^^^^^^^^                         for all vegetation types         |
+!                  Radiation Fluxes are normalized                         |
+!                        with respect to incoming solar radiation (=I0+D0) |
+!                                                                          |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+
+      USE VARxSV
+      USE VARySV
+
+
+      IMPLICIT NONE
+ 
+! Internal Variables
+! ==================
+
+      integer   ikl   ,kri
+
+      real      exdRad,k_drad,k___sv(klonv)
+      real      e_prad,e1pRad
+      real      zv_fac,zv1fac,deadLF
+      real      T_Rad0,A_Rad0,A0__sv(klonv)
+      real                    r0_Rad,t0_Rad,nu_Rad
+      real      Tr_Rad,Re_Rad,r__Rad,t__Rad,t1_Rad
+      real      arggam, gamma,gamasv(klonv),gammaL
+      real      denSig,Sig__c,Sigcsv(klonv)
+      real      DDifH1,DDifC1,C1__sv(klonv)
+      real      DDifH2,DDifC2,C2__sv(klonv)
+      real      denS_s,denS_a,den_c1,DDif_L
+      real      u0_Vis,absg_V,absv_V
+      real      u0_nIR,absgnI,absvnI
+      real      argexg,argexk,criLAI(klonv)
+      real      residu,d_DDif,dDDifs,dDDifa
+
+
+! Internal DATA
+! =============
+
+      integer            nvgt
+      parameter         (nvgt=12)
+      real      reVisL(0:nvgt)      ! Reflectivity  / Visible / Live Leaves
+      real      renIRL(0:nvgt)      ! Reflectivity  / Near IR / Live Leaves
+      real      trVisL(0:nvgt)      ! Transmitivity / Visible / Live Leaves
+      real      trnIRL(0:nvgt)      ! Transmitivity / Near IR / Live Leaves
+      real      reVisD(0:nvgt)      ! Reflectivity  / Visible / Dead Leaves
+      real      renIRD(0:nvgt)      ! Reflectivity  / Near IR / Dead Leaves
+      real      trVisD(0:nvgt)      ! Transmitivity / Visible / Dead Leaves
+      real      trnIRD(0:nvgt)      ! Transmitivity / Near IR / Dead Leaves
+
+      real      reVisS              ! Reflectivity  / Visible / Canopy Snow
+      real      renIRS              ! Reflectivity  / Near IR / Canopy Snow
+      real      trVisS              ! Transmitivity / Visible / Canopy Snow
+      real      trnIRS              ! Transmitivity / Near IR / Canopy Snow
+
+      real      snCaMx              ! Canopy Snow Thickness for having Snow
+                                    ! Snow Reflectivity and Transmitivity
+      real      CriStR              ! Critical Radiation Stomatal Resistance
+
+      integer            ivg
+
+      DATA (reVisL(ivg),renIRL(ivg),trVisL(ivg),trnIRL(ivg),
+     .      reVisD(ivg),renIRD(ivg),trVisD(ivg),trnIRD(ivg),ivg=0,nvgt)
+
+!     reVisL renIRL trVisL trnIRL reVisD renIRD trVisD trnIRD  IGBP     CLASSES
+!     ------ ------ ------ ------ ------ ------ ------ ------+ ----------------
+     ./0.11,  0.58,  0.07,  0.25,  0.36,  0.58,  0.22,  0.38,!  0 NO VEGETATION
+     . 0.11,  0.58,  0.07,  0.25,  0.36,  0.58,  0.22,  0.38,!  1 CROPS LOW
+     . 0.11,  0.58,  0.07,  0.25,  0.36,  0.58,  0.22,  0.38,!  2 CROPS MEDIUM
+     . 0.11,  0.58,  0.07,  0.25,  0.36,  0.58,  0.22,  0.38,!  3 CROPS HIGH
+     . 0.11,  0.58,  0.07,  0.25,  0.36,  0.58,  0.22,  0.38,!  4 GRASS LOW
+     . 0.11,  0.58,  0.07,  0.25,  0.36,  0.58,  0.22,  0.38,!  5 GRASS MEDIUM
+     . 0.11,  0.58,  0.07,  0.25,  0.36,  0.58,  0.22,  0.38,!  6 GRASS HIGH
+     . 0.10,  0.45,  0.05,  0.25,  0.16,  0.39,  0.01,  0.01,!  7 BROADL LOW
+     . 0.10,  0.45,  0.05,  0.25,  0.16,  0.39,  0.01,  0.01,!  8 BROADL MEDIUM
+     . 0.10,  0.45,  0.05,  0.25,  0.16,  0.39,  0.01,  0.01,!  9 BROADL HIGH
+     . 0.07,  0.35,  0.05,  0.10,  0.10,  0.39,  0.01,  0.01,! 10 NEEDLE LOW
+     . 0.07,  0.35,  0.05,  0.10,  0.10,  0.39,  0.01,  0.01,! 11 NEEDLE MEDIUM
+     . 0.07,  0.35,  0.05,  0.10,  0.10,  0.39,  0.01,  0.01/! 12 NEEDLE HIGH
+
+      DATA 
+     .reVisS,renIRS,trVisS,trnIRS
+!     ------ ------ ------ ------+
+     ./0.85,  0.85,  0.00,  0.00/!
+!     REMARK: Possible Refinement by taking actual Surface Snow Reflectivities
+!     ^^^^^^
+
+      DATA      snCaMx /0.5/
+
+      DATA      CriStR /25./
+
+
+! General Parameters, Solar Radiation Absorption
+! ==============================================
+
+      DO ikl=1,knonv
+
+            k_dRad = 0.5 /max(coszSV(ikl),eps6) ! absorbed irradiance fraction
+            e_pRad = 2.5   *  coszSV(ikl)       ! exponential argument,   
+                                                ! V/nIR radiation partitioning,
+                                                ! DR97, 2, eqn (2.53) & (2.54)
+            exdRad =    exp(-k_dRad*LAI_sv(ikl))! exponential, Irradi. Absorpt.
+            e1pRad = 1.-exp(-e_pRad)            ! exponential, V/nIR Rad. Part.
+
+            ivg    =                ivgtSV(ikl) ! Vegetation Type
+            zv_fac =    min( snCaSV(ikl)/snCaMx ! Contribution of Snow to Leaf
+     .                      ,  un_1)            ! Reflectivity and Transmissiv.
+            zv1fac = 1.     -       zv_fac      !
+            deadLF = 1.     -       glf_sv(ikl) ! Dead Leaf Fraction
+
+
+! Visible Part of the Solar Radiation Spectrum (V,   0.4--0.7mi.m)
+! ================================================================
+
+            A_Rad0 =      0.25 + 0.697 * e1pRad ! Absorbed    Vis. Radiation
+            T_Rad0 = 1. - A_Rad0                ! Transmitted Vis  Radiation
+
+! Reflectivity, Transmissivity
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            Re_Rad = glf_sv(ikl) *ReVisL(ivg) 
+     .             + deadLF      *ReVisD(ivg)
+            Tr_Rad = glf_sv(ikl) *TrVisL(ivg) 
+     .             + deadLF      *TrVisD(ivg)
+
+! Adaptation to Snow
+! ^^^^^^^^^^^^^^^^^^
+            Re_Rad = zv1fac      *Re_Rad      + zv_fac *reVisS
+            Tr_Rad = zv1fac      *Tr_Rad      + zv_fac *trVisS
+
+! Scattering /DR97, 2, eqn (2.26) and (2.27)           ! Diffuse  Radiation:
+! ^^^^^^^^^^                                           ! ^^^^^^^^^^^^^^^^^^
+            r__Rad = (2. *Re_Rad +     Tr_Rad) / 3.    ! Upw.  Scatter.Fract.
+            t__Rad = (    Re_Rad + 2. *Tr_Rad) / 3.    ! Downw.Scatter.Fract.
+
+            t1_Rad =  1. -t__Rad                       !
+            arggam =      t1_Rad*t1_Rad-r__Rad*r__Rad  !
+            arggam =  max(arggam,zer0)                 !
+            gamma  = sqrt(arggam)                      ! eqn (2.39)
+            gammaL =  min( gamma*LAI_sv(ikl),40.0)     !
+            DDifH1 =  exp( gammaL           )          ! Downw.Diffus.Solut.1
+            DDifH2 =  exp(-gammaL           )          ! Downw.Diffus.Solut.2
+!           REMARK:  These 2 contributions are zero in case of 0 Reflectivity
+!           ^^^^^^
+
+! Scattering /DR97, 2, eqn (2.19) and (2.20)           ! Direct   Radiation:
+! ^^^^^^^^^^                                           ! ^^^^^^^^^^^^^^^^^^
+            r0_Rad = 0.5 *((Re_Rad+Tr_Rad) *k_dRad     ! Upw.  Scatter.Fract.
+     .                    +(Re_Rad-Tr_Rad) /    3.)    ! 
+            t0_Rad = 0.5 *((Re_Rad+Tr_Rad) *k_dRad     ! Downw.Scatter.Fract.
+     .                    -(Re_Rad-Tr_Rad) /    3.)    !
+
+            nu_Rad = t1_Rad-r__Rad*albisv(ikl)         ! nu coeff., eqn 2.43
+            den_c1 =  gamma*(DDifH1+DDifH2)            ! eqn (2.43) Denomin. 
+     .              +nu_Rad*(DDifH1-DDifH2)            !(Constant for DDifH1)
+
+            denSig =  gamma*gamma - k_dRad*k_dRad      ! eqn (2.40) Denomin.
+            denS_s = sign(un_1,denSig)                 !
+            denS_a =  abs(     denSig)                 !
+            denSig =  max(eps6,denS_a) * denS_s        !
+            Sig__c = (r__Rad* r0_Rad                   ! sigma_c, eqn (2.40)
+     .               +t0_Rad*(k_dRad+t1_Rad)) / denSig ! 
+
+            DDifC1 = ((gamma-nu_Rad)*(T_Rad0-Sig__c*A_Rad0)*DDifH2
+     .             +((k_dRad-nu_Rad)* Sig__c
+     .               +t0_Rad+r__Rad * albisv(ikl)) *A_Rad0 *exdRad)
+     .           /max(den_c1,eps6)
+            DDifC2 =  T_Rad0        - DDifC1-Sig__c*A_Rad0
+
+! Visible Diffuse Fluxes
+! ^^^^^^^^^^^^^^^^^^^^^^
+            DDif_L =  DDifC1*DDifH1 + DDifC2*DDifH2    ! DOWNward,
+     .             +  Sig__c*A_Rad0 *exdRad            ! Canopy Basis
+            u0_Vis = ((gamma+t1_Rad)*DDifC1            ! UPward
+     .               -(gamma-t1_Rad)*DDifC2            ! Canopy Top
+     .             -((k_dRad-t1_Rad)*Sig__c            !
+     .               +t0_Rad               )*A_Rad0)   !
+     .          / max(r__Rad,eps6)                     !
+            u0_Vis = min(0.99,max(eps6,u0_Vis))        ! ERROR 
+            absg_V = (1.-albisv(ikl))*(A_Rad0*exdRad   ! Ground Absorption
+     .                                +DDif_L       )  !
+            absv_V = (1.-u0_Vis     )- absg_V          ! Veget. Absorption
+
+! Parameters for Computing Effective LAI for Transpiration
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            gamasv(ikl) = gamma
+            C1__sv(ikl) = DDifC1
+            C2__sv(ikl) = DDifC2
+            Sigcsv(ikl) = Sig__c
+            k___sv(ikl) = k_dRad
+            A0__sv(ikl) = A_Rad0
+
+
+! Near-IR Part of the Solar Radiation Spectrum (nIR, 0.7--2.8mi.m)
+! ================================================================
+
+            A_Rad0 =      0.80 + 0.185 * e1pRad ! Absorbed    nIR. Radiation
+            T_Rad0 = 1. - A_Rad0                ! Transmitted nIR  Radiation
+
+! Reflectivity, Transmissivity
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            Re_Rad = glf_sv(ikl) *RenIRL(ivg) 
+     .             + deadLF      *RenIRD(ivg)
+            Tr_Rad = glf_sv(ikl) *TrnIRL(ivg) 
+     .             + deadLF      *TrnIRD(ivg)
+
+! Adaptation to Snow
+! ^^^^^^^^^^^^^^^^^^
+            Re_Rad = zv1fac      *Re_Rad      + zv_fac *renIRS
+            Tr_Rad = zv1fac      *Tr_Rad      + zv_fac *trnIRS
+
+! Scattering /DR97, 2, eqn (2.26) and (2.27)           ! Diffuse  Radiation:
+! ^^^^^^^^^^                                           ! ^^^^^^^^^^^^^^^^^^
+            r__Rad = (2. *Re_Rad +     Tr_Rad) / 3.    ! Upw.  Scatter.Fract.
+            t__Rad = (    Re_Rad + 2. *Tr_Rad) / 3.    ! Downw.Scatter.Fract.
+
+            t1_Rad =  1. -t__Rad                       !
+            arggam =      t1_Rad*t1_Rad-r__Rad*r__Rad  !
+            arggam =  max(arggam,zer0)                 !
+            gamma  = sqrt(arggam)                      ! eqn (2.39)
+            DDifH1 =  exp( gamma*LAI_sv(ikl))          ! Downw.Diffus.Solut.1
+            DDifH2 =  exp(-gamma*LAI_sv(ikl))          ! Downw.Diffus.Solut.2
+!           REMARK:  These 2 contributions are zero in case of 0 Reflectivity
+!           ^^^^^^
+
+! Scattering /DR97, 2, eqn (2.19) and (2.20)           ! Direct   Radiation:
+! ^^^^^^^^^^                                           ! ^^^^^^^^^^^^^^^^^^
+            r0_Rad = 0.5 *((Re_Rad+Tr_Rad) *k_dRad     ! Upw.  Scatter.Fract.
+     .                    +(Re_Rad-Tr_Rad) /    3.)    ! 
+            t0_Rad = 0.5 *((Re_Rad+Tr_Rad) *k_dRad     ! Downw.Scatter.Fract.
+     .                    -(Re_Rad-Tr_Rad) /    3.)    !
+
+            nu_Rad = t1_Rad-r__Rad*albisv(ikl)         ! nu coeff., eqn 2.43
+            den_c1 =  gamma*(DDifH1+DDifH2)            ! eqn (2.43) Denomin. 
+     .              +nu_Rad*(DDifH1-DDifH2)            !(Constant for DDifH1)
+
+            denSig =  gamma*gamma - k_dRad*k_dRad      ! eqn (2.40) Denomin.
+            denS_s = sign(un_1,denSig)                 !
+            denS_a =  abs(     denSig)                 !
+            denSig =  max(eps6,denS_a) * denS_s        !
+            Sig__c = (r__Rad* r0_Rad                   ! sigma_c, eqn (2.40)
+     .               +t0_Rad*(k_dRad+t1_Rad)) / denSig ! 
+
+            DDifC1 = ((gamma-nu_Rad)*(T_Rad0-Sig__c*A_Rad0)*DDifH2
+     .             +((k_dRad-nu_Rad)* Sig__c
+     .               +t0_Rad+r__Rad * albisv(ikl)) *A_Rad0 *exdRad)
+     .           /max(den_c1,eps6)
+            DDifC2 =  T_Rad0        - DDifC1-Sig__c*A_Rad0
+
+! Near IR Diffuse Fluxes
+! ^^^^^^^^^^^^^^^^^^^^^^
+            DDif_L =  DDifC1*DDifH1 + DDifC2*DDifH2    ! DOWNward,
+     .             +  Sig__c*A_Rad0 *exdRad            ! Canopy Basis
+            u0_nIR = ((gamma+t1_Rad)*DDifC1            ! UPward
+     .               -(gamma-t1_Rad)*DDifC2            ! Canopy Top
+     .             -((k_dRad-t1_Rad)*Sig__c            !
+     .               +t0_Rad               )*A_Rad0)   !
+     .          / max(r__Rad,eps6)                     !
+            u0_nIR = min(0.99,max(eps6,u0_nIR))        ! ERROR
+            absgnI = (1.-albisv(ikl))*(A_Rad0*exdRad   ! Ground Absorption
+     .                                +DDif_L       )  !
+            absvnI = (1.-u0_nIR     )- absgnI          ! Veget. Absorption
+
+
+! Surface-Canopy Albedo and Normalized Solar Radiation Absorption
+! ===============================================================
+
+            alb_SV(ikl) = (u0_Vis+u0_nIR)*0.5d0
+            SoCasv(ikl) = (absv_V+absvnI)*0.5d0
+            SoSosv(ikl) = (absg_V+absgnI)*0.5d0
+
+      END DO
+
+
+! Effective LAI for Transpiration
+! ===============================
+
+        DO ikl=1,knonv
+              criLAI(ikl) = 2.                  ! LAI for which D0_Vis > 20W/m2
+                                                ! DR97, 2, eqn (2.57)
+        END DO
+
+      DO   kri=1,10
+        DO ikl=1,knonv
+
+              argexg      =  min(criLAI(ikl)*gamasv(ikl),     ea_Max)
+              argexk      =  min(criLAI(ikl)*k___sv(ikl),     ea_Max)
+              residu      =      C1__sv(ikl)            *exp( argexg)
+     .                          +C2__sv(ikl)            *exp(-argexg)
+     .                          +A0__sv(ikl)*gamasv(ikl)*exp(-argexk)
+     .                          -CriStR /max(sol_SV(ikl),       eps6)
+
+              d_DDif      =      C1__sv(ikl)*gamasv(ikl)*exp( argexg)
+     .                          -C2__sv(ikl)*gamasv(ikl)*exp(-argexg)
+     .                          -A0__sv(ikl)*k___sv(ikl)*exp(-argexk)
+              dDDifs      = sign(un_1,d_DDif)
+              dDDifa      =  abs(     d_DDif)
+              d_DDif      =  max(eps6,dDDifa) * dDDifs
+
+              criLAI(ikl) =      criLAI(ikl)-residu/d_DDif
+              criLAI(ikl) =  max(criLAI(ikl),zer0       )
+              criLAI(ikl) =  min(criLAI(ikl),LAI_sv(ikl))
+
+        END DO
+      END DO
+
+        DO ikl=1,knonv
+              LAIesv(ikl) = criLAI(ikl) +(exp(-k___sv(ikl)*criLAI(ikl))
+     .                                   -exp(-k___sv(ikl)*LAI_sv(ikl)))
+     .                                  /      k___sv(ikl)
+        END DO
+
+      return
+      end
+
+
+      subroutine ColPrt_SBL
+
+!--------------------------------------------------------------------------+
+!   MAR          ColPrt_SBL                           Sat 12-Feb-2012  MAR |
+!     SubRoutine ColPrt_SBL generates Surface Boundary Layers Properties   |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: Total Number of columns                          |
+!     ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+!                       X       Number of Mosaic Cell per grid box         |
+!                                                                          |
+!     INPUT:   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] |
+!              uqs_SV   : Specific  Humidity  Turbulent Flux         [m/s] |
+!              Tsrfsv   : Surface    Temperature                       [K] |
+!                                                                          |
+!     INPUT /  LMO_SV   : Monin-Obukhov       Scale                    [m] |
+!     OUTPUT:  us__SV   : Friction  Velocity                         [m/s] |
+!     ^^^^^^   uts_SV   : Temperature         Turbulent Flux       [K.m/s] |
+!                                                                          |
+!     OUTPUT:  ram_sv   : Aerodynamic Resistance for Momentum        [s/m] |
+!     ^^^^^^   rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!                                                                          |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+
+      USE VARxSV
+      USE VARySV
+
+      IMPLICIT NONE
+
+
+! Internal Variables
+! ==================
+
+      integer   ikl    ,ist    ,ist__s ,ist__w
+      real      d_TaTs ,CD_m
+      real      uustar ,thstar ,qqstar ,ssstar
+      real      thstarv,thstars,thstara
+      real      zeta   ,zeta_S ,zeta_A
+      real      fCdCdP ,Cd_min ,cCdUns
+      real      RapCm0
+
+
+! Internal DATA
+! =============
+
+      data      fCdCdP/ 3.09/   ! Drag Coefficient Factor, Col de Porte
+      data      Cd_min/ 1.05/   ! Drag Coefficient Minimum Col de Porte
+      data      cCdUns/-5.00/   ! Drag Coefficient Correction for Unstability
+
+
+! Aerodynamic Resistances
+! =======================
+
+      DO ikl=1,knonv
+
+! Surface Type
+! ~~~~~~~~~~~~
+        ist    =      isotSV(ikl)                    ! Soil Type
+        ist__s =  min(ist, 1)                        ! 1 => Soil
+        ist__w =  1 - ist__s                         ! 1 => Water Body
+
+! Drag and Aerodynamic Resistance
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        d_TaTs =      TaT_SV(ikl)-Tsrfsv(ikl)
+        RapCm0 =  log(za__SV(ikl)/Z0mdSV(4          ))
+     .         /  log(za__SV(ikl)/Z0mdSV(ivgtSV(ikl)))
+        RapCm0 =      RapCm0     *RapCm0             ! Neutral Drag Coefficient
+                                                     ! Vegetation   Correction
+        CD_m   =  max(Cd_min*RapCm0,                 ! Actual  Drag Coefficient
+     .                fCdCdP*RapCm0*VV__SV(ikl)  )   !         for  Momentum
+     .          *(1.+max(min(d_TaTs,zer0),cCdUns)    ! Unstability  Correction
+     .                                   /cCdUns )
+     .          * 1.5
+        ram_sv(ikl) = rhT_SV(ikl) *CpdAir/CD_m
+        rah_sv(ikl) = ram_sv(ikl)
+
+
+! Turbulent Scales
+! ================
+
+! Friction Velocity                   u*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        uustar      =      VV__SV(ikl) / ram_sv(ikl)
+        us__SV(ikl) = sqrt(uustar)
+
+! Real    Temperature Turbulent Scale theta*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        uts_SV(ikl) =    - d_TaTs      / rah_sv(ikl)
+        thstar      =      uts_SV(ikl) / us__SV(ikl)
+
+! Specific Humidity   Turbulent Scale qq*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        qqstar      =      uqs_SV(ikl) / us__SV(ikl) 
+
+! Virtual Temperature Turbulent Scale thetav*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        thstarv     = thstar      + TaT_SV(ikl) *(0.608*qqstar)
+        thstars     =     sign(un_1,thstarv)
+        thstara     =      abs(     thstarv)
+        thstarv     =      max(eps6,thstara)    *thstars
+
+! Monin Obukhov Scale Height
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~
+        LMO_SV(ikl) = TaT_SV(ikl) * uustar 
+     .              /(vonKrm      * Grav_F     * thstarv)
+        zeta        = za__SV(ikl) / LMO_SV(ikl)
+        zeta_S      =          sign(un_1  ,zeta)
+        zeta_A      =           abs(       zeta)
+        zeta        = zeta_S  * max(eps6  ,zeta_A)
+        LMO_SV(ikl) = za__SV(ikl) / zeta
+
+      END DO
+
+      return
+      end
+
+      subroutine SISVATeSBL
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVATeSBL                           Tue 12-Apr-2011  MAR |
+!     SubRoutine SISVATeSBL generates Surface Boundary Layers Properties   |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: Total Number of columns                          |
+!     ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+!                       X       Number of Mosaic Cell per grid box         |
+!                                                                          |
+!     INPUT:   za__SV   : Surface Boundary Layer (SBL) Height          [m] |
+!     ^^^^^    VV__SV   :(SBL Top)   Wind Velocity                   [m/s] |
+!              TaT_SV   : SBL Top    Temperature                       [K] |
+!              ExnrSV   : Exner      Potential                         [-] |
+!              qsnoSV   : SBL Mean   Snow      Content             [kg/kg] |
+!              uqs_SV   : Specific   Humidity  Turbulent Flux        [m/s] |
+!              usthSV   : Blowing Snow Erosion   Threshold           [m/s] |
+!              Z0m_SV   : Momentum     Roughness Length                [m] |
+!              Z0h_SV   : Heat         Roughness Length                [m] |
+!              Tsrfsv   : Surface    Temperature                       [K] |
+!              sqrCm0   : Contribution of Z0m to Neutral Drag Coefficient  |
+!              sqrCh0   : Contribution of Z0h to Neutral Drag Coefficient  |
+!                                                                          |
+!     INPUT /  LMO_SV   : Monin-Obukhov       Scale                    [m] |
+!     OUTPUT:  us__SV   : Friction  Velocity                         [m/s] |
+!     ^^^^^^   uts_SV   : Temperature         Turbulent Flux       [K.m/s] |
+!              uss_SV   : Blowing Snow        Turbulent Flux         [m/s] |
+!                                                                          |
+!     OUTPUT:  hSalSV   : Saltating Layer Height                       [m] |
+!     ^^^^^^   qSalSV   : Saltating Snow  Concentration            [kg/kg] |
+!              ram_sv   : Aerodynamic Resistance for Momentum        [s/m] |
+!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: STANDARD Possibility                          |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^^^^^^^^^^^^                          |
+!     #AE: TURBULENCE: Aerosols Erosion / Turbulent Diffusion Coeff.       |
+!                                                                          |
+!     #AW  TURBULENCE: Wind Time Mean (BOX Moving Average)                 |
+!     #AH  TURBULENCE: Ta-T Time Mean (BOX Moving Average)                 |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: OBSOLETE                                      |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^                                      |
+!     #AM  TURBULENCE: u*   Time Mean (BOX Moving Average)                 |
+!     #AT  TURBULENCE: u*T* Time Mean (BOX Moving Average)                 |
+!     #AS  TURBULENCE: u*s* Time Mean (BOX Moving Average)                 |
+!                                                                          |
+!     #ZX  TURBULENCE: Strong Stability Limit (King    et al. 1996)        |
+!     #zx  TURBULENCE: Strong Stability Limit (Mahalov et al. 2004)        |
+!     #IX  TURBULENCE: recurrence                                          |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # stdout               | #ss: OUTPUT of Blowing Snow Variables         |
+!                          |      unit  6, SubRoutine  SISVATeSBL **ONLY** |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+
+      USE VARxSV
+      USE VARySV
+      USE VARtSV
+
+      IMPLICIT NONE
+
+! V,  dT(a-s)    Time Moving Averages
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+cc #AA     integer                       ntaver,nt !
+cc #AA      parameter                    (ntaver= 4)! ntaver defined in MAR_SL.inc
+c #AW real             V__mem(klonv,ntaver)   !                   only
+c #AW real             VVmmem(klonv)          !
+c #AW common/SVeSBLmem/V__mem,VVmmem          !
+c #AH real             T__mem(klonv,ntaver)   !
+c #AH real             dTmmem(klonv)          !
+c #AH common/STeSBLmem/T__mem,dTmmem          !
+
+! u*, u*T*, u*s* Time Moving Averages
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AM real             u__mem(klonv,ntaver)
+c #AT real             uT_mem(klonv,ntaver)
+c #AS real             us_mem(klonv,ntaver)
+c #AM common/S_eSBLmem/u__mem
+c #AT.                ,uT_mem
+c #AS.                ,us_mem
+
+
+! Internal Variables
+! ==================
+
+      integer   ikl   ,icount
+c #AE integer   nit   ,iit
+      real      VVaSBL(klonv),VVa_OK          ! effective SBL wind speed
+      real      dTa_Ts(klonv)                 ! effective SBL Temperature diff.
+      real      Theta0                        ! Potential Reference Temperature
+      real      LMOmom(klonv)                 ! Monin-Obukhov Scale Momentum
+      real      LMOsgn                        ! Monin-Obukhov Scale Sign
+      real      LMOabs                        ! Monin-Obukhov Scale Abs.Value
+      real      uustar,thstar,qqstar,ssstar,thstarv,thstars,thstara
+      real      zetam ,zetah ,zeta_S,zeta_A,zeta0m ,zeta0h
+      real      psim_s,xpsimi,psim_i,psim_z
+      real      psis_s,psis_z,psis_0
+      real      psih_s,xpsihi,psih_i,psih_z
+      real      psim_0,psih_0
+      real      CDm(klonv)                    ! Drag Coefficient, Momentum
+      real      CDs(klonv),rCDs(klonv)        ! Drag Coefficient, Blown **
+      real      CDh(klonv)                    ! Drag Coefficient, Scalar
+      real      dustar,u0star,uTstar,usstar
+      real      sss__F,sss__N,usuth0
+c #AE real      dusuth,signus
+c #AE real      sss__K,sss__G
+c #AE real      us_127,us_227,us_327,us_427,us_527
+      real      zetMAX
+      real      coef_m,coef_h,stab_s
+c #AE real      SblPom
+      real      Richar(klonv)                 ! Richardson Number
+      real      fac_Ri,vuzvun,Kz_vun
+
+! OUTPUT of Snow Erosion Turbulence
+! #b1 real      W_pLMO                        ! Pseudo Obukhov Length  (WRITE)
+! #b1 real      W_psim                        ! Pseudo psim(z)         (WRITE)
+
+! OUTPUT of Snow Erosion Turbulence (2)
+! #b2 real      W_NUs1                        ! Contrib to U* numerat.1(WRITE)
+! #b2 real      W_NUs2                        ! Contrib to U* numerat.2(WRITE)
+! #b2 real      W_NUs3                        ! Contrib to U* numerat.3(WRITE)
+! #b2 real      W_DUs1                        ! Contrib to U* denomin.1(WRITE)
+! #b2 real      W_DUs2                        ! Contrib to U* denomin.2(WRITE)
+
+
+! Internal DATA
+! =============
+
+      data      Theta0/288.0/   ! Potential Reference Temperature
+c #ZX data      zetMAX/ 1.e6/   ! Strong Stability Limit
+c #zx 
+c2306-280611      data      zetMAX/ 1.e1/   ! Strong Stability Lim   
+c2806-290611      data      zetMAX/ 1.e0/   ! Strong Stability Limit
+                                !(Mahalov et al. 2004, GRL  31 2004GL021055)
+chj290911      data      zetMAX/ 4.28/   ! Strong Stability Limit
+c                                !(King    et al. 1996, JGR 101(7) p.19121)
+      data      zetMAX/ 0.0428/   ! Strong Stability Limit
+      data      coef_m/20.  /   ! Stabil.Funct.for Moment.: unstab.coef.
+      data      coef_h/15.  /   ! Stabil.Funct.for Heat:    unstab.coef.
+c #AE data      SblPom/ 1.27/   ! Lower Boundary Height Parameter 
+                                ! for Suspension
+                                ! Pommeroy, Gray and Landine 1993, 
+                                ! J. Hydrology, 144(8) p.169
+c #AE data      nit   / 5   /   ! us(is0,uth) recursivity: Nb Iterations 
+
+
+! Effective SBL variables
+! =======================
+
+      DO ikl=1,knonv
+        VVaSBL(ikl)   = VV__SV(ikl)
+c #AW !hj060511
+        VVaSBL(ikl)   = VVmmem(ikl)
+        dTa_Ts(ikl)   = TaT_SV(ikl)-Tsrfsv(ikl)
+c #AH!hj060511
+        dTa_Ts(ikl)   = dTmmem(ikl)
+      ENDDO
+
+
+! Convergence Criterion
+! =====================
+
+      icount = 0
+
+ 1    CONTINUE
+      icount = icount + 1
+      dustar = 0.
+
+        DO ikl=1,knonv
+
+          u0star      = us__SV(ikl)
+
+! u*, u*T*, u*s* Time Moving Averages
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AM     u0star      = 0.0
+c #AT     uTstar      = 0.0
+c #AS     usstar      = 0.0
+c #AM     DO nt=1,ntaver
+c #AM     u0star      = u0star + u__mem(ikl,nt)
+c #AT     uTstar      = uTstar + uT_mem(ikl,nt)
+c #AS     usstar      = usstar + us_mem(ikl,nt)
+c #AM     ENDDO
+c #AM     u0star      = u0star / ntaver
+c #AM     us__SV(ikl) = u0star
+c #AT     uts_SV(ikl) = uTstar / ntaver
+c #AS     uss_SV(ikl) = usstar / ntaver
+
+
+! Turbulent Scales from previous Time Step
+! ----------------------------------------
+
+          u0star      =      max(eps6,u0star)      ! Friction Velocity     u*
+          uustar      = u0star      * u0star       ! Friction Velocity^2  uu*
+          thstar      = uts_SV(ikl) / u0star       ! Temperature       theta*
+          qqstar      = uqs_SV(ikl) / u0star       ! Specific Humidity    qq*
+          ssstar      = uss_SV(ikl) / u0star       ! Blown    Snow        ss*
+
+
+! Monin-Obukhov Stability Parameter for Momentum
+! ----------------------------------------------
+
+! Pseudo Virtual Temperature Turbulent Scale thetav*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          thstarv     = thstar      + Theta0      *(0.608*qqstar)
+     .                             /(1.+0.608*QaT_SV(ikl)-qsnoSV(ikl))
+          thstars     =     sign(un_1,thstarv)
+          thstara     =      abs(     thstarv)
+          thstarv     =      max(eps6,thstara)*thstars
+
+! Pseudo Obukhov Length Scale        (Gall?e et al., 2001 BLM 99, (A2) p.17)
+! Full   Obukhov Length Scale        (when Blowing * is ##NOT## switched ON)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          LMO_SV(ikl) = Theta0      * max(eps6,uustar)
+     .                /(vonKrm      * Grav_F  *thstarv)
+
+! OUTPUT of Snow Erosion Turbulence
+! #b1     W_pLMO      = LMO_SV(ikl)
+
+          zetah       = za__SV(ikl) / LMO_SV(ikl)
+          zetam       =           min(zetMAX,zetah)! Strong Stability Limit
+                                                   !(Mahalov et al. 2004
+                                                   ! GRL 31 2004GL021055)
+          LMOmom(ikl) = za__SV(ikl) /(max(eps6,abs(zetam))
+     .                              *sign(un_1,    zetam ))
+          zeta0m      = Z0m_SV(ikl) / LMOmom(ikl)
+          zeta0h      = Z0h_SV(ikl) / LMO_SV(ikl)
+
+! Momentum Pseudo Stability Function (Gall?e et al. 2001, BLM 99, (11) p. 7)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          stab_s      =  max(zer0,sign(un_1,zetam))
+
+          psim_s      =  -A_Stab *zetam
+          xpsimi      = sqrt(sqrt(un_1-coef_m*min(zer0,zetam)))
+          psim_i      =   2. *log(half*(un_1+xpsimi)) 
+     .                       +log(half*(un_1+xpsimi*xpsimi))
+     .                   -2.*atan(xpsimi)   +half*piNmbr
+          psim_z      =    stab_s*psim_s+(1.-stab_s)*psim_i
+
+! OUTPUT of Snow Erosion Turbulence
+! #b1     W_psim      =           psim_z
+
+          psim_s      =  -A_Stab *zeta0m
+          xpsimi      = sqrt(sqrt(un_1-coef_m*min(zer0,zeta0m)))
+          psim_i      =   2. *log(half*(un_1+xpsimi)) 
+     .                       +log(half*(un_1+xpsimi*xpsimi))
+     .                   -2.*atan(xpsimi)   +half*piNmbr
+          psim_0      =    stab_s*psim_s+(1.-stab_s)*psim_i
+
+! Virtual Temperature Turbulent Scale thetav*    (ss* impact included   )
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ needed for new ss*)
+c #AE     thstarv     = thstar      + Theta0      *(0.608*qqstar
+c #AE.                                                   -ssstar
+c #AE.                                             )
+c #AE.                             /(1.+0.608*QaT_SV(ikl)-qsnoSV(ikl))
+c #AE     thstars     =     sign(un_1,thstarv)
+c #AE     thstara     =      abs(     thstarv)
+c #AE     thstarv     =      max(eps6,thstara)    *thstars
+
+! Full   Obukhov Length Scale        (Gall?e et al. 2001, BLM 99, (A1) p.16)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AE     LMO_SV(ikl) = Theta0      * us__SV(ikl)* us__SV(ikl)
+c #AE.                /(vonKrm      * Grav_F     * thstarv)
+
+c #AE     zetah       = za__SV(ikl) / LMO_SV(ikl)
+c #AE     zetam       =           min(zetMAX,zetah)! Strong Stability Limit
+                                                   !(Mahalov et al. 2004
+                                                   ! GRL 31 2004GL021055)
+c #AE     LMOmom(ikl) = za__SV(ikl) /(max(eps6,abs(zetam))
+c #AE.                              *sign(un_1,    zetam ))
+c #AE     zeta0m      = Z0m_SV(ikl) / LMOmom(ikl)
+
+! Snow Erosion    Stability Function (Gall?e et al. 2001, BLM 99, (11) p. 7)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AE     stab_s      =  max(zer0,sign(un_1,zetam))
+
+c #AE     psis_s      =  -AsStab *zetam
+c #AE     xpsimi      = sqrt(sqrt(un_1-coef_m*min(zer0,zetam)))
+c #AE     psim_i      =   2. *log(half*(un_1+xpsimi)) 
+c #AE.                       +log(half*(un_1+xpsimi*xpsimi))
+c #AE.                   -2.*atan(xpsimi)   +half*piNmbr
+c #AE     psis_z      =    stab_s*psis_s+(1.-stab_s)*psim_i
+
+c #AE     psis_s      =  -AsStab *zeta0m
+c #AE     xpsimi      = sqrt(sqrt(un_1-coef_m*min(zer0,zeta0m)))
+c #AE     psim_i      =   2. *log(half*(un_1+xpsimi)) 
+c #AE.                       +log(half*(un_1+xpsimi*xpsimi))
+c #AE.                   -2.*atan(xpsimi)   +half*piNmbr
+c #AE     psis_0      =    stab_s*psis_s+(1.-stab_s)*psim_i
+
+! Square Roots of the Drag Coefficient for Snow Erosion Turbulent Flux
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AE     rCDmSV(ikl) = vonKrm/(sqrCm0(ikl)-psim_z+psim_0)
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! #ss     IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV      .AND.
+! #ss.        nn__SV(ikl).EQ.nwr_SV                          )
+! #ss.    write(6,6600)  Z0m_SV(ikl) , psim_z
+! #ss.                  ,LMO_SV(ikl) , uustar
+! #ss.                  ,sqrCm0(ikl) , psim_0
+! #ss.                  ,LMOmom(ikl) , thstarv
+ 6600     format(/,' ** SISVATeSBL *0  '
+     .            ,'  Z0m_SV  = ',e12.4,'  psim_z  = ',e12.4
+     .            ,'  LMO_SV  = ',e12.4,'  uustar  = ',e12.4
+     .          ,/,'                   '
+     .            ,'  sqrCm0  = ',e12.4,'  psim_0  = ',e12.4
+     .            ,'  LMOmom  = ',e12.4,'  thstarv = ',e12.4)
+
+
+! Momentum            Turbulent Scale  u*
+! ---------------------------------------
+
+! Momentum            Turbulent Scale  u*          in case of NO Blow. Snow
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          VVa_OK      =  max(0.000001,       VVaSBL(ikl))
+          sss__N      =  vonKrm      *       VVa_OK
+          sss__F      = (sqrCm0(ikl) - psim_z + psim_0)
+          usuth0      =  sss__N /sss__F                ! u* if NO Blow. Snow
+
+! Momentum            Turbulent Scale  u*          in case of    Blow. Snow
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AE     sss__G      =  0.27417     * Grav_F
+
+! ______________               _____
+! Newton-Raphson (! Iteration, BEGIN)
+! ~~~~~~~~~~~~~~               ~~~~~
+c #AE     DO iit=1,nit
+c #AE     sss__K      =  Grav_F      * r_Stab * A_Stab *za__SV(ikl)
+c #AE.                                     *rCDmSV(ikl)*rCDmSV(ikl)
+c #AE.                           /(1.+0.608*QaT_SV(ikl)-qsnoSV(ikl))
+c #AE     us_127      =  exp(    SblPom *log(us__SV(ikl)))
+c #AE     us_227      =  us_127         *    us__SV(ikl)
+c #AE     us_327      =  us_227         *    us__SV(ikl)
+c #AE     us_427      =  us_327         *    us__SV(ikl)
+c #AE     us_527      =  us_427         *    us__SV(ikl)
+
+c #AE     us__SV(ikl) =  us__SV(ikl)
+c #AE.    - (  us_527     *sss__F     /sss__N
+c #AE.      -  us_427
+c #AE.      -  us_227     *qsnoSV(ikl)*sss__K
+c #AE.      + (us__SV(ikl)*us__SV(ikl)-usthSV(ikl)*usthSV(ikl))/sss__G)
+c #AE.     /(  us_427*5.27*sss__F     /sss__N
+c #AE.      -  us_327*4.27
+c #AE.      -  us_127*2.27*qsnoSV(ikl)*sss__K
+c #AE.      +  us__SV(ikl)*2.0                                 /sss__G)
+
+c #AE     us__SV(ikl)= min(us__SV(ikl),usuth0)
+c #AE     us__SV(ikl)= max(us__SV(ikl),eps6  )
+c #AE     rCDmSV(ikl)=     us__SV(ikl)/VVa_OK
+! #aE     sss__F     =     vonKrm     /rCDmSV(ikl)
+c #AE     ENDDO
+! ______________               ___  
+! Newton-Raphson (! Iteration, END  )
+! ~~~~~~~~~~~~~~               ~~~  
+
+c #AE     us_127      =  exp(    SblPom *log(us__SV(ikl)))
+c #AE     us_227      =  us_127         *    us__SV(ikl)
+
+! Momentum            Turbulent Scale  u*: 0-Limit in case of no Blow. Snow
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AE     dusuth      =  us__SV(ikl) - usthSV(ikl)       ! u* - uth*
+c #AE     signus      =  max(sign(un_1,dusuth),zer0)     ! 1 <=> u* - uth* > 0
+          us__SV(ikl) =                                  !
+c #AE.                   us__SV(ikl)  *signus  +         ! u* (_BS)
+     .                   usuth0                          ! u* (nBS)
+c #AE.                            *(1.-signus)           !
+
+
+! Blowing Snow        Turbulent Scale ss*
+! ---------------------------------------
+
+c #AE     hSalSV(ikl) = 8.436e-2  *exp(SblPom  *log(us__SV(ikl)))
+c #AE     qSalSV(ikl) = (us__SV(ikl) * us__SV(ikl)
+c #AE.                  -usthSV(ikl) * usthSV(ikl))*signus
+c #AE.                / (sss__G      * us_227     )
+
+c #ae     qSalSV(ikl) = (us__SV(ikl) * us__SV(ikl)
+c #ae.                  -usthSV(ikl) * usthSV(ikl))
+c #ae.                  *signus      * us__SV(ikl) *3.25
+c #ae.                 /(hSalSV(ikl) * Grav_F           )
+
+c #AE     ssstar      =  rCDmSV(ikl) *(qsnoSV(ikl) -qSalSV(ikl))
+c #AE.                 * r_Stab
+
+c #AE     uss_SV(ikl) =  min(zer0    , us__SV(ikl) *ssstar)
+c #BS     uss_SV(ikl) =  max(-0.002  , uss_SV(ikl)        )
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! #ss     IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV      .AND.
+! #ss.        nn__SV(ikl).EQ.nwr_SV                          )      THEN
+! #ss     write(6,6000)  daHost     ,     icount     ,
+! #ss.                   us__SV(ikl),1.e3*hSalSV(ikl),
+! #ss.              1.e3*Z0m_SV(ikl),
+! #ss.              1.e3*qsnoSV(ikl),1.e3*qSalSV(ikl)
+! #ss.                  ,usthSV(ikl),     us__SV(ikl)-usthSV(ikl),
+! #ss.              1.e3*ssstar     ,1.e3*us__SV(ikl)*ssstar
+ 6000     format(a18,i3,6x,'u*   [m/s] =',f6.3,'   hSalt[mm]='  ,e9.3,
+     .                  '   Z0m   [mm] =',f9.3,'   q   [g/kg] =',f9.3,
+     .               /,91x,                    '   qSa [g/kg] =',f9.3,
+     .               /,27x, 'ut*[m/s]='  ,e9.3,'   u*-ut*   ='  ,e9.3,
+     .                  '   s*  [g/kg] =',f9.3,'   us* [mm/s] =',f9.3)
+! #ss     END IF
+
+
+! Virtual Temperature Turbulent Scale thetav*    (ss* impact included)
+! --------------------------------------------------------------------
+
+c #AE     thstarv     = thstar      + Theta0      *(0.608*qqstar
+c #AE.                                                   -ssstar
+c #AE.                                             )
+c #AE.                             /(1.+0.608*QaT_SV(ikl)-qsnoSV(ikl))
+c #AE     thstars     =     sign(un_1,thstarv)
+c #AE     thstara     =      abs(     thstarv)
+c #AE     thstarv     =      max(eps6,thstara)    *thstars
+
+
+! Full   Obukhov Length Scale (Gall?e et al., 2001, BLM 99, (A1) p.16)
+! --------------------------------------------------------------------
+
+c #AE     LMO_SV(ikl) = Theta0      * us__SV(ikl)* us__SV(ikl) 
+c #AE.                /(vonKrm      * Grav_F     * thstarv)
+
+c #AE     zetah       = za__SV(ikl) / LMO_SV(ikl)
+c #AE     zetam       =           min(zetMAX,zetah)! Strong Stability Limit
+                                                   !(Mahalov et al. 2004
+                                                   ! GRL 31 2004GL021055)
+c #AE     LMOmom(ikl) = za__SV(ikl) /(max(eps6,abs(zetam))
+c #AE.                              *sign(un_1,    zetam ))
+c #AE     zeta0m      = Z0m_SV(ikl) / LMOmom(ikl)
+c #AE     zeta0h      = Z0h_SV(ikl) / LMO_SV(ikl)
+
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! #ss     IF (ii__SV(ikl).EQ.iwr_SV.AND.jj__SV(ikl).EQ.jwr_SV      .AND.
+! #ss.        nn__SV(ikl).EQ.nwr_SV                          )      THEN
+! #ss     write(6,6001)  LMO_SV(ikl)    ,    zetah
+ 6001     format(18x,9x,'LMO  [m]=',f9.1,'   zetah[-] =',f9.3)
+! #ss     END IF
+
+
+! Turbulent Scales
+! ----------------
+
+! Momentum Stability Function (Gall?e et al., 2001, BLM 99, (11) p. 7)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          stab_s      =  max(zer0,sign(un_1,zetam))
+
+          psim_s      =  -A_Stab *zetam
+          xpsimi      = sqrt(sqrt(un_1-coef_m*min(zer0,zetam)))
+          psim_i      =   2. *log(half*(un_1+xpsimi)) 
+     .                       +log(half*(un_1+xpsimi*xpsimi))
+     .                   -2.*atan(xpsimi)   +half*piNmbr
+          psim_z      =    stab_s*psim_s+(1.-stab_s)*psim_i
+
+          psim_s      =  -A_Stab *zeta0m
+          xpsimi      = sqrt(sqrt(un_1-coef_m*min(zer0,zeta0m)))
+          psim_i      =   2. *log(half*(un_1+xpsimi)) 
+     .                       +log(half*(un_1+xpsimi*xpsimi))
+     .                   -2.*atan(xpsimi)   +half*piNmbr
+          psim_0      =    stab_s*psim_s+(1.-stab_s)*psim_i
+
+! Heat     Stability Function (Gall?e et al., 2001, BLM 99, (11) p. 7)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          stab_s      =  max(zer0,sign(un_1,zetah))
+
+          psih_s      =  -AhStab *zetah
+          xpsihi      = sqrt(sqrt(un_1-coef_h*min(zer0,zetah)))
+          psih_i      =   2. *log(half*(un_1+xpsihi)) 
+          psih_z      =    stab_s*psih_s+(1.-stab_s)*psih_i
+
+          psih_s      =  -AhStab *zeta0h
+          xpsihi      = sqrt(sqrt(un_1-coef_h*min(zer0,zeta0h)))
+          psih_i      =   2. *log(half*(un_1+xpsihi)) 
+          psih_0      =    stab_s*psih_s+(1.-stab_s)*psih_i
+
+! Square Roots of the Drag Coefficients
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          rCDhSV(ikl) = vonKrm*(ExnrSV(ikl)/p0_kap)
+     .                        /(sqrCh0(ikl)-psih_z+psih_0)
+          rCDmSV(ikl) = vonKrm/(sqrCm0(ikl)-psim_z+psim_0)
+
+! Drag Coefficients
+! ~~~~~~~~~~~~~~~~~
+          CDh(ikl)    = rCDmSV(ikl) * rCDhSV(ikl)
+          CDm(ikl)    = rCDmSV(ikl) * rCDmSV(ikl)
+
+! Real    Temperature Turbulent Scale theta*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          thstar      = rCDhSV(ikl) * dTa_Ts(ikl)
+     .                              *(p0_kap     /ExnrSV(ikl))
+          uts_SV(ikl) = us__SV(ikl) * thstar
+
+
+! Convergence Criterion
+! =====================
+
+          dustar      = max(dustar,abs(us__SV(ikl)-u0star))
+
+! u*, u*T*, u*s* Time Moving Averages
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #AM     DO nt=   1,ntaver-1
+c #AM     u__mem(ikl,nt    ) = u__mem(ikl,nt+1)
+c #AT     uT_mem(ikl,nt    ) = uT_mem(ikl,nt+1)
+c #AS     us_mem(ikl,nt    ) = us_mem(ikl,nt+1)
+c #AM     ENDDO
+c #AM     u__mem(ikl,ntaver) = us__SV(ikl)
+c #AT     uT_mem(ikl,ntaver) = uts_SV(ikl)
+c #AS     us_mem(ikl,ntaver) = uss_SV(ikl)
+
+! OUTPUT of Snow Erosion Turbulence
+! #b1    IF (icount     .EQ.1  )                                    THEN
+! #b1     write(6,6004)
+ 6004     format(122('-'))
+! #b1    IF (mod(VVaSBL(ikl),4.).LT.0.1)                            THEN
+! #b1     write(6,6003)
+ 6003     format('   V  Ta-Ts  Z0      It'
+     .   ,' du*     u*    sss__F   CD       Qss       Qs*     '
+     .   ,' PseudOL Full-OL zetam   zetah   psim_z  psih_z')
+! #b1     write(6,6004)
+! #b1    END IF
+! #b1    END IF
+! #b1     write(6,6002) VVaSBL(ikl),dTa_Ts(ikl),Z0m_SV(ikl),icount
+! #b1.                 ,dustar     ,us__SV(ikl),sss__F
+! #b1.                 ,   CDm(ikl),qSalSV(ikl),ssstar
+! #b1.                 ,W_pLMO     ,LMO_SV(ikl)
+! #b1.                 ,zetam      ,zetah      ,W_psim     ,psih_z
+ 6002     format(2f6.1,f8.4,i3,f9.6,f6.3,f9.3,3f9.6,2f8.2,2f8.4,2f8.2)
+
+! OUTPUT of Snow Erosion Turbulence (2): u*_AE
+! #b2    IF (icount     .EQ.1  )                                    THEN
+! #b2     write(6,6014)
+ 6014     format(100('-'))
+! #b2    IF (mod(VVaSBL(ikl),4.).LT.0.1)                            THEN
+! #b2     write(6,6013)
+ 6013     format('   V  Ta-Ts  Z0      It'
+     .   ,' du*     u*    sss__F   W_NUs1   W_NUs2   W_NUs3      '
+     .   ,' W_DUs1     W_DUs2 ')
+! #b2     write(6,6014)
+! #b2    END IF
+! #b2    END IF
+! #b2     write(6,6012) VVaSBL(ikl),dTa_Ts(ikl),Z0m_SV(ikl),icount
+! #b2.                 ,dustar     ,us__SV(ikl),sss__F
+! #b2.                 ,W_NUs1     ,W_NUs2     ,W_NUs3     
+! #b2.                 ,W_DUs1     ,W_DUs2     
+ 6012     format(2f6.1,f8.4,i3,f9.6,f6.3,f9.3,3f9.3,2f12.3)
+
+        END DO
+c #IX IF (                     icount.lt. 3)                     GO TO 1
+! hjp if parallel mode, use   IF (                     icount.lt. 3)
+!     IF (dustar.gt.0.0001.AND.icount.lt. 6)                     GO TO 1
+
+
+c #AM   DO ikl=1,knonv
+c #AM     u0star      =      0.0
+c #AT     uTstar      =      0.0
+c #AS     usstar      =      0.0
+c #AM     DO nt=1,ntaver
+c #AM     u0star      = u0star + u__mem(ikl,nt)
+c #AT     uTstar      = uTstar + uT_mem(ikl,nt)
+c #AS     usstar      = usstar + us_mem(ikl,nt)
+c #AM     ENDDO
+c #AM     us__SV(ikl) = u0star / ntaver
+c #AT     uts_SV(ikl) = uTstar / ntaver
+c #AS     uss_SV(ikl) = usstar / ntaver
+c #AM   END DO
+
+
+! Aerodynamic Resistances
+! -----------------------
+
+        DO ikl=1,knonv
+          ram_sv(ikl) = 1./(CDm(ikl)*max(VVaSBL(ikl),eps6))
+          rah_sv(ikl) = 1./(CDh(ikl)*max(VVaSBL(ikl),eps6))
+        END DO
+
+
+      return
+      end
+
+
+
+
+      subroutine SISVAT_SBL
+ 
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_SBL                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_SBL generates Surface Boundary Layers Properties   |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: Total Number of columns                          |
+!     ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+!                       X       Number of Mosaic Cell per grid box         |
+!                                                                          |
+!     INPUT:   za__SV   : Surface Boundary Layer (SBL) Height          [m] |
+!     ^^^^^    VV__SV   :(SBL Top)   Wind Velocity                   [m/s] |
+!              TaT_SV   : SBL Top    Temperature                       [K] |
+!              ExnrSV   : Exner      Potential                         [-] |
+!              uqs_SV   : Specific   Humidity  Turbulent Flux        [m/s] |
+!              Z0m_SV   : Momentum   Roughness Length                  [m] |
+!              Z0h_SV   : Heat       Roughness Length                  [m] |
+!              Tsrfsv   : Surface    Temperature                       [K] |
+!              sqrCm0   : Contribution of Z0m to Neutral Drag Coefficient  |
+!              sqrCh0   : Contribution of Z0h to Neutral Drag Coefficient  |
+!                                                                          |
+!     INPUT /  LMO_SV   : Monin-Obukhov       Scale                    [m] |
+!     OUTPUT:  us__SV   : Friction  Velocity                         [m/s] |
+!     ^^^^^^   uts_SV   : Temperature         Turbulent Flux       [K.m/s] |
+!                                                                          |
+!     OUTPUT:  Fh__sv   : Stability Function                           [-] |
+!     ^^^^^^   dFh_sv   : Stability Function (Derivative)              [-] |
+!              ram_sv   : Aerodynamic Resistance for Momentum        [s/m] |
+!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!                                                                          |
+!     WARNING: SISVAT_SBL blows up for too small z0m values & large z_SBL  |
+!     ^^^^^^^                      (z0m = 1.8e-6 m for z_SBL = 20 m)       |
+!                                                                          |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # stdout               | #sb: OUTPUT/Verification: SISVAT_SBL          |
+!                          |      unit  6, SubRoutine  SISVAT_SBL **ONLY** |
+!--------------------------------------------------------------------------+
+ 
+ 
+       
+ 
+ 
+! Global Variables
+! ================
+ 
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+ 
+      USE VARxSV
+      USE VARySV
+
+      IMPLICIT NONE 
+ 
+! Internal Variables
+! ==================
+ 
+      integer   ikl    ,ist    ,ist__s ,ist__w
+      real      CD_m_0 ,CD_h_0 ,ram0   ,rah0  ,rahMIN
+      real      d_TaTs ,RiB__D ,RiBulk
+      real      bmstab ,Am1_FU ,Am2_FU ,Fm_Uns
+      real      bhstab ,Ah1_FU ,Ah2_FU ,Fh_Uns,dFh_Un
+      real      Aux_FS ,FStabl ,dFSdRi ,Stabil,Fm_loc
+      real      uustar ,thstar ,qqstar ,ssstar
+      real      thstarv,thstars,thstara
+      real      zeta   ,zeta_S ,zeta_A
+      real      zetMAX
+ 
+ 
+! Internal DATA
+! =============
+ 
+      data      zetMAX/ 4.28/   ! Strong Stability Limit
+!                               !(King et al. 1996, JGR 101(7) p.19121)
+ 
+! Aerodynamic Resistances
+! =======================
+ 
+      DO ikl=1,knonv
+ 
+! Surface Type
+! ~~~~~~~~~~~~
+        ist    =      isotSV(ikl)                    ! Soil Type
+        ist__s =  min(ist, 1)                        ! 1 => Soil
+        ist__w =  1 - ist__s                         ! 1 => Water Body
+ 
+! Neutral Parameters
+! ~~~~~~~~~~~~~~~~~~
+        CD_m_0 =  0.16/    (sqrCm0(ikl)*sqrCm0(ikl)) ! Neutral Drag Coeff.Mom.
+        CD_h_0 =  0.16/    (sqrCm0(ikl)*sqrCh0(ikl)) ! Neutral Drag Coeff.Heat
+        ram0   =  1.0 /    (CD_m_0     *VV__SV(ikl)) ! Neutral Aero Resis.Mom.
+        rah0   =  1.0 /    (CD_h_0     *VV__SV(ikl)) ! Neutral Aero Resis.Heat
+ 
+! Bulk Richardson Number
+! ~~~~~~~~~~~~~~~~~~~~~~
+        RiB__D =          VV__SV(ikl) *VV__SV(ikl)
+     .                   *TaT_SV(ikl)
+        d_TaTs =         (TaT_SV(ikl)- Tsrfsv(ikl))
+     .                   *p0_kap     / ExnrSV(ikl)
+        RiBulk =  Grav_F *za__SV(ikl)* d_TaTs
+     .          / RiB__D
+ 
+! OUTPUT/Verification: SISVAT_SBL
+! #sb       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #sb.          nn__SV(ikl).GE.nwr_SV)
+! #sb.      write(6,6600) Tsrfsv(ikl),TaT_SV(ikl),VV__SV(ikl)
+! #sb.                  , d_TaTs     ,RiBulk
+ 6600       format(/,'Tem(s,a), Wind  , d_TaTs, RiBulk = ',5e15.6)
+ 
+! Unstable Case
+! ~~~~~~~~~~~~~
+        bmstab =  ist__s * (13.7 -0.34 /sqrt(CD_m_0))! Momentum
+     .          + ist__w *   4.9                     !
+        bmstab =  10.    *  bmstab   * CD_m_0        !
+     .              *sqrt(za__SV(ikl)/ Z0m_SV(ikl))  !
+        Am1_FU =  bmstab *    sqrt(abs(RiBulk))      !
+        Am2_FU =  Am1_FU +1.0 +10.*abs(RiBulk)       !
+        Fm_Uns = (Am1_FU +1.0)/        Am2_FU        !
+ 
+! OUTPUT/Verification: SISVAT_SBL
+! #sb       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #sb.          nn__SV(ikl).GE.nwr_SV)
+! #sb.      write(6,6601) CD_m_0     ,Z0m_SV(ikl),bmstab     
+! #sb.                  , ist__s     ,ist__w
+ 6601       format(/,'CD_m_0  , Z0m_SV, bmstab, ist/sw = ',3e15.6,2i15)
+ 
+        bhstab =  ist__s * ( 6.3 -0.18 /sqrt(CD_h_0))! Heat
+     .          + ist__w *   2.6                     !
+        bhstab =  10.    *  bhstab   * CD_h_0        !
+     .              *sqrt(za__SV(ikl)/ Z0h_SV(ikl))  !
+        Ah1_FU =  bhstab *    sqrt(abs(RiBulk))      !
+        Ah2_FU =  Ah1_FU +1.0 +10.*abs(RiBulk)       !
+        Fh_Uns = (Ah1_FU +1.0)/        Ah2_FU        !
+        dFh_Un =((Ah1_FU +2.0)/(Ah2_FU*Ah2_FU)) * 5. !
+ 
+! Stable   Case
+! ~~~~~~~~~~~~~
+        Aux_FS =          1.0 + 5.*    RiBulk
+        FStabl =                Aux_FS*Aux_FS
+        dFSdRi =                Aux_FS          *10.
+ 
+! Effective Stability Functions and Derivatives
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        Stabil      =          sign(un_1,d_TaTs)
+        Fm_loc      =  FStabl * max(zer0,Stabil)
+     .               - Fm_Uns * min(zer0,Stabil)
+        Fh__sv(ikl) =  FStabl * max(zer0,Stabil)
+     .               - Fh_Uns * min(zer0,Stabil)
+        dFh_sv(ikl) =  dFSdRi * max(zer0,Stabil)
+     .               - dFh_Un * min(zer0,Stabil)
+ 
+! OUTPUT/Verification: SISVAT_SBL
+! #sb       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #sb.          nn__SV(ikl).GE.nwr_SV)
+! #sb.      write(6,6602) FStabl     ,Stabil     
+! #sb.                   ,Fm_Uns     ,Fm_loc     
+ 6602       format(/,'FStabl  , Stabil, Fm_Uns, Fm_loc = ',4e15.6)
+ 
+! Aerodynamic Resistances
+! ~~~~~~~~~~~~~~~~~~~~~~~
+        ram_sv(ikl) =  ram0   *          Fm_loc
+        rah_sv(ikl) =  rah0   *          Fh__sv(ikl)
+        rahMIN   = max(rah_sv(ikl),  abs(d_TaTs)*60./za__SV(ikl))
+                                               ! 60 for 30dgC within 1/2 hour
+        dFh_sv(ikl) =  rah0   *          dFh_sv(ikl)
+     .              *  rahMIN /          rah_sv(ikl)
+        rah_sv(ikl) =  rahMIN
+ 
+ 
+! Square Root Contributions to the Drag Coefficients
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        rCDmSV(ikl) =  sqrt(ram_sv(ikl) *VV__SV(ikl))
+        rCDmSV(ikl) =  1.     / max(eps6,rCDmSV(ikl))
+        rCDhSV(ikl) =       rah_sv(ikl) *VV__SV(ikl)
+     .                                  *rCDmSV(ikl)
+        rCDhSV(ikl) = (1.     / max(eps6,rCDhSV(ikl)))
+     .              * (     ExnrSV(ikl) /p0_kap      )
+ 
+! OUTPUT/Verification: SISVAT_SBL
+! #sb       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #sb.          nn__SV(ikl).GE.nwr_SV)
+! #sb.      write(6,6603) ram_sv(ikl),rah_sv(ikl)
+! #sb.                   ,rCDmSV(ikl),rCDhSV(ikl)
+ 6603       format(/,'AeR(m,h), rCD(m,h)               = ',4e15.6)
+ 
+ 
+! Turbulent Scales
+! ================
+ 
+! Friction Velocity                   u*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        uustar      =      VV__SV(ikl) / ram_sv(ikl)
+        us__SV(ikl) = sqrt(uustar)
+ 
+! Real    Temperature Turbulent Scale theta*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        uts_SV(ikl) =      d_TaTs      / rah_sv(ikl)
+        thstar      =      uts_SV(ikl) / us__SV(ikl)
+ 
+! Specific Humidity   Turbulent Scale qq*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        qqstar      =      uqs_SV(ikl) / us__SV(ikl)
+ 
+! Virtual Temperature Turbulent Scale thetav*
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        thstarv     = thstar      + TaT_SV(ikl) *(0.608*qqstar
+     .                                             )
+        thstars     =     sign(un_1,thstarv)
+        thstara     =      abs(     thstarv)
+        thstarv     =      max(eps6,thstara)    *thstars
+ 
+! Monin Obukhov Scale Height
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~
+        LMO_SV(ikl) = TaT_SV(ikl) * uustar
+     .              /(vonKrm      * Grav_F     * thstarv)
+        zeta        = za__SV(ikl) / LMO_SV(ikl)
+        zeta        =           min(zetMAX,zeta)  ! Strong Stability Limit
+!                                                 ! King et al.   1996
+!                                                 ! JGR 101(7) p.19121
+        zeta_S      =          sign(un_1  ,zeta)
+        zeta_A      =           abs(       zeta)
+        zeta        = zeta_S  * max(eps6  ,zeta_A)
+        LMO_SV(ikl) = za__SV(ikl) / zeta
+ 
+! OUTPUT/Verification: SISVAT_SBL
+! #sb       IF (ii__SV(ikl).EQ.iwr_SV .AND. jj__SV(ikl).EQ. jwr_SV .AND.
+! #sb.          nn__SV(ikl).GE.nwr_SV)
+! #sb.      write(6,6604) us__SV(ikl),uts_SV(ikl)
+! #sb.                   ,LMO_SV(ikl),zeta        
+ 6604       format(/,'***(m,h), LMO   , zeta           = ',4e15.6)
+ 
+      END DO
+ 
+      return
+      end
+
+
+      subroutine SISVAT_TVg
+! #e1.                     (ETVg_d)
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_TVg                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_TVg computes the Canopy Energy Balance             |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: Total Number of columns =                        |
+!     ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+!                       X       Number of Mosaic Cell per grid box         |
+!                                                                          |
+!     INPUT:   ivgtSV   = 0,...,12:   Vegetation Type                      |
+!     ^^^^^               0:          Water, Solid or Liquid               |
+!              isnoSV   = total Nb of Ice/Snow Layers                      |
+!                                                                          |
+!     INPUT:   sol_SV   : Downward Solar Radiation                  [W/m2] |
+!     ^^^^^    IRd_SV   : Surface  Downward Longwave Radiation      [W/m2] |
+!              TaT_SV   : SBL Top  Temperature                         [K] |
+!              rhT_SV   : SBL Top  Air  Density                    [kg/m3] |
+!              QaT_SV   : SBL Top  Specific  Humidity              [kg/kg] |
+!              psivSV   : Leaf     Water     Potential                 [m] |
+!              IRs_SV   : Soil     IR Flux  (previous time step)    [W/m2] |
+!              dt__SV   : Time     Step                                [s] |
+!                                                                          |
+!              SoCasv   : Absorbed Solar Radiation by Canopy (Normaliz)[-] |
+!              tau_sv   : Fraction of Radiation transmitted by Canopy  [-] |
+!              Evg_sv   : Soil+Vegetation Emissivity                   [-] |
+!              Eso_sv   : Soil+Snow       Emissivity                   [-] |
+!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!              Sigmsv   : Canopy Ventilation Factor                    [-] |
+!              LAI_sv   : Leaf Area  Index                             [-] |
+!              LAIesv   : Leaf Area  Index (effective / transpiration) [-] |
+!              glf_sv   : Green Leaf Fraction of NOT fallen Leaves     [-] |
+!              rrMxsv   : Canopy Maximum Intercepted Rain          [kg/m2] |
+!                                                                          |
+!     INPUT /  TvegSV   : Canopy   Temperature                         [K] |
+!     OUTPUT:  rrCaSV   : Canopy     Water     Content             [kg/m2] |
+!     ^^^^^^                                                               |
+!                                                                          |
+!     OUTPUT:  IRv_sv   : Vegetation IR Flux                        [W/m2] |
+!     ^^^^^^   HSv_sv   : Sensible Heat Flux                        [W/m2] |
+!              HLv_sv   : Latent   Heat Flux                        [W/m2] |
+!              Evp_sv   : Evaporation                              [kg/m2] |
+!              EvT_sv   : Evapotranspiration                       [kg/m2] |
+!              ETVg_d   : Vegetation  Energy Power Forcing          [W/m2] |
+!                                                                          |
+!     Internal Variables:                                                  |
+!     ^^^^^^^^^^^^^^^^^^                                                   |
+!                                                                          |
+!     METHOD: The Newton-Raphson Scheme is preferable                      |
+!     ^^^^^^  when computing over a long time step the heat content        |
+!             of a medium having a very small or zero heat capacity.       |
+!             This is to handle strong non linearities arising             |
+!             in conjunction with rapid temperature variations.            |
+!                                                                          |
+!     REFERENCE: DR97: Koen de Ridder thesis, UCL, 1997                    |
+!     ^^^^^^^^^                                                            |
+!                                                                          |
+!     Preprocessing  Option:                                               |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #NN: Newton-Raphson Increment not added in last Iteration            |
+!     #NC: OUTPUT Preparation for Stand Alone NetCDF File                  |
+!                                                                          |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+
+      USE VARxSV
+      USE VARySV
+
+
+      IMPLICIT NONE
+
+! OUTPUT
+! ------
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1 real      ETVg_d(klonv)                 ! VegetationPower, Forcing
+
+! OUTPUT for Stand Alone NetCDF File
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #NC real          SOsoKL(klonv)             ! Absorbed Solar Radiation
+c #NC real          IRsoKL(klonv)             ! Absorbed IR    Radiation
+c #NC real          HSsoKL(klonv)             ! Absorbed Sensible Heat Flux
+c #NC real          HLsoKL(klonv)             ! Absorbed Latent   Heat Flux
+c #NC real          HLs_KL(klonv)             ! Evaporation
+c #NC real          HLv_KL(klonv)             ! Transpiration
+c #NC common/DumpNC/SOsoKL,IRsoKL
+c #NC.             ,HSsoKL,HLsoKL
+c #NC.             ,HLs_KL,HLv_KL
+
+
+! Internal Variables
+! ==================
+
+      integer   ikl                           ! Grid Point Index
+      integer   nitmax,nit                    ! Iterations Counter
+      real      d_Tveg                        ! Canopy Temperat. Increment
+      real      dTvMAX                        ! Canopy Temperat. Increment MAX
+      real      dHvdTv                        ! Derivativ.of Canopy Energ.Budg.
+      real      Hv_Tv0                        ! Imbalance of Canopy Energ.Budg.
+      real      Hv_MAX                        ! MAX Imbal.of Canopy Energ.Budg.
+      real      Hv_MIN                        ! MIN Imbal.of Canopy Energ.Budg.
+      real      Hswich                        ! Newton-Raphson         Switch
+      real      Tveg_0(klonv)                 ! Canopy Temperature, Previous t
+      real      tau_Ca                        ! Canopy IR Radiation Absorption
+      real      IR_net                        ! InfraRed  NET(t)
+      real      dIRdTv(klonv)                 ! InfraRed  NET(t), Derivative(t)
+      real      dHSdTv(klonv)                 ! Sensible Heat FL. Derivative(t)
+      real      dHLdTv(klonv)                 ! Latent   Heat FL. Derivative(t)
+      real      EvFrac                        ! Condensat./Transpirat. Switch
+      real      SnoMsk                        ! Canopy Snow            Switch
+      real      den_qs,arg_qs,qsatvg          ! Canopy Saturat. Spec. Humidity
+      real      dqs_dT                        ! d(qsatvg)/dTv
+      real      FacEvp,FacEvT,Fac_Ev          ! Evapo(transpi)ration Factor
+      real      dEvpdT(klonv),dEvTdT(klonv)   ! Evapo(transpi)ration Derivative
+      real      F_Stom                        ! Funct.  (Leaf Water Potential)
+      real      R0Stom                        ! Minimum Stomatal Resistance
+      real      R_Stom                        !         Stomatal Resistance
+      real      LAI_OK                        ! 1. ==>  Leaves   exist
+      real      rrCaOK,snCaOK,dEvpOK          ! Positive Definiteness Correct.
+
+
+! Internal DATA
+! =============
+
+      data      nitmax /   5   /              ! Maximum  Iterations    Number
+      data      dTvMAX /   5.  /              ! Canopy Temperat. Increment MAX
+      data      Hv_MIN /   0.1 /              ! MIN Imbal. of Surf.Energy Budg.
+      data      SnoMsk /   0.0 /              ! Canopy Snow Switch    (Default)
+
+
+! Newton-Raphson Scheme
+! =====================
+
+      nit    = 0
+  101 CONTINUE
+      nit    = nit + 1
+      HV_MAX = 0.
+
+
+! Temperature of the Previous Time Step
+! -------------------------------------
+
+        DO ikl=1,knonv
+          Tveg_0(ikl) = TvegSV(ikl)
+
+
+! IR    Radiation Absorption
+! --------------------------
+
+          tau_Ca = 1.  - tau_sv(ikl)                        ! Canopy Absorption
+          IRv_sv(ikl) = -2.0   *Evg_sv(ikl)  *StefBo        !
+     .                         *TvegSV(ikl)  *TvegSV(ikl)   ! Downward IR (OUT)
+     .                         *TvegSV(ikl)  *TvegSV(ikl)   ! + Upward IR (OUT)
+          dIRdTv(ikl) =
+     .     -Evg_sv(ikl)*                                    !
+     .                8.*StefBo*TvegSV(ikl)  *TvegSV(ikl)   ! Downward IR (OUT)
+     .                         *TvegSV(ikl)                 ! + Upward IR (OUT)
+          IR_net =       tau_Ca                             !
+     .    *(Evg_sv(ikl)* IRd_SV(ikl)                        ! Downward IR (IN)
+     .     -             IRs_SV(ikl)                        !   Upward IR (IN)
+     .     +             IRv_sv(ikl))                       !          IR (OUT)
+
+
+! Sensible Heat Flux
+! ------------------
+
+          dHSdTv(ikl) = rhT_SV(ikl)* Sigmsv(ikl) *CpdAir    ! Derivative, t(n)
+     .                / rah_sv(ikl)                         ! 
+          HSv_sv(ikl) = dHSdTv(ikl)                         ! Value,      t(n)
+     .                *(TaT_SV(ikl)-TvegSV(ikl))            !
+
+
+! Latent   Heat Flux
+! ------------------
+
+! Canopy Saturation Specific Humidity
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          den_qs =         TvegSV(ikl)- 35.8
+          arg_qs = 17.27 *(TvegSV(ikl)-273.16)/den_qs
+          qsatvg = .0038 * exp(arg_qs)
+          dqs_dT = qsatvg* 4099.2    /(den_qs *den_qs)
+
+! Canopy Stomatal Resistance
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          R0Stom = min(         StodSV(ivgtSV(ikl))
+     .                /max(eps6,glf_sv(       ikl)),StxdSV)  ! Min Stomatal R.
+          F_Stom = pscdSV / max(pscdSV-psivSV(ikl) ,eps6)    ! F(Leaf Wat.Pot.)
+                                                             ! DR97, eqn. 3.22
+          R_Stom =(R0Stom / max(LAIesv(ikl), R0Stom/StxdSV)) ! Can.Stomatal R.
+     .           * F_Stom                                    ! DR97, eqn. 3.21
+
+! Evaporation / Evapotranspiration
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          SnoMsk = max(zer0, sign(un_1,snCaSV(ikl)-eps_21))  !
+          EvFrac = max(zer0, sign(un_1,QaT_SV(ikl)-qsatvg))  ! Condensation/
+          EvFrac = EvFrac                                    ! Transpiration
+     .       + (1.-EvFrac)*((1-SnoMsk)*         rrCaSV(ikl)  !        Switch
+     .                                         /rrMxsv(ikl)  !
+     .                      +  SnoMsk *min(un_1,snCaSV(ikl)  !
+     .                                         /rrMxsv(ikl)))!
+          Fac_Ev = rhT_SV(ikl) *Sigmsv(ikl)                  ! Idem,  Factor
+          FacEvp = Fac_Ev      *EvFrac     / rah_sv(ikl)     !
+          Evp_sv(ikl) = FacEvp*(qsatvg     - QaT_SV(ikl))    ! Evaporation
+          dEvpdT(ikl) = FacEvp* dqs_dT                       ! Evp Derivative
+          FacEvt = Fac_Ev * (1.-EvFrac)    /(rah_sv(ikl)     !
+     .                              +R_Stom *Sigmsv(ikl))    !
+          EvT_sv(ikl) = FacEvt*(qsatvg     - QaT_SV(ikl))    ! EvapoTranspir.
+          dEvTdT(ikl) = FacEvt* dqs_dT                       ! EvT Derivative
+          HLv_sv(ikl) =-LhvH2O*(Evp_sv(ikl)+ EvT_sv(ikl))    ! Latent   Heat
+     .                 -LhfH2O* Evp_sv(ikl)* SnoMsk          !(Subli.Contrib.)
+          dHLdTv(ikl) = LhvH2O*(dEvpdT(ikl)+ dEvTdT(ikl))    !
+     .                 +LhfH2O* dEvpdT(ikl)* SnoMsk          !
+
+
+! Imbalance  of the Canopy  Energy Budget
+! ---------------------------------------
+
+          LAI_OK = max(zer0,                                 ! NO Budget if 
+     .                 sign(un_1, LAI_sv(ikl)-eps_21))       ! no Leaves
+          Hv_Tv0 =    (  SoCasv(ikl)         *sol_SV(ikl)    ! Absorbed Solar
+     .                 + IR_net                              ! NET      IR
+     .                 + HSv_sv(ikl)                         ! Sensible Heat
+     .                 + HLv_sv(ikl)                         ! Latent   Heat
+     .                ) *LAI_OK                              !
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1     ETVg_d(ikl) =  Hv_Tv0                              ! Veg.Energ.Bal.
+
+          Hswich      =          1.00
+c #NN     Hswich      = max(zer0,                            ! Newton-Raphson
+c #NN.                      sign(un_1,    abs(Hv_Tv0     )   !         Switch
+c #NN.                                       -Hv_MIN      )) !
+
+
+! Derivative of the Canopy  Energy Budget
+! ---------------------------------------
+
+          dHvdTv    =   dIRdTv(ikl) * max(eps_21,tau_Ca)
+     .                - dHSdTv(ikl)
+     .                - dHLdTv(ikl)
+
+
+! Update Canopy and Surface/Canopy Temperatures
+! ---------------------------------------------
+
+          d_Tveg      = Hv_Tv0       / dHvdTv               !
+          d_Tveg      =      sign(un_1,d_Tveg)              ! Increment
+     .                       *min( abs(d_Tveg)     ,dTvMAX) ! Limitor
+          TvegSV(ikl) = TvegSV(ikl)  - Hswich      *d_Tveg  ! Newton-Raphson
+          Hv_MAX      = max(Hv_MAX,abs(Hv_Tv0     ))        !
+
+
+! Update Vegetation Fluxes
+! ------------------------
+
+c #NN     IRv_sv(ikl) = IRv_sv(ikl)-dIRdTv(ikl)    *d_Tveg  ! Emitted  IR
+c #NN     HSv_sv(ikl) = HSv_sv(ikl)+dHSdTv(ikl)    *d_Tveg  ! Sensible Heat
+c #NN     Evp_sv(ikl) = Evp_sv(ikl)-dEvpdT(ikl)    *d_Tveg  ! Evapotranspir.
+c #NN     EvT_sv(ikl) = EvT_sv(ikl)-dEvTdT(ikl)    *d_Tveg  ! Evapotranspir.
+c #NN     HLv_sv(ikl) = HLv_sv(ikl)+dHLdTv(ikl)    *d_Tveg  ! Latent   Heat
+
+          IRv_sv(ikl) = IRv_sv(ikl)                *LAI_OK
+          HSv_sv(ikl) = HSv_sv(ikl)                *LAI_OK
+          Evp_sv(ikl) = Evp_sv(ikl)                *LAI_OK
+          EvT_sv(ikl) = EvT_sv(ikl)                *LAI_OK
+          HLv_sv(ikl) = HLv_sv(ikl)                *LAI_OK
+        END DO
+
+c #IX IF (                     nit.lt.nitmax)    GO TO 101
+c hj150311 for parallel      IF (Hv_MAX.gt.Hv_MIN.and.nit.lt.nitmax)    GO TO 101
+      IF (                     nit.lt.nitmax)    GO TO 101                     
+        DO ikl=1,knonv
+          IRv_sv(ikl) = IRv_sv(ikl)                         ! Emitted  IR
+     .   +dIRdTv(ikl) *(TvegSV(ikl)-Tveg_0(ikl))            ! 
+          HSv_sv(ikl) = HSv_sv(ikl)                         ! Sensible Heat
+     .   -dHSdTv(ikl) *(TvegSV(ikl)-Tveg_0(ikl))            !
+          Evp_sv(ikl) = Evp_sv(ikl)                         ! Evaporation
+     .   +dEvpdT(ikl) *(TvegSV(ikl)-Tveg_0(ikl))            !
+          EvT_sv(ikl) = EvT_sv(ikl)                         ! Transpiration
+     .   +dEvTdT(ikl) *(TvegSV(ikl)-Tveg_0(ikl))            !
+          HLv_sv(ikl) = HLv_sv(ikl)                         ! Latent   Heat
+     .   -dHLdTv(ikl) *(TvegSV(ikl)-Tveg_0(ikl))            !
+
+! OUTPUT for Stand Alone NetCDF File
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #NC     HLv_KL(ikl) = HLv_sv(ikl)
+
+
+! Update Canopy Water Content
+! ---------------------------
+
+          rrCaSV(ikl) = rrCaSV(ikl)-(1.-SnoMsk)*Evp_sv(ikl)*dt__SV
+          snCaSV(ikl) = snCaSV(ikl)-    SnoMsk *Evp_sv(ikl)*dt__SV
+
+! Correction for Positive Definiteness (see WKarea/EvpVeg/EvpVeg.f)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          rrCaOK =  max(rrCaSV(ikl), 0.)
+          snCaOK =  max(snCaSV(ikl), 0.)
+          dEvpOK =     (rrCaOK-rrCaSV(ikl)
+     .                 +snCaOK-snCaSV(ikl))/dt__SV
+
+          Evp_sv(ikl) = Evp_sv(ikl)       - dEvpOK          ! Evaporation
+          HLv_sv(ikl) = HLv_sv(ikl)                         ! Latent   Heat
+     .    +(1.-SnoMsk)* LhvH2O            * dEvpOK          !
+     .    +    SnoMsk *(LhvH2O+LhfH2O)    * dEvpOK          !
+
+          rrCaSV(ikl) = rrCaOK
+          snCaSV(ikl) = snCaOK
+
+        END DO
+
+
+      return
+      end
+
+
+      subroutine SISVAT_TSo
+! #e1.                     (ETSo_0,ETSo_1,ETSo_d)
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_TSo                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_TSo computes the Soil/Snow Energy Balance          |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: 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)[-] |
+!              IRv_sv   : Vegetation  IR Radiation                  [W/m2] |
+!              tau_sv   : Fraction of Radiation transmitted by Canopy  [-] |
+!              Evg_sv   : Soil+Vegetation Emissivity                   [-] |
+!              Eso_sv   : Soil+Snow       Emissivity                   [-] |
+!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!              Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
+!              Sigmsv   : Canopy Ventilation Factor                    [-] |
+!              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] |
+!                                                                          |
+!     METHOD: NO   Skin Surface Temperature                                |
+!     ^^^^^^  Semi-Implicit Crank Nicholson Scheme                         |
+!                                                                          |
+!     REFERENCE: DR97: Koen de Ridder thesis, UCL, 1997                    |
+!     ^^^^^^^^^                                                            |
+!                                                                          |
+!     Preprocessing  Option:                                               |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #VX: TURBULENCE: u*q* limited to SBL Saturat.Specif.Humid.           |
+!     #RC: TURBULENCE: Richardson Number:    T Derivative is used          |
+!     #DL: TURBULENCE: Latent     Heat Flux: T Derivative is used          |
+!     #NC: OUTPUT Preparation for Stand Alone NetCDF File                  |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # SISVAT_iii_jjj_n     | #e1: OUTPUT/Verification: Energy Conservation |
+!                          |                                               |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VAR0SV
+
+      USE VARxSV
+      USE VARySV
+!hj220711
+      USE VARtSV
+
+      IMPLICIT NONE
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1 real      ETSo_0(klonv)                 ! Soil/Snow Power, before Forcing
+! #e1 real      ETSo_1(klonv)                 ! Soil/Snow Power, after  Forcing
+! #e1 real      ETSo_d(klonv)                 ! 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(klonv),mu_aux          !     Snow thermal Conductivity
+      real      mu__dz(klonv,-nsol:nsno+1)    ! mu_(eta,sno)   / dz
+      real      dtC_sv(klonv,-nsol:nsno)      ! dt      / C
+      real      IRs__D(klonv)                 ! UpwardIR Previous Iter.Contr.
+      real      dIRsdT(klonv)                 ! UpwardIR           T Derivat.
+      real      f_HSHL(klonv)                 ! Factor common to HS and HL
+      real      dRidTs(klonv)                 ! d(Rib)/d(Ts)
+      real      HS___D(klonv)                 ! Sensible Heat Flux Atm.Contr.
+      real      f___HL(klonv)                 !
+      real      HL___D(klonv)                 ! Latent   Heat Flux Atm.Contr.
+      REAL      TSurf0(klonv),dTSurf          ! Previous Surface Temperature
+      real      qsatsg(klonv),den_qs,arg_qs   ! Soil   Saturat. Spec. Humidity
+      real      dqs_dT(klonv)                 ! d(qsatsg)/dTv
+      real      Psi(   klonv)                 ! 1st Soil Layer Water Potential
+      real      RHuSol(klonv)                 ! 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(klonv,-nsol:nsno)      ! A Diagonal
+      real      Diag_B(klonv,-nsol:nsno)      ! B Diagonal
+      real      Diag_C(klonv,-nsol:nsno)      ! C Diagonal
+      real      Term_D(klonv,-nsol:nsno)      !   Independant Term
+      real      Aux__P(klonv,-nsol:nsno)      ! P Auxiliary Variable
+      real      Aux__Q(klonv,-nsol:nsno)      ! Q Auxiliary Variable
+      real      Ts_Min,Ts_Max                 ! Temperature Limits
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1 real      Exist0                        ! Existing Layer Switch
+
+      integer   nt_srf,it_srf,itEuBk          ! HL: Surface Scheme
+      parameter(nt_srf=10)                    !
+      real      agpsrf,xgpsrf,dt_srf,dt_ver   !
+      real      etaBAK(klonv)                 !
+      real      etaNEW(klonv)                 !
+      real      etEuBk(klonv)                 !
+      real      fac_dt(klonv),faceta(klonv)   !
+      real      PsiArg(klonv),SHuSol(klonv)   !
+
+! OUTPUT for Stand Alone NetCDF File
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #NC real          SOsoKL(klonv)             ! Absorbed Solar Radiation
+c #NC real          IRsoKL(klonv)             ! Absorbed IR    Radiation
+c #NC real          HSsoKL(klonv)             ! Absorbed Sensible Heat Flux
+c #NC real          HLsoKL(klonv)             ! Absorbed Latent   Heat Flux
+c #NC real          HLs_KL(klonv)             ! Evaporation
+c #NC real          HLv_KL(klonv)             ! Transpiration
+c #NC common/DumpNC/SOsoKL,IRsoKL
+c #NC.             ,HSsoKL,HLsoKL
+c #NC.             ,HLs_KL,HLv_KL
+
+
+! 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
+
+
+! 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_SV(isl)                   ! 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,eps6)
+          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_SV(isl)                   ! 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) /rhoWat) ** 1.88 !
+          mu_sno(ikl) =          max(eps6,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(eps6,              ! dt / (dz X rho C)
+     .    dzsnSV(ikl,isl) * ro__SV(ikl,isl) *Cn_dSV)      !
+        END DO
+
+
+! Snow
+! ----
+
+      DO   isl=1,nsno
+        DO ikl=1,knonv
+          ro__SV(ikl,isl) =                               !
+     .                   ro__SV(ikl ,isl)                 !
+     .       * max(0,min(isnoSV(ikl)-isl+1,1))            !
+        END DO
+      END DO
+
+      DO   isl=1,nsno
+        DO ikl=1,knonv
+
+! Combined Heat Conductivity
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          mu_aux      =  CdidSV                           !
+     .                 *(ro__SV(ikl,isl) /rhoWat) ** 1.88 !
+          mu__dz(ikl,isl) =                               !
+     .      2.                        *mu_aux*mu_sno(ikl) ! Combined Heat
+     .     /max(eps6,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
+
+
+! OUTPUT/Verification: Energy/Water Budget: 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(zer0,min(un_1,Exist0))
+! #e1     ETSo_0(ikl) = ETSo_0(ikl)
+! #e1.                +(TsisSV(ikl,isl)-Tf_Sno)*Exist0
+! #e1.                                 /dtC_sv(ikl,isl)
+! #e1   END DO
+! #e1 END DO
+
+
+! Tridiagonal Elimination: Set Up
+! ===============================
+
+! Soil/Snow Interior
+! ^^^^^^^^^^^^^^^^^^
+      DO   isl= -nsol+1,nsno-1
+        DO ikl=1,knonv
+          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!)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+           isl=  nsno
+        DO ikl=1,knonv
+          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
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #RC     dRidTs(ikl) =-Grav_F      *    za__SV(ikl)
+c #RC.                              *(1.-Sigmsv(ikl))
+c #RC.                /(TaT_SV(ikl) *    VV__SV(ikl)
+c #RC.                              *    VV__SV(ikl))
+
+! Surface: Turbulent Heat Flux: Factors
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          f_HSHL(ikl) = rhT_SV(ikl) *(1.-Sigmsv(ikl))          !#common factor
+     .                              /    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) *    CpdAir                !#- 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)           !
+
+! 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)             !
+          dqs_dT(ikl) = qsatsg(ikl)* 4099.2   /(den_qs *den_qs)!
+          fac_dt(ikl) = f_HSHL(ikl)/(rhoWat   * 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)              !
+              etaBAK(ikl)  = max(eps6,eta_SV(ikl ,isl))        !
+              etaNEW(ikl)  =          etaBAK(ikl)              !
+              etEuBk(ikl)  =          etaNEW(ikl)              !
+            END DO                                             !
+        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
+!    .        *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),eps6))                       !
+     .              **bCHdSV(ist)                              !
+              PsiArg(ikl) = 7.2E-5*Psi(ikl)                    !
+              RHuSol(ikl) =   exp(-min(ea_Max,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) -Rootsv(ikl,0)         !
+     .                                 /(rhoWat*dz_dSV(0))     !
+            END DO                                             !
+          END DO                                               !
+            DO ikl=1,knonv                                     !
+              etaNEW(ikl) =  max(etEuBk(ikl),eps6)             !
+            END DO                                             !
+              dt_srf      =      dt_srf         * xgpsrf       !
+        END DO                                                 !
+ 
+! 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)            !
+          HL___D(ikl)=( ist__s *rhoWat *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)                            !
+ 
+! Surface: Latent    Heat Flux: T Derivative
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          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                                                 !
+
+! 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  ))!
+     .        +      tau_sv(ikl)      *IRd_SV(ikl)*Eso_sv(ikl) ! Down Atm IR
+     .         -(1.0-tau_sv(ikl)) *0.5*IRv_sv(ikl)             ! Down Veg 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   isl=-nsol+1,nsno
+        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
+          TsisSV(ikl,-nsol) = Term_D(ikl,-nsol)/Aux__P(ikl,-nsol)
+        END DO
+
+      DO   isl=-nsol+1,nsno
+        DO ikl=      1,knonv
+          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   isl=nsno-1,-nsol,-1
+        DO ikl=     1,knonv
+          TsisSV(ikl,isl)   = Aux__Q(ikl,isl)  *TsisSV(ikl,isl+1)
+     .                                         +TsisSV(ikl,isl)
+        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
+          IF (abs(dTSurf) > 5.e-2*dt__SV) THEN
+            write(*,*) 'abrupt',ikl,'dTs ',dTSurf,TsisSV(ikl,isl) 
+          ENDIF
+        END DO
+      
+      DO ikl=     1,knonv
+        DO   isl=isnoSV(ikl),1      ,-1
+
+          IF (Ts_Min >  TsisSV(ikl,isl)) THEN
+             write(*,*) 'cold', ikl, 'couche',isl, TsisSV(ikl,isl)
+          ENDIF 
+          IF (Ts_Max <  TsisSV(ikl,isl)) THEN
+             write(*,*) 'hot ', ikl, 'couche',isl, TsisSV(ikl,isl) 
+          ENDIF
+          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
+!hj220711
+          TsfnSV(ikl) = TsisSV(ikl,isl)
+
+! OUTPUT for Stand Alone NetCDF File
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #NC     SOsoKL(ikl) = sol_SV(ikl) * SoSosv(ikl)            ! Absorbed Sol.
+c #NC     IRsoKL(ikl) =               IRs_SV(ikl)            ! Up Surf. IR
+c #NC.        +     tau_sv(ikl)      *IRd_SV(ikl)*Eso_sv(ikl)! Down Atm IR
+c #NC.        -(1.0-tau_sv(ikl)) *0.5*IRv_sv(ikl)            ! Down Veg IR
+c #NC     HSsoKL(ikl) = HSs_sv(ikl)                          ! HS
+c #NC     HLsoKL(ikl) = HLs_sv(ikl)                          ! HL
+c #NC     HLs_KL(ikl) = HLs_sv(ikl) / LhvH2O                 ! mm w.e./sec
+        END DO
+
+
+! OUTPUT/Verification: Energy/Water Budget: Energy Budget (OUT)
+! #e1   DO ikl=1,knonv
+! #e1     ETSo_d(ikl) =
+! #e1.         (     SoSosv(ikl)      *sol_SV(ikl)             ! Net   Solar
+! #e1.         +                       IRs_SV(ikl)             ! Up Surf. IR
+! #e1.         +     tau_sv(ikl)      *IRd_SV(ikl)*Eso_sv(ikl) ! Down Atm IR
+! #e1.         -(1.0-tau_sv(ikl)) *0.5*IRv_sv(ikl)             ! Down Veg IR
+! #e1.                                +HSs_sv(ikl)             ! Sensible
+! #e1.                                +HLs_sv(ikl)            )! Latent
+! #e1     ETSo_1(ikl) = 0.
+! #e1   END DO
+! #e1 DO   isl= -nsol,nsno
+! #e1   DO ikl=1,knonv
+! #e1     Exist0      = isl -           isnoSV(ikl)
+! #e1     Exist0      = 1.  - max(zer0,min(un_1,Exist0))
+! #e1     ETSo_1(ikl) = ETSo_1(ikl)
+! #e1.                +(TsisSV(ikl,isl)-Tf_Sno)*Exist0
+! #e1.                                 /dtC_sv(ikl,isl)
+! #e1   END DO
+! #e1 END DO
+
+
+      return
+      end
+      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 |   ?        IRv_sv   : Vegetation  IR Radiation                  [W/m2] |    
+C |   ?        tau_sv   : Fraction of Radiation transmitted by Canopy  [-] |        
+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 YOMCST
+      USE indice_sol_mod
+
+
+      IMPLICIT NONE                                                                    
+                                                                                
+                                                                                
+C +--Global Variables                                                           
+C +  ================                                                          
+
+      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_ice
+        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)* stefan   * 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)* stefan   * 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***************
+!      write(*,*)'RCPD',RCPD,'RLVTT',RLVTT,'RD',RD,'RVTMP2',RVTMP2
+      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,3
+!        write(*,*)'isnoSV',isnoSV(ig),'TsisSV',TsisSV(ig,isnoSV(ig))
+!      ENDDO
+
+      !write(*,*)'retv',retv,'thermcep',thermcep,'r2es',r2es
+      !IF (r2es.LT.1.e-8) THEN
+      !  r2es=1.e-8
+      !ENDIF
+      !IF (retv.LT.1.e-8) THEN
+      !  retv=1.e-8
+      !ENDIF
+
+      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*RLVTT*(1.-zdelta) + R5IES*RLSTT*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)        &
+     &          /RLVTT / 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)/RLVTT                &
+     &             / zx_pkh(ig)
+          ELSE
+             zx_qs = qsatl(Tsf_SV(ig)) / ps__SV(ig)
+             zx_dq_s_dh = dqsatl(Tsf_SV(ig),zx_qs)/RLVTT                &
+     &             / 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) = RLVTT
+        IF (Tsf_SV(ig) .LT. RTT) zx_sl(ig) = RLSTT
+        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
+!      DO ig=1,3                                                                
+!        write(*,*)'   lat  HF',HLs_sv(ig),'sens HF',HSs_sv(ig)
+!        write(*,*)'   dlHF/dT',dLdTSV(ig),'dsHF/dT',dSdTSV(ig)
+!      END DO  
+!      write(*,*)'RCPD',RCPD,'dt',dt__SV,'t_grnd',t_grnd
+      DO ig = 1,1
+!        write(*,*)ig,'Tsfn: ',TsfnSV(ig),'Tsrf',Tsrf(ig)
+!        write(*,*)'  cal',cal(ig),'radsol',rsolSV(ig)
+!        write(*,*)'  mh',zx_mh(ig),'sl', zx_sl(ig),'pkh',zx_pkh(ig)
+!        write(*,*)'  mq',zx_mq(ig),'difgrnd',dif_grnd(ig)
+!        write(*,*)'  nh',zx_nh(ig),'sl', zx_sl(ig),'nq',zx_nq(ig)
+!        write(*,*)'term1:',cal(ig)/RCPD*zx_pkh(ig)*dt__SV
+!        write(*,*)'*',(rsolSV(ig) + zx_mh(ig) + zx_sl(ig) * zx_mq(ig)) 
+!        write(*,*)'+',dif_grnd(ig) * t_grnd * dt__SV,' / '
+!        write(*,*)'(1-',dt__SV * cal(ig)/(RCPD * zx_pkh(ig)),'*'
+!        write(*,*)'*',(zx_nh(ig) + zx_sl(ig) * zx_nq(ig))
+!        write(*,*)'+',dt__SV * dif_grnd(ig),')'
+      ENDDO
+
+      end ! subroutine SISVAT_TS2  
+
+
+      subroutine SISVAT_qVg
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_qVg                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_qVg computes the Canopy Water  Balance             |
+!                                    including  Root   Extraction          |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     PARAMETERS:  klonv: Total Number of columns =                        |
+!     ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+!                       X       Number of Mosaic Cell per grid box         |
+!                                                                          |
+!     INPUT:   ivgtSV   = 0,...,12:   Vegetation Type                      |
+!     ^^^^^               0:          Water, Solid or Liquid               |
+!                                                                          |
+!     INPUT:   rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
+!     ^^^^^    QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
+!                                                                          |
+!              TvegSV   : Canopy   Temperature                         [K] |
+!              rrCaSV   : Canopy     Water     Content             [kg/m2] |
+!              rrMxsv   : Canopy Maximum Intercepted Rain          [kg/m2] |
+!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!              EvT_sv   : EvapoTranspiration                       [kg/m2] |
+!              Sigmsv   : Canopy Ventilation Factor                    [-] |
+!              glf_sv   : Green Leaf Fraction of NOT fallen Leaves     [-] |
+!              LAIesv   : Leaf Area  Index (effective / transpiration) [-] |
+!              psi_sv   : Soil       Water    Potential                [m] |
+!              Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
+!                                                                          |
+!     INPUT /  psivSV   : Leaf       Water    Potential                [m] |
+!     OUTPUT:                                                              |
+!     ^^^^^^                                                               |
+!                                                                          |
+!     OUTPUT:  Rootsv   : Root Water Pump                        [kg/m2/s] |
+!     ^^^^^^                                                               |
+!                                                                          |
+!     REMARK: Water Extraction by roots calibrated by Evapotranspiration   |
+!     ^^^^^^  (computed in the Canopy Energy Balance)                      |
+!                                                                          |
+!     REFERENCE: DR97: Koen de Ridder thesis, UCL, 1997                    |
+!     ^^^^^^^^^                                                            |
+!                                                                          |
+!     Preprocessing  Option:                                               |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #KW: Root Water Flow slowed down by Soil Hydraulic Conductivity      |
+!                                                                          |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VAR0SV
+
+      USE VARxSV
+      USE VARySV
+
+
+      IMPLICIT NONE
+
+! Internal Variables
+! ==================
+
+      integer   ikl   ,isl                    ! Grid Point, Layer Indices
+      integer   nitmax,nit                    ! Iterations Counter
+      real      PlantW(klonv)                 ! Plant  Water
+      real      dPdPsi(klonv)                 ! Plant  Water psi Derivative
+      real      psidif                        ! Soil-Canopy  Water Pot. Differ.
+      real      Root_W                        ! Root   Water     Flow
+      real      RootOK                        ! Roots take Water in Soil Layer
+      real      d_psiv                        ! Canopy Water     Increment
+      real      dpvMAX                        ! Canopy Water     Increment MAX
+      real      BWater                        ! Imbalance of Canopy Water Budg.
+      real      BW_MAX                        ! MAX Imbal.of Canopy Water Budg.
+      real      BW_MIN                        ! MIN Imbal.of Canopy Water Budg.
+      real      dBwdpv                        ! Derivativ.of Canopy Water Budg.
+      real      Bswich                        ! Newton-Raphson         Switch
+      real      psiv_0(klonv)                 ! Canopy Temperature,  Previous t
+      real      EvFrac                        ! Condensat./Transpiration Switch
+      real      den_qs,arg_qs,qsatvg          ! Canopy Saturat. Spec. Humidity
+      real      EvTran                        ! EvapoTranspiration
+      real      dEdpsi                        ! Evapotranspiration  Derivative
+      real      Fac_Ev,FacEvT                 ! Evapotranspiration  Factors
+      real      denomE                        ! Evapotranspiration  Denominator
+      real      F_Stom                        ! Funct.  (Leaf Water Potential)
+      real      dFdpsi                        ! Derivative  of F_Stom
+      real      denomF                        ! Denominator of F_Stom
+      real      F___OK                        ! (psi>psi_c) => F_Stom swich  ON
+      real      R0Stom                        ! Minimum Stomatal Resistance
+      real      R_Stom                        !         Stomatal Resistance
+      real      dRdpsi                        ! Derivat.Stomatal Resistance
+      real      numerR                        ! Numerat.Stomatal Resistance
+
+
+! Internal DATA
+! =============
+
+      data      nitmax /   5     /            ! Maximum  Iterations    Number
+      data      dpvMAX /  20.    /            ! Canopy   Water   Increment MAX
+      data      BW_MIN /   4.e-8 /            ! MIN Imbal. of Surf.Energy Budg.
+
+
+! Newton-Raphson Scheme
+! =====================
+
+      nit    = 0
+  101 CONTINUE
+      nit    = nit + 1
+      BW_MAX = 0.
+
+
+! W.Potential of the Previous Time Step
+! -------------------------------------
+
+        DO ikl=1,knonv
+          psiv_0(ikl) = psivSV(ikl)
+
+
+! Extraction of Soil Water through the Plant Roots
+! ------------------------------------------------
+
+          PlantW(ikl)     = 0.                              ! Plant Water
+          dPdPsi(ikl)     = 0.                              ! Idem, Derivat.
+        END DO
+      DO   isl=-nsol,0
+        DO ikl=1,knonv
+          psidif = psivSV(ikl)-(DH_dSV(ivgtSV(ikl))         ! Soil-Canopy Water
+     .                         +psi_sv(       ikl ,isl))    ! Potential  Diff.
+          Root_W = rhoWat     * RF__SV(ivgtSV(ikl),isl)     ! If > 0, Contrib.
+     .              /max(eps_21,PR_dSV(ivgtSV(ikl))         !     to Root Water
+c #KW.                         +Khydsv(ikl   ,isl )*1.e-4   ! (DR97, eqn.3.20)
+     .                                                   )  !
+!         Pas de prise en compte de la resistance sol/racine dans proto-svat 
+!         (DR97, eqn.3.20)
+          RootOK =      max(zer0, sign(un_1,psidif))
+          Rootsv(ikl,isl) = Root_W*max(zer0,psidif)         ! Root  Water
+          PlantW(ikl)     = PlantW(ikl) + Rootsv(ikl ,isl)  ! Plant Water
+          dPdPsi(ikl)     = dPdPsi(ikl) + RootOK*Root_W     ! idem, Derivat.
+        END DO
+      END DO
+
+
+! Latent   Heat Flux
+! ------------------
+
+! Canopy Saturation Specific Humidity
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=1,knonv
+          den_qs =         TvegSV(ikl)- 35.8
+          arg_qs = 17.27 *(TvegSV(ikl)-273.16)/den_qs
+          qsatvg = .0038 * exp(arg_qs)
+
+! Canopy Stomatal Resistance
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          R0Stom = min(         StodSV(ivgtSV(ikl))
+     .                /max(eps6,glf_sv(       ikl)),StxdSV) ! Min Stomatal R.
+          denomF =              pscdSV-psivSV(ikl)
+          F___OK =     max(zer0,sign(un_1,denomF))
+          denomF =     max(eps6,          denomF)           !
+          F_Stom =              pscdSV  / denomF            ! F(Leaf Wat.Pot.)
+          dFdpsi =             -F_Stom  / denomF            !
+                                                            ! DR97, eqn. 3.22
+          numerR = R0Stom / max(LAIesv(ikl), R0Stom/StxdSV) !
+          R_Stom = numerR *                  F_Stom         ! Can.Stomatal R.
+                                                            ! DR97, eqn. 3.21
+          dRdpsi = R_Stom *                  dFdpsi         !
+
+! Evaporation / Evapotranspiration
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          EvFrac = max(zer0, sign(un_1,QaT_SV(ikl)-qsatvg)) ! Condensation/
+          EvFrac = EvFrac                                   ! Transpiration
+     .       + (1.-EvFrac)     *rrCaSV(ikl)/ rrMxsv(ikl)    !        Switch
+          Fac_Ev = rhT_SV(ikl) *Sigmsv(ikl)                 ! idem,  Factor
+          denomE = rah_sv(ikl) +R_Stom     * Sigmsv(ikl)
+          FacEvT = Fac_Ev * (1.-EvFrac)    / denomE         !
+          EvTran = FacEvT     *(qsatvg     - QaT_SV(ikl))   ! EvapoTranspir.
+          dEdpsi =(EvTran     / denomE)    * dRdpsi         ! EvT Derivative
+
+
+! Imbalance  of the Canopy  Water  Budget
+! ---------------------------------------
+
+          BWater      =( PlantW(ikl)                        ! Available  Water
+     .                 - EvTran     )*        F___OK        ! Transpired Water
+
+          Bswich      = max(zer0,                           ! Newton-Raphson
+     .                      sign(un_1,    abs(BWater)       !         Switch
+     .                                       -BW_MIN))      !
+
+
+! Derivative of the Canopy  Water  Budget
+! ---------------------------------------
+
+          dBwdpv      = dPdpsi(ikl)
+     .                - dEdpsi
+          dBwdpv      = sign(  un_1,    dBwdpv)             !
+     .                *  max(eps_21,abs(dBwdpv))            ! 
+
+
+! Update Canopy and Surface/Canopy Temperatures
+! ---------------------------------------------
+
+          d_psiv      = BWater       / dBwdpv               !
+          d_psiv      =      sign(un_1,d_psiv)              ! Increment
+     .                       *min( abs(d_psiv)     ,dpvMAX) ! Limitor
+          psivSV(ikl) = psivSV(ikl)  - Bswich      *d_psiv  ! Newton-Raphson
+          BW_MAX      = max(BW_MAX,abs(BWater))
+        END DO
+
+
+! Update Root Water Fluxes | := Evapotranspiration 
+! ------------------------------------------------
+
+      DO   isl=-nsol,0
+        DO ikl=1,knonv
+          Rootsv(ikl,isl) = Rootsv(ikl,isl)*EvT_SV(ikl)     ! Root  Water
+     .                          /max(eps_21,PlantW(ikl))    !
+        END DO
+      END DO
+
+c hj150311 for parallel      IF (BW_MAX.gt.BW_MIN.and.nit.lt.nitmax)    GO TO 101
+      IF (                     nit.lt.nitmax)    GO TO 101                    
+      return
+      end
+
+
+      subroutine SISVAT_qSn
+     .                     (
+! #e1.                      EqSn_0,EqSn_1,EqSn_d
+! #m1.                     ,SIsubl,SImelt,SIrnof
+     .                     )
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_qSn                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_qSn updates  the Snow Water Content                |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     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                      |
+!     ^^^^^                                                                |
+!                                                                          |
+!     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.] |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: STANDARD Possibility                          |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^^^^^^^^^^^^                          |
+!     #IB: OUTPUT: Ice-Sheet Surface Mass Balance  (on NetCDF File )       |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option:           (PLEASE VERIFY before USE)          |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #SU: SLUSH : Alternative Parameterization                            |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # SISVAT_iii_jjj_n     | #E0: OUTPUT on ASCII  File (SISVAT Variables) |
+!   #                      |(#E0  MUST BE PREPROCESSED BEFORE #e1 & #e2 !) |
+!   # SISVAT_iii_jjj_n     | #e1: OUTPUT/Verification: Energy Conservation |
+!   # SISVAT_iii_jjj_n     | #m1: OUTPUT/Verification: * Mass Conservation |
+!                          |                                               |
+!   # SISVAT_qSn.vm        | #vm: OUTPUT/Verification: Energy/Water Budget |
+!                          |      unit 43, SubRoutine  SISVAT_qSn **ONLY** |
+!   # SISVAT_qSn.vu        | #vu: OUTPUT/Verification: Slush  Parameteriz. |
+!                          |      unit 44, SubRoutine  SISVAT_qSn **ONLY** |
+!                          |                                               |
+!   # stdout               | #s2: OUTPUT of SnowFall, Snow Buffer          |
+!                          |      unit  6, SubRoutine  SISVAT_BSn, _qSn    |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VAR0SV
+
+      USE VARxSV
+
+
+! OUTPUT
+! ------
+
+      USE VARySV
+
+      IMPLICIT NONE
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1 real     EqSn_d(klonv)                 ! Energy in Excess, initial
+! #e1 real     EqSn_0(klonv)                 ! Snow Energy, befor Phase Change
+! #vm real     EqSn01(klonv)                 ! Snow Energy, after Phase Change
+! #vm real     EqSn02(klonv)                 ! Snow Energy, after Phase Change
+                                             !              .AND. Last Melting 
+! #e1 real     EqSn_1(klonv)                 ! Snow Energy, after Phase Change
+                                             !              .AND. Mass Redistr.
+! OUTPUT/Verification: * Mass Conservation
+! #m1 real     SIsubl(klonv)                 ! Snow Deposed Mass
+! #m1 real     SImelt(klonv)                 ! Snow Melted  Mass
+! #m1 real     SIrnof(klonv)                 ! 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(klonv)                 ! Nb of Layers Updater
+      integer  kSlush                        ! Slush Switch
+      real     dTSnow                        ! Temperature                  [C]
+      real     EExdum(klonv)                 ! 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(klonv)                 ! 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.]
+
+! OUTPUT of SISVAT Trace Statistics (see assignation in PHY_SISVAT)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      integer             isnnew,isinew,isnUpD,isnitr
+
+! OUTPUT/Verification: Energy/Water Budget
+! #vm real     WqSn_0(klonv)                 ! Snow Water+Forcing  Initial
+! #vm real     WqSn_1(klonv)                 ! 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                 !
+
+! OUTPUT/Verification: Slush  Parameterization
+! #vu logical         su_opn                 ! IO   Switch
+! #vu common/SI_qSn_L/su_opn                 !
+
+
+! DATA
+! ====
+!hj1907      data      dzepsi/0.005/     !hj180711           ! Minim. Snow Layer Thickness (!) 
+!hjp230611  
+      data      dzepsi/0.0001/                ! Minim. Snow Layer Thickness (!)
+!hjp290611      data      dzepsi/0.0003/                ! Minim. Snow Layer Thickness (!)
+
+!hjp230611
+      data      dz_Min/1.e-4/                 ! Minim. Snow Layer Thickness
+!     data      dz_Min/0.005/                 ! Minim. Snow Layer Thickness
+c ... Warning: Too high for Col de Porte: precludes 1st snow (layer) apparition
+!hj1907      data      dz_Min/0.005/    !hj180711              ! Minim. Snow Layer Thickness 
+
+
+      data      SGDmax/0.003/                 ! Maxim. Snow Grain Diameter  [m]
+                                              ! (Rowe et al. 1995, JGR p.16268)
+
+
+! OUTPUT/Verification: Energy/Water Budget: 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) -Tf_Sno         )
+! #e1.                 -LhfH2O      *(1.              -eta_SV(ikl,isn)))
+! #e1   END DO
+! #e1 END DO
+
+
+! OUTPUT/Verification: Energy/Water Budget: 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
+
+
+! OUTPUT/Verification: * Mass Conservation
+! #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)
+c #IB   wem_SV(ikl)   = 0.
+c #IB   wer_SV(ikl)   = 0.
+      END DO
+
+
+! Melting/Freezing Energy
+! =======================
+
+!  REMARK: Snow liquid Water Temperature assumed = Tf_Sno
+!  ^^^^^^
+        DO ikl=1,knonv
+          EExdum(ikl) = drr_SV(ikl)     * hC_Wat *(TaT_SV(ikl)-Tf_Sno) 
+     .                                  * dt__SV
+          EExcsv(ikl) = EExdum(ikl)     *    min(1,isnoSV(ikl)) ! Snow exists
+          EExdum(ikl) = EExdum(ikl)     -          EExcsv(ikl)  !
+
+! OUTPUT/Verification: Energy/Water Budget
+! #e1     EqSn_d(ikl) = EExcsv(ikl)                             !
+
+        END DO
+
+
+! Surficial Water Status
+! ----------------------
+
+        DO ikl=1,knonv
+          SWS_SV(ikl) = max(zer0,sign(un_1,Tf_Sno
+     .                                    -TsisSV(ikl,isnoSV(ikl))))
+        END DO
+
+      DO   isn=nsno,1,-1
+        DO ikl=1,knonv
+
+! Energy, store Previous Content
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          dTSnow      = TsisSV(ikl,isn) -          Tf_Sno
+          EExcsv(ikl) = EExcsv(ikl) 
+     .                + ro__SV(ikl,isn) * Cn_dSV * dTSnow
+     .                                           * dzsnSV(ikl,isn)
+          TsisSV(ikl,isn) =                        Tf_Sno
+
+! 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(zer0,          EExcsv(ikl) )
+
+! Energy Consumption
+! ^^^^^^^^^^^^^^^^^^
+          SnHLat      = ro__SV(ikl,isn) * LhfH2O
+          dzMelt(ikl) = EnMelt      / max(SnHLat,    eps6 )
+          noSnow(ikl) = noSnow(ikl) 
+     .      + max(zer0  ,sign(un_1,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)
+          EExcsv(ikl) = EExcsv(ikl)     -dzMelt(ikl)*SnHLat
+c #IB     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
+
+! OUTPUT/Verification: * Mass Conservation
+! #m1     SImelt(ikl) = SImelt(ikl)
+! #m1.                + ro__SV(ikl,isn) * dzMelt(ikl)
+
+          OKmelt      =max(zer0,sign(un_1,drr_SV(ikl)-eps6))
+
+! 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(zer0,                  EExcsv(ikl))
+          WaFrez      =   -(     EnFrez          * LayrOK / LhfH2O)
+          drrNEW      = max(zer0,drr_SV(ikl)     - WaFrez / dt__SV)
+          WaFrez      =    (     drr_SV(ikl)     - drrNEW)* dt__SV
+          drr_SV(ikl) =          drrNEW
+          EExcsv(ikl) =          EExcsv(ikl)     + WaFrez * LhfH2O
+          EnFrez      = min(zer0,EExcsv(ikl))    * LayrOK
+          rdzNEW      = WaFrez + rdzsno
+          ro__SV(ikl,isn) =      rdzNEW /max(eps6, dzsnSV(ikl,isn))
+          TsisSV(ikl,isn) =      Tf_Sno
+     .                + EnFrez /(Cn_dSV *max(eps6, rdzNEW)        )
+          EExcsv(ikl) =          EExcsv(ikl)     - EnFrez
+c #IB     wer_SV(ikl) = WaFrez                             
+c #IB.                + wer_SV(ikl)
+
+
+! Snow Water Content
+! ==================
+
+! Pore   Volume [-]
+! ^^^^^^^^^^^^^^^^^
+          rosDry      =(1.     - eta_SV(ikl,isn))* ro__SV(ikl,isn) !
+          PorVol      = 1.     - rosDry          / rhoIce          !
+          PorVol      =      max(PorVol          , zer0  )         !
+
+! Water  Retention
+! ^^^^^^^^^^^^^^^^
+          rWater      = ws0dSV * PorVol * rhoWat * dzsnSV(ikl,isn)
+          drrNEW      = max(zer0,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(eps6,rdzNEW)
+          ro__SV(ikl,isn) =      rdzNEW / max(eps6,dzsnSV(ikl,isn))
+
+! Pore Hole Close OFF
+! ^^^^^^^^^^^^^^^^^^^
+          PClose = max(zer0,
+     .                 sign(un_1,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
+          rusnSV(ikl) =          rusnSV(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
+        DO isn=1,nsno-1
+           isnnew =(un_1-max(zer0  ,sign(un_1,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
+        DO isn=  nsno,1,-1
+           nh =    nh + isn* min(istoSV(ikl,isn)-1,1)*max(0,1-nh)
+        ENDDO
+           zc =     0. 
+           zt =     0. 
+        DO isn=1,nsno
+           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
+
+
+! OUTPUT/Verification: Energy/Water Budget: 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) -Tf_Sno         )
+! #vm.                 -LhfH2O      *(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)
+          RnofSV(ikl) = RnofSV(ikl)
+     .                +(rusnSV(ikl) - rusnew     ) / 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
+
+
+! Slush Formation (CAUTION: ADD RunOff Possibility before Activation)
+! ---------------  ^^^^^^^  ^^^
+
+! OUTPUT/Verification: Slush  Parameterization
+! #vu IF (.NOT.su_opn)                                              THEN
+! #vu          su_opn=.true.
+! #vu     open(unit=44,status='unknown',file='SISVAT_qSn.vu')
+! #vu     rewind    44
+! #vu END IF
+! #vu     write(44,440) daHost
+ 440      format('iSupI    i       dz       ro      eta',
+     .            '   PorVol   zSlush     ro_n    eta_n',2x,a18)
+
+c #SU DO   isn=1,nsno
+c #SU   DO ikl=1,knonv
+c #SU     kSlush = min(1,max(0,isn+1-ispiSV(ikl)))        ! Slush Switch
+
+! Available Additional Pore   Volume [-]
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #SU     PorVol = 1. - ro__SV(ikl,isn)                   ! [--]
+c #SU.           *(1. - eta_SV(ikl,isn))/ rhoIce          !
+c #SU.           -      eta_SV(ikl,isn)                   !
+c #SU.                 *ro__SV(ikl,isn) / rhoWat          !
+c #SU     PorVol =  max(PorVol          , zer0  )         !
+c #SU     zWater =      dzsnSV(ikl,isn) * PorVol * 1000.  ! [mm] OR [kg/m2]
+c #SU.           * (1. -SWS_SV(ikl)                       ! 0 <=> freezing
+c #SU.                *(1 -min(1,iabs(isn-isnoSV(ikl))))) ! 1 <=> isn=isnoSV
+c #SU     zSlush =  min(rusnSV(ikl)     , zWater)         ! [mm] OR [kg/m2]
+c #SU     rusnSV(ikl) = rusnSV(ikl)     - zSlush          ! [mm] OR [kg/m2]
+c #SU     ro_new      =(dzsnSV(ikl,isn) * ro__SV(ikl,isn) !
+c #SU.                 +zSlush                           )!
+c #SU.            / max(dzsnSV(ikl,isn) , eps6           )!
+
+! OUTPUT/Verification: Slush  Parameterization
+! #vu     rusnew          = eta_SV(ikl,isn)               !
+
+c #SU     eta_SV(ikl,isn) =(ro_new - ro__SV(ikl,isn)      !
+c #SU.                    *(1.     - eta_SV(ikl,isn)))    !
+c #SU.               / max (ro_new , eps6            )    !
+
+! OUTPUT/Verification: Slush  Parameterization
+! #vu     IF    (isn.le.isnoSV(ikl))                      !
+! #vu.    write(44,441) ispiSV(ikl),isn,dzsnSV(ikl,isn)   !
+! #vu.                 ,ro__SV(ikl,isn),rusnew            !
+! #vu.                 ,PorVol         ,zSlush            !
+! #vu.                 ,ro_new         ,eta_SV(ikl,isn)   !
+ 441      format(2i5,f9.3,f9.1,f9.6,f9.3,f9.6,f9.1,f9.6)  !
+
+c #SU     ro__SV(ikl,isn) =      ro_new                   !
+c #SU   END DO
+c #SU END DO
+
+
+! 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) , eps6))
+          NOLayr=min(zer0,sign(un_1,dzsnSV(ikl,isn) + dzVap0))
+          dzVap1=min(zer0,          dzsnSV(ikl,isn) + dzVap0)
+
+
+! Additional Energy (CAUTION: Verification is not performed)
+! -----------------
+
+! OUTPUT/Verification: Energy Consrv. (HLS)
+! #e4     AdEnrg = dzVap0 * ro__SV(ikl,isnoSV(ikl))           ! Water   Vapor
+! #e4.            *hC_Wat *(TsisSV(ikl,isnoSV(ikl)) -Tf_Sno)  ! Sensible Heat
+
+! OUTPUT/Verification: Energy Consrv. (HL)
+! #e3     B_Enrg =(Cn_dSV      *(TsisSV(ikl,isn) -Tf_Sno         )
+! #e3.            -LhfH2O      *(1.              -eta_SV(ikl,isn)))
+! #e3.           /(1.          + dzVap0 /max(eps6,dzsnSV(ikl,isn)))
+! #e3     eta_SV(ikl,isn) =
+! #e3.           max(zer0,un_1 +(B_Enrg 
+! #e3.                         -(TsisSV(ikl,isn) -Tf_Sno)*Cn_dSV)
+! #e3.                          /LhfH2O                          )
+! #e3     TsisSV(ikl,isn) =    ( B_Enrg
+! #e3.                         +(1.              -eta_SV(ikl,isn))
+! #e3.                          *LhfH2O                          )
+! #e3.                         / Cn_dSV
+! #e3.                         + Tf_Sno
+
+! OUTPUT/Verification: Energy Conservation
+! #e1     STOP "PLEASE add Energy (#e3) from deposition/sublimation"
+
+
+! Update of the upper Snow layer Thickness
+! ----------------------------------------
+
+          dzsnSV(ikl,isn) =
+     .           max(zer0,  dzsnSV(ikl,isnoSV(ikl)) + dzVap0)
+          isnoSV(ikl)     = isnoSV(ikl)             + NOLayr
+          isn             = isnoSV(ikl)
+          dzsnSV(ikl,isn) = dzsnSV(ikl,isn) + dzVap1
+c #IB     wes_SV(ikl)     = ro__SV(ikl,isn) * dzVap0
+      END DO
+
+
+! OUTPUT/Verification: Energy/Water Budget: 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) -Tf_Sno         )
+! #vm.                 -LhfH2O      *(1.              -eta_SV(ikl,isn)))
+! #vm   END DO
+! #vm END DO
+
+
+! OUTPUT/Verification: * Mass Conservation
+! #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(zer0,sign(un_1,dzMelt(ikl)-eps6         ))
+        ThinOK = max(zer0,sign(un_1,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))*LhfH2O
+
+! Water  Production
+! ^^^^^^^^^^^^^^^^^
+        drr_SV(ikl)   = drr_SV(ikl)     
+     .                + ro__SV(ikl,1) * z_Melt /dt__SV
+      END DO
+
+
+! Update Nb of Layers
+! ===================
+
+! OUTPUT in SISVAT for ikl = 1 (preferably for Stand Alone Version)
+! OUTPUT           for SnowFall and Snow Buffer
+! #s2   IF          (isnoSV(1) .GT. 0)
+! #s2.  write(6,6005)noSnow(1)
+ 6005   format(i3,' (noSnow) ')
+
+      DO ikl=1,knonv
+        isnoSV(ikl)   = isnoSV(ikl) 
+     .     * min(1,iabs(isnoSV(ikl)-noSnow(ikl)))
+      END DO
+
+
+! OUTPUT/Verification: Energy Conservation: 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) -Tf_Sno         )
+! #e1.                 -LhfH2O      *(1.              -eta_SV(ikl,isn)))
+! #e1   END DO
+! #e1 END DO
+
+
+! OUTPUT/Verification: Energy/Water Budget: 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
+
+
+! OUTPUT/Verification: Energy/Water Budget
+! #vm IF (.NOT.emopen)                                              THEN
+! #vm          emopen = .true.
+! #vm          open(unit=43,status='unknown',file='SISVAT_qSn.vm')
+! #vm          rewind 43
+! #vm   write(43,43)
+ 43     format('SubRoutine SISVAT_qSn: Local Energy and Water Budgets',
+     .       /,'=====================================================')
+! #vm END IF
+! #vm DO ikl=1,knonv
+! #vm IF (EqSn01(ikl).gt.1.e-3) write(43,431) dahost,EqSn01(ikl)
+ 431  format(' WARNING (1) in _qSn,',         a18,
+     .       ': Energy Unbalance in Phase Change = ',e15.6)
+! #vm END DO
+! #vm DO ikl=1,knonv
+! #vm IF (EqSn02(ikl).gt.1.e-3) write(43,432) dahost,EqSn01(ikl)
+ 432  format(' WARNING (2) in _qSn,',         a18,
+     .       ': Energy Unbalance in Phase Change = ',e15.6)
+! #vm END DO
+! #vm         timeer=timeer + dt__SV
+! #vm         hourer=3600.0
+! #vm IF (mod(no_err,11).eq.0)                                      THEN
+! #vm         no_err=       1
+! #vm   write(43,435)timeer/hourer
+ 435    format(11('-'),'----------+-',3('-'),'----------+-',
+     .          3('-'),'----------+-',3('-'),'----------+-',
+     .                 '----------------+----------------+',
+     .       /,f8.2,3x,'EqSn_0(1) | ',3x,'EqSn_d(1) | ',
+     .              3x,'EqSn_1(1) | ',3x,'EExcsv(1) | ',
+     .                 'E_0+E_d-E_1-EE  |   Water Budget |',
+     .       /,11('-'),'----------+-',3('-'),'----------+-',
+     .          3('-'),'----------+-',3('-'),'----------+-',
+     .                 '----------------+----------------+')
+! #vm END IF
+! #vm IF (abs(EqSn_0(1)+EqSn_d(1)-EqSn_1(1)-EExcsv(1)).gt.eps6.OR.
+! #vm.    abs(WqSn_1(1)-WqSn_0(1))                    .gt.eps6    ) THEN
+! #vm         no_err=no_err+1
+! #vm   write(43,436)   EqSn_0(1),EqSn_d(1)
+! #vm.                 ,EqSn_1(1),EExcsv(1)
+! #vm.                 ,EqSn_0(1)+EqSn_d(1)-EqSn_1(1)-EExcsv(1)
+! #vm.                 ,WqSn_1(1)-WqSn_0(1)
+ 436    format(8x,f12.0,' + ',f12.0,' - ',f12.0,' - ',f12.3,' = ',f12.3,
+     .      '    | ',f15.9)
+! #vm END IF
+
+! OUTPUT/Verification: Energy Conservation
+! #e1   DO ikl=1,knonv
+! #e1     EqSn_d(ikl) = EqSn_d(ikl) - EExcsv(ikl)
+! #e1   END DO
+
+      return
+      end
+
+
+      subroutine SISVAT_GSn
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_GSn                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_GSn simulates SNOW Metamorphism                    |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     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                      |
+!     ^^^^^^   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__SV   : 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  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VAR0SV
+
+
+! INPUT/OUTPUT
+! ------------
+
+      USE VARxSV
+
+      IMPLICIT NONE
+
+! OUTPUT
+! ------
+
+      integer   k
+
+
+! Local  Variables
+! ================
+
+      logical   vector                        !
+      integer   ikl                           !
+      integer   isn   ,isnp                   !
+      integer   istoOK                        !
+      real      G1_bak,G2_bak                 ! Old Values of G1, G2
+      real      ro_dry(klonv,      nsno)      ! Dry Density            [g/cm3]
+      real      etaSno(klonv,      nsno)      ! Liquid Water Content   [g/cm2]
+      real      SnMass(klonv)                 ! 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   !
+
+      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)
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #vp real      G_curr(18),Gcases(18)
+! #vp common   /GSnLOC/    Gcases
+
+! OUTPUT/Verification: Snow   Properties
+! #wp real                 D__MAX
+! #wp common   /GSnMAX/    D__MAX
+
+
+! DATA
+! ====
+
+      data       vector/.true./               ! Vectorization  Switch
+      data       vdent1/ 2.e8/                ! Wet Snow Metamorphism
+      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/               !
+
+! OUTPUT/Verification: Snow   Properties
+! #wp data       D__MAX / 4.00/               !
+
+
+!  1. Metamorphoses dans les Strates
+!     Metamorphism
+!     ==============================
+
+      frac_j = dt__SV / 86400.                        ! Time Step [Day]
+
+
+!  1.1 Initialisation: teneur en eau liquide et gradient de temperature 
+!  ------------------  liquid water content and temperature gradient
+
+      DO   isn=1,nsno
+        DO ikl=1,knonv
+          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
+
+      DO   isn=1,nsno
+        DO ikl=1,knonv
+
+          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))),eps6))
+!         Factor 1.d-2 for Conversion K/m --> K/cm
+
+
+!  1.2 Metamorphose humide 
+!      Wet Snow Metamorphism
+!      ---------------------
+
+          Wet_OK = max(zer0,sign(un_1,eta_SV(ikl,isn)-eps6))
+
+
+!      Vitesse de diminution de la dendricite
+!      Rate of the dendricity decrease
+!      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          sWater=1.d-1*ro__SV(ikl,isn)*eta_SV(ikl,isn)
+     .       /max(eps6,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/Tf_Sno))
+
+!  1.2.1 Cas dendritique/dendritic Case
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          OK__wd=max(zer0,                            !
+     .               sign(un_1,-G1snSV(ikl,isn)       !
+     .                         -eps6           ))     !
+
+          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(zer0,                            ! IF 1., 
+     .               sign(un_1, DENDRn                ! NO change
+     .                         -eps6           ))     ! 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(zer0,                            !
+     .               sign(un_1, 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__SV))
+     .           ** husi_3
+
+
+!  1.3 Metamorposes seches / Dry Metamorphism
+!      --------------------------------------
+
+
+!  1.3.1 Calcul Metamorphose faible/low Gradient (0.00-0.05 deg/cm)
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          OKlowT=max(zer0,                            !
+     .               sign(un_1, vgrat1                !
+     .                         -dTsndz         ))     !
+
+          facVap=exp(vvap1/TsisSV(ikl,isn))
+
+!  1.3.1.1 Cas dendritique / dendritic Case
+
+          OK_ldd=max(zer0,                            !
+     .               sign(un_1,-G1snSV(ikl,isn)       !
+     .                         -eps6           ))     !
+
+          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(zer0,                            ! IF 1., 
+     .               sign(un_1, DENDRn                ! NO change
+     .                         -eps6           ))     ! 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(zer0,  sign(un_1,vdiam2-DiamGx))
+          No_Big=    istoOK+DiamOK
+          No_Big=min(No_Big,un_1)
+
+          dSPHER=           vsphe2*facVap*frac_j      !
+          SPHER0=    SPHERn+dSPHER                    ! small grains
+          SPHbig=    SPHERn+dSPHER                    ! big   grains
+     .        *exp(min(zer0,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(zer0,                            !
+     .               sign(un_1, 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(zer0,                            !
+     .               sign(un_1,-G1snSV(ikl,isn)       !
+     .                         -eps6           ))     !
+
+          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(zer0,                            ! IF 1., 
+     .               sign(un_1, DENDRn                ! NO change
+     .                         -eps6           ))     ! Dendr. -> Spheric
+
+          G1_mdd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
+     .       +(1.-OK__DE)* max(zer0  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+          G2_mdd= OK__DE * max(zer0  ,SPHERn*G1_dSV)  ! Spheric
+     .       +(1.-OK__DE)*(ADSdSV-max(SPHERn,zer0  )) ! 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(zer0,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(zer0,                            !
+     .               sign(un_1,-G1snSV(ikl,isn)       !
+     .                         -eps6           ))     !
+
+          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(zer0,                            ! IF 1., 
+     .               sign(un_1, DENDRn                ! NO change
+     .                         -eps6  ))              ! Dendr. -> Spheric
+
+          G1_hdd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
+     .       +(1.-OK__DE)* max(zer0  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+          G2_hdd= OK__DE * max(zer0  ,SPHERn*G1_dSV)  ! Spheric
+     .       +(1.-OK__DE)*(ADSdSV-max(SPHERn,zer0  )) ! Spher. -> Size 
+
+!  1.3.3.2 Cas non dendritique non completement anguleux.
+!          non dendritic and spericity gt. 0
+
+          OK_hds=max(zer0,                            !
+     .               sign(un_1, G1snSV(ikl,isn)       !
+     .                         -eps6           ))     !
+
+          SPHERn= G1snSV(ikl,isn)/G1_dSV
+          SPHERn= SPHERn - facVap*frac_j
+          G1_hds= max(zer0,SPHERn*G1_dSV)
+
+!  1.3.3.3 Cas non dendritique et anguleux
+!          dendritic and spericity = 0.
+
+          T1__OK = max(zer0,sign(un_1,TsisSV(ikl,isn)-Tf_Sno+vtang1))
+          T2__OK = max(zer0,sign(un_1,TsisSV(ikl,isn)-Tf_Sno+vtang2))
+          T3_xOK = max(zer0,sign(un_1,TsisSV(ikl,isn)-Tf_Sno+vtang3))
+          T3__OK =                    T3_xOK  * (1. - T2__OK)
+          T3_nOK =              (1. - T3_xOK) * (1. - T2__OK)
+          ro1_OK = max(zer0,sign(un_1,vrang1-ro_dry(ikl,isn)))
+          ro2_OK = max(zer0,sign(un_1,ro_dry(ikl,isn)-vrang2))
+          dT1_OK = max(zer0,sign(un_1,vgang1-dTsndz         ))
+          dT2_OK = max(zer0,sign(un_1,vgang2-dTsndz         ))
+          dT3xOK = max(zer0,sign(un_1,vgang3-dTsndz         ))
+          dT3_OK =                    dT3xOK  * (1. - dT2_OK)
+          dT4xOK = max(zer0,sign(un_1,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*(Tf_Sno       -TsisSV(ikl,isn))        ! 12
+     .                    /vtang6)                                       !
+     .     +T3__OK*(vtang7-vtang8*(Tf_Sno-vtang2-TsisSV(ikl,isn))        ! 13
+     .                    /vtang9)                                       !
+     .     +T3_nOK*(vtanga-vtangb*(Tf_Sno-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
+
+          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
+
+! OUTPUT/Verification: Snow Layers Agregation: Properties
+! #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))
+
+! #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)
+ 471      format(
+     .         /,' isn     =  ',i4,6x,'(MAX.:',i4,')',  
+     .         /,' T       =  ',f8.3,
+     .         /,' ro      =  ',f8.3,
+     .         /,' eta     =  ',f8.3,
+     .         /,' G1      =  ',f8.3,
+     .         /,' G2      =  ',f8.3,
+     .         /,' Histor. =  ',i4  ,
+     .         /,' Grad(T) =  ',f8.3,'                   ' ,18i3  ,
+     ./,         '                       Current    Case: ',18f3.0,
+     ./,         '                       Cases performed: ',18f3.0,
+     ./,' ------------------------------------------------------------',
+     .             '-----------+------------------+------------------+',
+     ./,' Status                                                      ',
+     .             '           | G1               | G2               |',
+     ./,' ------------------------------------------------------------',
+     .             '-----------+------------------+------------------+',
+     ./,'    Wet_OK: ',f8.3,'                  OK__wd: ',f8.3,'       ',
+     .             '           | G1__wd: ',f8.3,' | G2__wd: ',f8.5,' |',
+     ./,'                                   1.-OK__wd: ',f8.3,' OK__ws',
+     .             ': ',f8.3,' | G1__ws: ',f8.3,' |                  |',
+     ./,'                                                    1.-OK__ws',
+     .             ': ',f8.3,' |                  | G2__ws: ',f8.5,' |',
+     ./,' 1.-Wet_OK: ',f8.3,' OKlowT: ',f8.3,' OK_ldd: ',f8.3,'       ',
+     .             '           | G1_ldd: ',f8.3,' | G2_ldd: ',f8.5,' |',
+     ./,'                                   1.-OK_ldd: ',f8.3,'       ',
+     .             '           | G1_lds: ',f8.3,' |                  |',
+     ./,'                     OKmidT: ',f8.3,' OK_mdd: ',f8.3,'       ',
+     .             '           | G1_mdd: ',f8.3,' | G2_mdd: ',f8.5,' |',
+     ./,'                                   1.-OK_mdd: ',f8.3,'       ',
+     .             '           | G1_mds: ',f8.3,' |                  |',
+     ./,'                     OKhigT: ',f8.3,' OK_hdd: ',f8.3,'       ',
+     .             '           | G1_hdd: ',f8.3,' | G2_hdd: ',f8.5,' |',
+     ./,'                                   1.-OK_hdd: ',f8.3,' OK_hds',
+     .             ': ',f8.3,' | G1_hds: ',f8.3,' |                  |',
+     ./,'                                                    1.-OK_hds',
+     .             ': ',f8.3,' |                  | G2_hds: ',f8.5,' |',
+     ./,' ------------------------------------------------------------',
+     .             '-----------+------------------+------------------+',
+     ./,'                                                             ',
+     .             '           |         ',f8.3,' |         ',f8.5,' |',
+     ./,' ------------------------------------------------------------',
+     .             '-----------+------------------+------------------+')
+        END DO
+      END DO
+
+
+!  2. Mise a Jour Variables Historiques (Cas non dendritique)
+!     Update of the historical Variables
+!     =======================================================
+
+      IF (vector)                                                   THEN
+        DO isn=1,nsno
+        DO ikl=1,knonv
+
+          SphrOK = max(zer0,sign(un_1,       G1snSV(ikl,isn)))
+          H1a_OK = max(zer0,sign(un_1,vsphe4-G1snSV(ikl,isn)))
+          H1b_OK =     1   - min(1   ,       istoSV(ikl,isn))
+          H1__OK =                    H1a_OK*H1b_OK
+          H23aOK = max(zer0,sign(un_1,vsphe4-G1_dSV
+     .                                      +G1snSV(ikl,isn)))
+          H23bOK = max(zer0,sign(un_1,etaSno(ikl,isn)
+     .                      /max(eps6,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(zer0,sign(un_1,Tf_Sno-TsisSV(ikl,isn)+eps6))
+          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(un_1,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.Tf_Sno)                       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
+      DO isn=nsno,1,-1
+        DO ikl=1,knonv
+          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(Tf_Sno-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(zer0,sign(un_1,etaSno(ikl,isn)-eps6))
+          OK_Ang     =    max(zer0,sign(un_1,vgran6-G1snSV(ikl,isn)))
+     .                *(1-min(1   , abs(istoSV(ikl,isn)-istdSV(1))))
+
+! OUTPUT/Verification: Snow   Properties
+! #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(zer0,sign(un_1,vtelv1-etaSno(ikl,isn)
+     .                                    /max(eps6,dzsnSV(ikl,isn))))
+     .               *    max(0   ,sign(1   ,istoSV(ikl,isn)
+     .                                      -istdSV(1)      ))
+          ViscSn     =  
+     .    ViscSn*(    OK_Liq/(vvisc5+vvisc6*etaSno(ikl,isn)
+     .                            /max(eps6,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,
+     .         (un_1-dt__SV*max(SnMass(ikl)*cos(slopSV(ikl)),un_1)
+     .                     /max(ViscSn                      ,eps6)))
+          rosnew         = ro__SV(ikl,isn) *dzsnSV(ikl,isn)  
+     .                            /max(eps6,dzsnew)
+          rosmax         = 1.d0   /( (1.d0 -eta_SV(ikl,isn)) /rhoIce
+     .                               +      eta_SV(ikl,isn)  /rhoWat)
+          rosnew         =                        min(rosnew ,rosmax)
+          dzsnSV(ikl,isn)= dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+     .                            /max(eps6,rosnew)
+          ro__SV(ikl,isn)= rosnew
+          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
+      END DO
+
+
+! OUTPUT/Verification: Snow   Properties
+! #wp DO ikl = 1,knonv
+! #wp DO isn = 1,isnoSV(ikl)
+! #wp   IF (G1snSV(ikl,isn).gt.0. .AND. G2snSV(ikl,isn).gt.D__MAX) THEN
+! #wp     write(6,6600) G1snSV(ikl,isn),G2snSV(ikl,isn),ikl,isn
+ 6600     format(/,'WARNING in _GSn: G1,G2 =',2f9.3,'  (ikl,isn) =',2i4)
+! #wp     D__MAX =                      G2snSV(ikl,isn)
+! #wp   END IF
+! #wp   IF (                            G2snSV(ikl,isn).lt.0.    ) THEN
+! #wp     write(6,6601) G1snSV(ikl,isn),G2snSV(ikl,isn),ikl,isn
+ 6601     format(/,'ERROR 1 in _GSn: G1,G2 =',2f9.3,'  (ikl,isn) =',2i4)
+! #wp     STOP
+! #wp   END IF
+! #wp   IF (G1snSV(ikl,isn).gt.G1_dSV+eps6                       ) THEN
+! #wp     write(6,6602) G1snSV(ikl,isn),G2snSV(ikl,isn),ikl,isn
+ 6602     format(/,'ERROR 2 in _GSn: G1,G2 =',2f9.3,'  (ikl,isn) =',2i4)
+! #wp     STOP
+! #wp   END IF
+! #wp   IF (G1snSV(ikl,isn).lt.0.                           .AND.
+! #wp.      G2snSV(ikl,isn).gt.G1_dSV+eps6                       ) THEN
+! #wp     write(6,6603) G1snSV(ikl,isn),G2snSV(ikl,isn),ikl,isn
+ 6603     format(/,'ERROR 3 in _GSn: G1,G2 =',2f9.3,'  (ikl,isn) =',2i4)
+! #wp     STOP
+! #wp   END IF
+! #wp END DO
+! #wp END DO
+
+      return
+      end
+
+
+      subroutine SISVAT_qSo
+! #m0.                     (Wats_0,Wats_1,Wats_d)
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_qSo                           Sat 12-Feb-2012  MAR |
+!     SubRoutine SISVAT_qSo computes the Soil      Water  Balance          |
+!--------------------------------------------------------------------------+
+!                                                                          |
+!     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                      |
+!     ^^^^^    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] |
+!              Rootsv   : Root   Water Pump                      [kg/m2/s] |
+!                                                                          |
+!     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)  |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option:                                               |
+!     ^^^^^^^^^^^^^^^^^^^^^                                                |
+!     #GF: Saturation Front                                                |
+!     #GH: Saturation Front allows Horton Runoff                           |
+!     #GA: Soil Humidity Geometric Average                                 |
+!     #BP: Parameterization of Terrain Bumps                               |
+!                                                                          |
+!                                                                          |
+!     Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+!     ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+!     FILE                 |      CONTENT                                  |
+!     ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+!   # SISVAT_iii_jjj_n     | #m0: OUTPUT/Verification: H2O    Conservation |
+!   # SISVAT_iii_jjj_n     | #m1: OUTPUT/Verification: * Mass Conservation |
+!   # stdout               | #mw: OUTPUT/Verification: H2O    Conservation |
+!                          |      unit  6, SubRoutine  SISVAT_qSo **ONLY** |
+!   # SISVAT_qSo.vw        | #vw: OUTPUT/Verif+Detail: H2O    Conservation |
+!                          |      unit 42, SubRoutine  SISVAT_qSo **ONLY** |
+!   # stdout               | #sg: OUTPUT/Verification: Gravitational Front |
+!                          |      unit  6, SubRoutine  SISVAT_qSo **ONLY** |
+!                                                                          |
+!     REMARQUE: Inclure possibilite de creer mare sur bedrock impermeable  |
+!     ^^^^^^^^                                                             |
+!--------------------------------------------------------------------------+
+
+
+       
+
+
+! Global Variables
+! ================
+
+      USE  PHY_SV
+
+      USE VAR_SV
+      USE VARdSV
+      USE VAR0SV
+
+      USE VARxSV
+      USE VARySV
+
+
+      IMPLICIT NONE
+
+! OUTPUT
+! ------
+
+! OUTPUT/Verification: H2O    Conservation
+! #m0 real      Wats_0(klonv)                 ! Soil Water,  before forcing
+! #m0 real      Wats_1(klonv)                 ! Soil Water,  after  forcing
+! #m0 real      Wats_d(klonv)                 ! Soil Water          forcing
+
+
+! Internal Variables
+! ==================
+
+      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(klonv)                 ! 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(klonv)                 ! Soil     Run    OFF
+      real      Dhydtz(klonv,-nsol:0)         ! Dhydif * dt / dz           [m]
+      real      Elem_A,Elem_B,Elem_C          !   Diagonal Coefficients
+      real      Diag_A(klonv,-nsol:0)         ! A Diagonal
+      real      Diag_B(klonv,-nsol:0)         ! B Diagonal
+      real      Diag_C(klonv,-nsol:0)         ! C Diagonal
+      real      Term_D(klonv,-nsol:0)         !   Independant Term
+      real      Aux__P(klonv,-nsol:0)         ! P Auxiliary Variable
+      real      Aux__Q(klonv,-nsol:0)         ! Q Auxiliary Variable
+      real      etaaux(klonv,-nsol:-nsol+1)   ! Soil Water Content     [m3/m3]
+      real      FreeDr                        ! Free Drainage Fraction (actual)
+      real      FreeD0                        ! Free Drainage Fraction (1=Full)
+
+! OUTPUT/Verification: H2O    Conservation
+! #mw logical         mwopen                  ! IO   Switch
+! #mw common/Sm_qSo_L/mwopen                  !
+! #mw real     hourwr,timewr                  !
+! #mw common/Sm_qSo_R/timewr                  !
+! #mw real            Evapor(klonv)           !
+
+
+! Internal DATA
+! =============
+
+c #BP data      z0soil/0.020/                 ! Soil Surface Bumps Height  [m]
+      data      FreeD0/1.000/                 ! Free Drainage Fraction (1=Full)
+
+
+! OUTPUT/Verification: H2O    Conservation: 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.      + rhoWat *( 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.      + rhoWat *( 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.      + rhoWat *( 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(eps6,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 = rhoWat     *Dhydif              ! MAXimum  Infiltration
+     .           *(etadSV(ist)-eta_SV(ikl,isl))    !          Rate
+     .           /(dzAvSV(isl)*LSdzsv(ikl)    )    !
+     .          +  rhoWat     *Khydav              ! 
+
+! Surface Horton RunOFF
+! ^^^^^^^^^^^^^^^^^^^^^
+          SoRnOF(ikl) =
+     .                max(zer0,drr_SV(ikl)-Wg_MAX)
+          drr_SV(ikl) =        drr_SV(ikl)-SoRnOF(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
+
+! Water Diffusion
+! ^^^^^^^^^^^^^^^
+c #GF     Dhydif = s1__SV(ist)
+c #GF.               *max(eps6,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
+
+! Water Conduction (without Horton Runoff)
+! ^^^^^^^^^^^^^^^^
+c #GF     Khyd_f =             Ks_dSV(ist)
+!         Uses saturated K ==> Horton Runoff ~0    !
+
+! Water Conduction (with    Horton Runoff)
+! ^^^^^^^^^^^^^^^^
+c #GH     ik0    = nkhy       *eta_SV(ikl,isl)
+c #GH.                        /etadSV(ist)
+c #GH     eta__f         =            1.
+c #GH.   -aKdtSV(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.   (aKdtSV(ist,ik0)     *eta_SV(ikl,isl)
+c #GH.   +bKdtSV(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)
+!         eta__f         =     eta_SV(ikl,isl)     ! Another Possibility
+
+c #GH     ik0    = nkhy       *eta__f
+c #GH.                        /etadSV(ist)
+c #GH     Khyd_f =
+c #GH.   (aKdtSV(ist,ik0)     *eta__f
+c #GH.   +bKdtSV(ist,ik0))    /dt__SV
+
+c #GF     Khydav = ist__s    * Khyd_f              ! DR97  Assumption
+c #GF.           + ist__w    * vK_dSV              ! Water Bodies
+
+! Gravitational Flow
+! ^^^^^^^^^^^^^^^^^^
+c #GF     Wg_MAX =                                 ! MAXimum  Infiltration
+c #GF.             rhoWat     *Dhydif              !          Rate
+c #GF.           *(etadSV(ist)-eta_SV(ikl,isl))    ! 
+c #GF.           /(dzAvSV(isl)*LSdzsv(ikl)    )    !
+c #GF.          +  rhoWat     *Khydav              ! 
+
+! OUTPUT/Verification: Gravitational Front
+! #sg     write(6,6001) isl,drr_SV(ikl)*3.6e3,Wg_MAX     *3.6e3
+ 6001     format(i3,'  vRain ,Wg_MAX ',2e12.3,' mm/hr')
+
+c #GF     WgFlow =  min(Wg_MAX,drr_SV(ikl))        ! Infiltration Rate
+c #GF     WExces =  max(zer0  ,drr_SV(ikl)-WgFlow) ! Water Excess => RunOff
+
+! OUTPUT/Verification: Gravitational Front
+! #sg     write(6,6002)     WgFlow     *3.6e3,WExces     *3.6e3
+ 6002     format(3x,'  WgFlow,WExces ',2e12.3,' mm/hr')
+
+c #GF     SoRnOF(ikl) =        SoRnOF(ikl)+WExces  !
+c #GF     drr_SV(ikl) =        WgFlow              !
+
+! OUTPUT/Verification: Gravitational Front
+! #sg     write(6,6003)     SoRnOF(ikl)*3.6e3,drr_SV(ikl)*3.6e3
+ 6003     format(3x,'  SoRnOF,drr_SV ',2e12.3,' mm/hr')
+
+c #GF     SatRat =(etadSV(ist)-eta_SV(ikl,isl))    ! Saturation   Rate
+c #GF.            *rhoWat     *dzAvSV(isl)         !
+c #GF.                        *LSdzsv(ikl)/dt__SV  !
+c #GF     SatRat =  min(SatRat,drr_SV(ikl))        !
+c #GF     drr_SV(ikl) =        drr_SV(ikl)-SatRat  ! Water Flux for Below
+
+! OUTPUT/Verification: Gravitational Front
+! #sg     write(6,6004)     SatRat     *3.6e3,drr_SV(ikl)*3.6e3
+ 6004     format(3x,'  SatRat,drr_SV ',2e12.3,' mm/hr')
+! #sg     write(6,6005)     eta_SV(ikl,isl)*1.e3
+
+c #GF     eta_SV(ikl,isl) =    eta_SV(ikl,isl)     ! Saturation
+c #GF.                        +SatRat*dt__SV       !
+c #GF.                       /(rhoWat*dzAvSV(isl)  !
+c #GF.                               *LSdzsv(ikl)) !
+
+! OUTPUT/Verification: Gravitational Front
+! #sg     write(6,6005)     eta_SV(ikl,isl)*1.e3
+
+ 6005     format(3x,'  eta_SV,       ',e12.3,' g/kg')
+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]
+!         Inclure la possibilite de creer une mare sur un bedrock impermeable
+c #GF     drr_SV(ikl) = 0.
+c #GF   END DO
+
+
+! Temperature Correction due to a changed Soil Energy Content
+! ===========================================================
+
+! REMARQUE: Mettre en oeuvre le couplage humidite-energie
+! ^^^^^^^^
+
+
+! 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 !
+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
+
+
+! Tridiagonal Elimination: Set Up
+! -------------------------------
+
+! Soil/Snow Interior
+! ^^^^^^^^^^^^^^^^^^
+      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)
+          Elem_A   =         Dhydtz(ikl,isl)   
+     .                    -  aKdtSV(ist,ikm)* dziiSV(isl)  *LSdzsv(ikl)
+          Elem_B   =      - (Dhydtz(ikl,isl)
+     .                      +Dhydtz(ikl,isl+1)
+     .                      -aKdtSV(ist,ik0)*(dziiSV(isl+1)
+     .                                       -dzi_SV(isl) )*LSdzsv(ikl))
+          Elem_C   =         Dhydtz(ikl,isl+1) 
+     .                    +  aKdtSV(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)
+     .                    + (bKdtSV(ist,ikp)* dzi_SV(isl+1)
+     .                      +bKdtSV(ist,ik0)*(dziiSV(isl+1)
+     .                                       -dzi_SV(isl)  )
+     .                      -bKdtSV(ist,ikm)* dziiSV(isl)   )
+     .                                      * LSdzsv(ikl)
+     .                    -  dt__SV         * Rootsv(ikl,isl)/rhoWat
+        END DO
+      END DO
+
+           isl=-nsol
+        DO ikl=1,knonv
+          ist      =         isotSV(ikl)
+          FreeDr   =         iWaFSV(ikl)       *  min(ist,1)
+!         FreeDr   =         FreeD0            *  min(ist,1) ! Free Drainage
+          ik0      = nkhy *  eta_SV(ikl,isl  ) / etadSV(ist)
+          ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
+          Elem_A   =         0.
+          Elem_B   =      - (Dhydtz(ikl,isl+1) 
+     .                      -aKdtSV(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl)
+     .                                       -FreeDr                  ))
+          Elem_C   =         Dhydtz(ikl,isl+1) 
+     .                    +  aKdtSV(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)
+     .                    + (bKdtSV(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
+     .                      +bKdtSV(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl)
+     .                                       -FreeDr                  ))
+     .                    -  dt__SV         * Rootsv(ikl,isl)/rhoWat
+        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)   
+     .                    -  aKdtSV(ist,ikm)* dziiSV(isl)*LSdzsv(ikl)
+          Elem_B   =      - (Dhydtz(ikl,isl)
+     .                      +aKdtSV(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)
+     .                    - (bKdtSV(ist,ik0)* dzi_SV(isl)
+     .                      +bKdtSV(ist,ikm)* dziiSV(isl))*LSdzsv(ikl)
+     .            + dt__SV *(HLs_sv(ikl)    *     (1-min(1,isnoSV(ikl)))
+     .                                                   / Lx_H2O(ikl)
+     .                      +drr_SV(ikl)
+     .                      -Rootsv(ikl,isl)             )/rhoWat 
+        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   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
+     .              *rhoWat         *dzAvSV(isl)   !
+     .                              *LSdzsv(ikl)   !
+     .                              /dt__SV        !
+          SoRnOF(ikl)     =          SoRnOF(ikl)   !
+     .                    + max(zer0,SatRat)       !
+          eta_SV(ikl,isl) = max(eps6               !
+     .                         ,eta_SV(ikl,isl))   !
+          eta_SV(ikl,isl) = min(eta_SV(ikl,isl)    !
+     .                         ,etadSV(ist)    )   !
+        END DO
+      END DO
+
+! OUTPUT/Verification: Soil Vertic.Discret.
+! #so     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)   =(aKdtSV(ist,ikp)  *eta_SV(ikl,isl)
+     .                       +bKdtSV(ist,ikp)) *2.0/dt__SV
+! OUTPUT/Verification: Soil Vertic.Discret.
+! #so     write(6,6011) ikl,isl,eta_SV(ikl,isl)*1.e3,
+! #so.                  ikp,    aKdtSV(ist,ikp),bKdtSV(ist,ikp),
+! #so.                          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   =          iWaFSV(ikl)       *  min(ist,1)
+!         FreeDr   =          FreeD0            *  min(ist,1) ! Free Drainage
+          SoRnOF(ikl) =  SoRnOF(ikl)
+     .                + (aKdtSV(ist,ik0)*(etaaux(ikl,-nsol)*Explic
+     .                                   +eta_SV(ikl,-nsol)*Implic)
+     .                 + bKdtSV(ist,ik0)                           )
+     .                 * FreeDr          *rhoWat           /dt__SV
+
+! Full Run OFF: Update
+! ~~~~~~~~~~~~~~~~~~~~
+          RnofSV(ikl) = RnofSV(ikl)     + SoRnOF(ikl)
+        END DO
+
+
+! Temperature Correction due to a changed Soil Energy Content
+! ===========================================================
+
+! REMARQUE: Mettre en oeuvre le couplage humidite-energie
+! ^^^^^^^^
+
+
+! Bumps/Asperites Treatment
+! =========================
+
+! Average over Bump Depth (z0soil)
+! --------------------------------
+
+c #BP       z_Bump      = 0.
+c #BP     DO ikl=1,knonv
+c #BP       etBump(ikl) = 0.
+c #BP     END DO
+
+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
+
+
+! Correction
+! ----------
+
+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
+
+
+! Positive Definite
+! =================
+
+c #BP DO   isl= 0,-nsol,-1
+c #BP   DO ikl= 1,knonv
+c #BP     eta_SV(ikl,isl)   =          max(eps6,eta_SV(ikl,isl))
+c #BP   END DO
+c #BP END DO
+
+
+! OUTPUT/Verification: H2O    Conservation: Water  Budget (OUT)
+! #m0   DO ikl=1,knonv
+! #m0     Wats_d(ikl) = Wats_d(ikl)                    ! 
+! #m0.                + drr_SV(ikl)     *0.00          ! 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.                             !
+
+! OUTPUT/Verification: H2O    Conservation
+! #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.                - Rootsv(ikl,isl)                ! Root Extract.
+! #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.      + rhoWat *( 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.      + rhoWat *( 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.      + rhoWat *( eta_SV(ikl,isl)   *dz78SV(isl)
+! #m0.                + eta_SV(ikl,isl-1) *dz_8SV(isl) ) *LSdzsv(ikl)
+! #m0   END DO
+
+
+! OUTPUT/Verification: H2O    Conservation
+! #mw IF (.NOT.mwopen)                                              THEN
+! #mw          mwopen = .true.
+! #mw          open(unit=42,status='unknown',file='SISVAT_qSo.vw')
+! #mw          rewind 42
+! #mw   write(42,42)
+ 42     format('SubRoutine SISVAT_qSo: Local Water Budget',
+     .       /,'=========================================')
+! #mw END IF
+! #mw         timewr=timewr + dt__SV
+! #mw         hourwr=3600.0
+! #mw IF (mod(timewr,hourwr).lt.eps6)
+! #mw.  write(42,420)timewr/hourwr
+ 420    format(11('-'),'----------+--------------+-',
+     .          3('-'),'----------+--------------+-',
+     .                 '----------------+----------------+',
+     .       /,f8.2,3x,'Wats_0(1) |    Wats_d(1) | ',
+     .              3x,'Wats_1(1) | W_0+W_d-W_1  | ',
+     .                 '   Soil Run OFF |   Soil Evapor. |',
+     .       /,11('-'),'----------+--------------+-',
+     .          3('-'),'----------+--------------+-',
+     .                 '----------------+----------------+')
+! #mw   write(42,421)   Wats_0(1),Wats_d(1)
+! #mw.                 ,Wats_1(1) 
+! #mw.                 ,Wats_0(1)+Wats_d(1)-Wats_1(1)
+! #mw.                 ,SoRnOF(1),Evapor(1)
+ 421    format(8x,f12.6,' + ',f12.6,' - ',f12.6,' = ',f12.6,' | ',f12.6,
+     .      '      ',f15.6)
+
+      return
+      end
+
+
+      subroutine SISVAT_wEq( labWEq ,istart)
+
+!--------------------------------------------------------------------------+
+!   MAR          SISVAT_wEq                           Sat 12-Feb-2012  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 VAR_SV
+      USE VARxSV
+
+      IMPLICIT NONE
+
+      character*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
Index: LMDZ5/trunk/libf/phylmd/sisvat/surf_sisvat_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/sisvat/surf_sisvat_mod.F90	(revision 1865)
+++ LMDZ5/trunk/libf/phylmd/sisvat/surf_sisvat_mod.F90	(revision 1865)
@@ -0,0 +1,1743 @@
+MODULE surf_sisvat_mod
+  USE dimphy
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER    :: nsnowmx=35
+  INTEGER, PARAMETER    :: nsismx=46         ! = nsnowmx + nsoilmx 
+
+CONTAINS
+
+                                       
+
+  SUBROUTINE surf_sisvat(knon,rlon,rlat, ikl2i, itime, dtime, debut, lafin, &
+             rmu0, swdown, lwdown, pexner, ps, p1lay, &
+             precip_rain, precip_snow, precip_snow_adv, snow_adv, &
+             bl_height, wind_velo, temp_air, dens_air, spechum, tsurf, &
+             rugos, snow_cont_air, alb_soil, slope, cloudf, &
+             radsol, qsol, tsoil, snow, snowhgt, qsnow, to_ice, sissnow, agesno, & 
+             AcoefH, AcoefQ, BcoefH, BcoefQ, cdragh, &
+             runoff_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &      
+             tsurf_new, alb1, alb2, alb3, &
+             emis_new, z0_new, qsurf)       
+                                                                             
+! +------------------------------------------------------------------------+   
+! |                                                                        |   
+! |   SubRoutine surf_sisvat: Interface between LMDZ and landice scheme    |
+! |     of the SISVAT (Soil/Ice Snow Vegetation Atmosphere Transfer Scheme)|   
+! |                                                                        |
+! |   Author: Heinz Juergen Punge, LSCE                June 2009           |
+! |     based on the MAR-SISVAT interface by Hubert Gallee                 |
+! |                                                                        |   
+! +------------------------------------------------------------------------+   
+! |   
+! |   In the current setup, SISVAT is used only to model the land ice      |
+! |   part of the surface; hence it is called with the compressed variables| 
+! |   from pbl_surface, and only by the surf_landice routine.              |
+! |                                                                        |   
+! |   In this interface it is assumed that the partitioning of the soil,   |
+! |   and hence the number of grid points is constant during a simulation, |
+! |   hence eg. snow properties remain stored in the global SISVAT         |
+! |   variables between the calls and don't need to be handed over as      |
+! |   arguments. When the partitioning is supposed to change, make sure to |
+! |   update the variables.                                                | 
+! |                                                                        |  
+! |   INPUT                                                                |  
+! |   ^^^^^     VegMod: SISVAT    is set up when .T.                       |  
+! |             SnoMod: Snow Pack is set up when .T.                       |  
+! |             reaLBC: Update Bound.Condit.when .T.                       |   
+! |                                                                        |  
+! |   INPUT    (via MODULES VARxSV, VARySV, VARtSV)                        |  
+! |   ^^^^^     xxxxSV: SISVAT/LMDZ interfacing variables                  |   
+! |                                                                        |  
+! |   Preprocessing  Option: SISVAT PHYSICS                                |   
+! |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^^^^^^                                |   
+! | #                       #HY                                            |   
+! | #                       #SN: Snow         Model                        |   
+! | #                       #BS: Blowing Snow Parameterization             |   
+! |                                                                        |   
+! | #                       #DS: diffuse radiation differing from direct   |   
+! |                             (variable RADsod must still be included)   |
+! | #                       #CP: SBL,                       Col de Porte   |   
+! | #                       #cp  Solar Radiation,           Col de Porte   |   
+! | #                       #AG: Snow Ageing,               Col de Porte   |   
+! |                                                                        |   
+! |   Preprocessing  Option: SISVAT IO                                     |   
+! |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |   
+! |   FILE                 |      CONTENT                                  |   
+! |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |   
+! | # ANI.yyyymmdd.LAB.nc  | #NC: OUTPUT on NetCDF File (Stand Alone EXP.) |   
+! | # SISVAT_iii_jjj_n     | #WV: OUTPUT on ASCII  File (SISVAT Variables) |   
+! | # SISVATtroubles       | #VF: OUTPUT on ASCII  File (SISVAT Troubles)  |   
+! |                        |                                               |   
+! | #                      | #ES: OUTPUT/Verification: Energy Conservation |   
+! | #                      | #E2: OUTPUT/Verification: Energy Consrv.2e pt.|   
+! |                        |                           (no premature stop) |   
+! | #                      | #MW: OUTPUT/Verification: H2O    Conservation |   
+! | #                      | #MS: OUTPUT/Verification: * Mass Conservation |   
+! | #                      | #MI: OUTPUT/Verification: SeaIce Conservation |   
+! |                        |                                               |   
+! | # SISVAT__zSn.OUT      | #as: OUTPUT/Verification: Snow Layers Agrega. |   
+! | # SISVAT__SnO.OUT      | #aw: OUTPUT/Verification: Albedo Parameteriz. |   
+! | # SISVATe_qSn.OUT      | #em: OUTPUT/Verification: Energy/Water Budget |   
+! | # SISVATu_qSn.OUT      | #su: OUTPUT/Verification: Slush  Parameteriz. |   
+! | # SISVATw_qSo.OUT      | #mw: OUTPUT/Verif+Detail: H2O    Conservation |   
+! |                        |                                               |   
+! | # SISVAT__GSn.OUT      | #VP: OUTPUT/Verification: Snow   Properties   |   
+! | # SISVAT__wEq.OUT      | #EQ: OUTPUT/Verification: Snow/Ice Water Eqv. |   
+! |                        |                                               |   
+! | #                      | #VR: VERIFICATION OUTPUT                      |   
+! | #                      | #WR: Additional   OUTPUT                      |   
+! |                                                                        |   
+! +------------------------------------------------------------------------+ 
+                                                       
+    USE VAR_SV 
+    USE VARdSV 
+    USE VARxSV 
+    USE VARySV
+    USE VARtSV
+ 
+    USE VARdCP
+    USE VARphy, ra_earth=>ra
+    USE YOMCST              
+                                        
+    IMPLICIT NONE    
+                                                                
+! +--INTERFACE Variables                                                     
+! +  =================== 
+                                            
+    include  "dimsoil.h"                                     
+                                                                    
+
+! +--Global Variables                                                          
+! +  ================  
+! Input Variables for SISVAT
+    INTEGER,               INTENT(IN)      :: knon
+    INTEGER,               INTENT(IN)      :: itime   
+    REAL,                  INTENT(IN)      :: dtime 
+    LOGICAL,               INTENT(IN)      :: debut     ! true if first step
+    LOGICAL,               INTENT(IN)      :: lafin     ! true if last step
+
+    INTEGER, DIMENSION(klon), INTENT(IN)   :: ikl2i     ! Index Decompression
+    REAL, DIMENSION(klon), INTENT(IN)      :: rlon, rlat
+    REAL, DIMENSION(klon), INTENT(IN)      :: rmu0      ! cos sol. zenith angle
+    REAL, DIMENSION(klon), INTENT(IN)      :: swdown    !
+    REAL, DIMENSION(klon), INTENT(IN)      :: lwdown    ! 
+    REAL, DIMENSION(klon), INTENT(IN)      :: pexner    ! Exner potential
+    REAL, DIMENSION(klon), INTENT(IN)      :: precip_rain, precip_snow
+    REAL, DIMENSION(klon), INTENT(IN)      :: precip_snow_adv, snow_adv 
+                                                        !Snow Drift
+    REAL, DIMENSION(klon), INTENT(IN)      :: bl_height, wind_velo
+    REAL, DIMENSION(klon), INTENT(IN)      :: temp_air, spechum, ps,p1lay
+    REAL, DIMENSION(klon), INTENT(IN)      :: dens_air, tsurf            
+    REAL, DIMENSION(klon), INTENT(IN)      :: rugos,snow_cont_air
+    REAL, DIMENSION(klon), INTENT(IN)      :: alb_soil, slope 
+    REAL, DIMENSION(klon), INTENT(IN)      :: cloudf   
+    REAL, DIMENSION(klon), INTENT(IN)      :: AcoefH, AcoefQ
+    REAL, DIMENSION(klon), INTENT(IN)      :: BcoefH, BcoefQ
+    REAL, DIMENSION(klon), INTENT(IN)      :: cdragh
+
+! Variables exchanged between LMDZ and SISVAT
+    REAL, DIMENSION(klon,nsoilmx), INTENT(OUT) :: tsoil ! Soil Temperature 
+    REAL, DIMENSION(klon), INTENT(OUT)     :: qsol      ! Soil Water Content   
+    REAL, DIMENSION(klon), INTENT(INOUT)   :: snow      ! Tot snow mass [kg/m2]
+    REAL, DIMENSION(klon), INTENT(IN)      :: radsol    ! Surface absorbed rad.
+
+! Output Variables from SISVAT
+    REAL, DIMENSION(klon), INTENT(OUT)     :: alb1      ! Albedo SW 
+    REAL, DIMENSION(klon), INTENT(OUT)     :: alb2,alb3      ! Albedo LW
+    REAL, DIMENSION(klon), INTENT(OUT)     :: emis_new  ! Surface Emissivity
+    REAL, DIMENSION(klon), INTENT(OUT)     :: z0_new    ! Momentum Roughn Lgt
+    REAL, DIMENSION(klon), INTENT(OUT)     :: runoff_lic ! Runoff            
+    REAL, DIMENSION(klon), INTENT(OUT)     :: dflux_s   ! d/dT sens. ht flux  
+    REAL, DIMENSION(klon), INTENT(OUT)     :: dflux_l   ! d/dT latent ht flux 
+    REAL, DIMENSION(klon), INTENT(OUT)     :: fluxsens  ! Sensible ht flux    
+    REAL, DIMENSION(klon), INTENT(OUT)     :: fluxlat   ! Latent heat flux
+    REAL, DIMENSION(klon), INTENT(OUT)     :: evap      ! Evaporation
+    REAL, DIMENSION(klon), INTENT(OUT)     :: agesno    ! Snow age (top layer)
+    REAL, DIMENSION(klon), INTENT(OUT)     :: tsurf_new ! Surface Temperature 
+    REAL, DIMENSION(klon), INTENT(OUT)     :: qsurf     ! Surface Humidity 
+    REAL, DIMENSION(klon), INTENT(OUT)     :: qsnow     ! Total H2O snow[kg/m2]
+    REAL, DIMENSION(klon), INTENT(OUT)     :: snowhgt   ! Snow height (m)
+    REAL, DIMENSION(klon), INTENT(OUT)     :: to_ice    ! Snow passed to ice 
+    REAL, DIMENSION(klon), INTENT(OUT)     :: sissnow   ! Snow in model (kg/m2)
+                                                                           
+! +--OUTPUT for NetCDF File                                         
+! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                             
+!   REAL, DIMENSION(klonv)                 :: SOsoKL    ! Abs Solar Radiation 
+!   REAL, DIMENSION(klonv)                 :: IRsoKL    ! Abs IR    Radiation 
+!   REAL, DIMENSION(klonv)                 :: HSsoKL    ! Abs Sensible Ht Flux 
+!   REAL, DIMENSION(klonv)                 :: HLsoKL    ! Abs Latent Heat Flux 
+!   REAL, DIMENSION(klonv)                 :: HLs_KL    ! Evaporation          
+!   REAL, DIMENSION(klonv)                 :: HLv_KL    ! Transpiration        
+!                              
+!   REAL, DIMENSION(klonv)                 :: SOsoNC    ! Abs Solar Radiation  
+!   REAL, DIMENSION(klonv)                 :: IRsoNC    ! Abs IR    Radiation  
+!   REAL, DIMENSION(klonv)                 :: HSsoNC    ! Abs Sensible Ht Flux
+!   REAL, DIMENSION(klonv)                 :: HLsoNC    ! Abs Latent Heat Flux
+!   REAL, DIMENSION(klonv)                 :: HLs_NC    ! Evaporation      
+!   REAL, DIMENSION(klonv)                 :: HLv_NC    ! Transpiration     
+!                                      
+!   REAL, DIMENSION(klonv,nsoilmx)           :: eta_NC    ! nsoilmx=nsol+1
+!   REAL, DIMENSION(klonv,nsoilmx)           :: tsolNC    !   
+!   REAL, DIMENSION(klonv)                   :: snowNC    !
+!   INTEGER, DIMENSION(klonv)                :: isnoNC    !
+!   INTEGER, DIMENSION(klonv)                :: ispiNC    !     
+!   INTEGER, DIMENSION(klonv)                :: iiceNC    !           
+!   REAL, DIMENSION(klonv)                   :: swaNC     !
+!   REAL, DIMENSION(klonv)                   :: swsNC     !   
+!   INTEGER, DIMENSION(klonv,nsno)           :: istoNC    ! 
+!   REAL, DIMENSION(klonv,nsno)              :: dzsnNC    ! 
+!   REAL, DIMENSION(klonv,nsno)              :: rhosnNC   !      
+!   REAL, DIMENSION(klonv,nsno)              :: etasnNC   !  
+!   REAL, DIMENSION(klonv,nsno)              :: tsnNC     ! 
+!   REAL, DIMENSION(klonv,nsno)              :: g1snNC    !      
+!   REAL, DIMENSION(klonv,nsno)              :: g2snNC    !                    
+!   REAL, DIMENSION(klonv,nsno)              :: agsnNC    ! 
+!   REAL, DIMENSION(klonv)                   :: meltNC    !      
+!   REAL, DIMENSION(klonv)                   :: refrNC    !                
+!   REAL, DIMENSION(klonv)                   :: alb1NC    !      
+!   REAL, DIMENSION(klonv)                   :: alb2NC    !         
+!   REAL, DIMENSION(klonv)                   :: rnofNC    ! 
+                                                                          
+! + Optional Variables:                                                 
+! +--V,  dT(a-s)    Time Moving Averages                                       
+! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~           
+
+! #AW real             V__mem(klon,ntaver)   ! ntaver defined in LMDZ_SL.inc  
+! #AW real             VVmmem(klon)          !                                 
+! #AW common/SVeSBLmem/V__mem,VVmmem         !                                 
+! #AH real             T__mem(klon,ntaver)   !                                 
+! #AH real             dTmmem(klon)          !                                 
+! #AH common/STeSBLmem/T__mem,dTmmem         !                      
+! +--u*, u*T*, u*s* Time Moving Averages                                    
+! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                                       
+! #AM real             u__mem(klon,ntaver)   ! ntaver defined in LMDZ_SL.inc  
+! #AT real             uT_mem(klon,ntaver)   !                                 
+! #AS real             us_mem(klon,ntaver)   !                                 
+! #AM common/S_eSBLmem/u__mem                !                                 
+! #AT.                ,uT_mem                !                                 
+! #AS.                ,us_mem                !
+!! #AH    REAL, DIMENSION(klonv,ntaver)            :: T__mem    !
+!! #AH    REAL, DIMENSION(klonv)                   :: dTmmem    ! 
+!! #AW    REAL, DIMENSION(klonv,ntaver)            :: V__mem    !      
+!! #AM    REAL, DIMENSION(klonv)                   :: u__mem    !             
+!! #AT    REAL, DIMENSION(klonv)                   :: uT_mem    ! 
+!! #AS    REAL, DIMENSION(klonv)                   :: us_mem    !     
+!! #AW    REAL, DIMENSION(klonv)                   :: VVmmem    !    
+
+                                                                    
+! +--Internal  Variables                                                       
+! +  ===================                                          
+
+    CHARACTER(len=20)               :: fichnom, fn_outfor ! Name for output file
+    INTEGER                         :: i, ig, ikl, isl, isn, nt
+    INTEGER                         :: gp_outfor, un_outfor
+
+    REAL, PARAMETER                 :: f1=0.5
+    REAL, PARAMETER                 :: sn_upp=5000.,sn_low=500.
+    REAL, PARAMETER                 :: sn_add=400.,sn_div=2.
+                                             ! snow mass upper,lower limit, 
+                                             ! added mass/division lowest layer
+    REAL, PARAMETER                 :: c1_zuo=12.960e+4, c2_zuo=2.160e+6
+    REAL, PARAMETER                 :: c3_zuo=1.400e+2,  czemin=1.e-3  
+                                             ! Parameters for drainage
+! c1_zuo/ 2.796e+4/,c2_zuo/2.160e+6/,c3_zuo/1.400e+2/ !     Tuning
+! +...        Run Off Parameters                                              
+! +           86400*1.5 day     ...*25 days (Modif. ETH Camp: 86400*0.3day)    
+! +           (Zuo and Oerlemans 1996, J.Glacio. 42, 305--317)             
+
+    REAL, DIMENSION(klon)           :: eps0SL          ! surface Emissivity 
+    REAL                            :: zsigma, Ua_min, Us_min
+    REAL                            :: lambda          ! Par. soil discret.
+    REAL, DIMENSION(nsoilmx), SAVE  :: dz1,dz2         ! Soil layer thicknesses
+!$OMP THREADPRIVATE(dz1)
+    LOGICAL, SAVE                   :: firstcall=.TRUE.,SnoMod, ok_outfor=.FALSE.!$OMP THREADPRIVATE(firstcall)                
+
+
+
+! + Optional:  
+!c #BW INTEGER                      ::  noUNIT                  
+!c #BW REAL                         ::  BlowST,SnowSB   
+                                          
+                                        
+! +--Internal Variables
+! +  ==================
+
+    INTEGER                         ::  ivg,iso
+
+!========================================================================
+ 
+      SnoMod=.true.
+      zsigma=1000.
+      dt__SV=dtime
+      IF (ok_outfor) THEN
+        un_outfor=51                 ! unit number for point output
+        gp_outfor=79! 633 !79        ! grid point number for point output
+        fn_outfor='outfor_SV.dat' 
+      END IF
+
+!     write(*,*)'Start of simulation? ',debut        !hj
+      IF (debut) THEN 
+        firstcall=.TRUE. 
+        INI_SV=.false.
+      ELSE
+        firstcall=.false.
+        INI_SV=.true.
+      END IF
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! + INITIALISATION: BEGIN +++ 
+! + -------------------------
+! +
+! + Compute soil discretization (as for LMDZ)
+! + -----------------------------------------  
+      IF (firstcall) THEN
+
+! +--Array size
+        klonv=klon
+        knonv=knon
+        write(*,*)'klon',klon,'klonv',klonv,'knon',knon 
+
+
+        CALL INIT_VARtSV
+        CALL INIT_VARxSV
+        CALL INIT_VARySV
+
+        eps0SL(:)=0.
+! +--Soil layer thickness                                                   
+! +  -----------------------  
+!        write(*,'(/a)') 'Start SISVAT init: soil discretization ', nsoilmx
+        CALL get_soil_levels(dz1,dz2,lambda)
+        lambSV=lambda
+        dz1_SV(1:knon,1:) = 0.     
+        dz2_SV(1:knon,1:) = 0.
+                      
+        DO isl =   -nsol,0   
+          dz_dSV(isl) = 0.5e-3*dz2(1-isl)           ! Soil layer thickness 
+          DO ikl=1,knon
+            dz1_SV(ikl,isl) = dz1(1-isl)    !1.e-3* 
+            dz2_SV(ikl,isl) = dz2(1-isl)    !1.e-3*
+          END DO
+!          IF (knon > 0) THEN
+!            write(*,*)'level:',dz_dSV(isl),dz1_SV(1,isl),dz2_SV(1,isl)
+!          END IF
+        END DO
+
+        DO ikl=1,knon                                
+          eps0SL(ikl )= 1.
+          alb0SV(ikl) = alb_soil(ikl)              ! Soil Albedo        
+
+! + Soil Upward IR Flux, Water Fluxes, roughness length  
+          IRs_SV(ikl) =                               &
+              -eps0SL(ikl)* rsigma*temp_air(ikl)      &  ! Upward IR Flux
+              *temp_air(ikl)*temp_air(ikl)*temp_air(ikl)         
+          TvegSV(ikl) = temp_air(ikl) 
+ ! + Soil
+        DO isl =   -nsol,0    
+          TsisSV(ikl,isl) = temp_air(ikl)  !tsoil(ikl,1-isl)  Soil Temperature
+          eta_SV(ikl,isl) = 0.0001         !etasoil(ikl,1-isl)Soil Water[m3/m3]
+          ro__SV(ikl,isl) = 50.      !rosoil(ikl,1-isl) soil water volumic mass
+        END DO            
+        END DO                                            
+
+! +--Surface Fall Line Slope                                                   
+! +  -----------------------  
+        IF (SnoMod)  THEN                
+          DO ikl=1,knon  
+            slopSV(ikl) = slope(ikl)
+            SWf_SV(ikl) =             &   ! Normalized Decay of the  
+              exp(-dt__SV             &   ! Surficial Water Content  
+              /(c1_zuo                &   !(Zuo and Oerlemans 1996,  
+            +c2_zuo*exp(-c3_zuo*abs(slopSV(ikl)))))  ! J.Glacio. 42, 305--317)
+          END DO                                     
+        END IF           
+                             
+! +--SBL  Characteristics history, not stored at restart.                     
+        DO ikl=1,knon  
+         DO nt=1,ntaver                                       ! #AW
+           V__mem(ikl,nt)=wind_velo(ikl)                      ! #AH
+           T__mem(ikl,nt)=temp_air(ikl)-tsurf(ikl) 
+         END DO                                         
+        END DO                                     
+
+
+! + SISVAT_ini (as for use with MAR, but not computing soil layers)
+! + -------------------------------------------------------------
+!        write(*,'(/a)') 'Start SISVAT initialization: SISVAT_ini' 
+        CALL SISVAT_ini(knon)
+
+! open output file 
+        IF (ok_outfor) THEN
+          open(unit=un_outfor,status='new',file=fn_outfor)         
+          rewind un_outfor      
+          ikl=gp_outfor     ! index sur la grille land ice
+          ig=611            ! index sur la grille globale
+          write(un_outfor,501) fn_outfor, ikl, rlon(ig),rlat(ig)  
+501     format(/,a18,/,'Grid point ',i4,' Long',f9.4,' Lat ',f9.4       &
+     &            ,/,'++++++++++++++++++++++++++++++++++++++++++++++',  &
+     & '++++++++++++++++++++++++++++++++++++++++++++++',                &
+     & '++++++++++++++++++++++++++++++++++++++++++++++',                &
+     &             /,' SWdown + IRdown + Wind   + Temp.  + Humid.   ',  &
+     & '+ Press  +Precip_l+Precip_s+ Tsrf   + Clouds +'                 &
+     & '+ Zenith + BLhgt  + Densair+ Exner +'                           &
+     &            ,/,' sol_SV + IRd_SV + VV__SV + TaT_SV + QaT_SV   ',  &
+     & '+ ps__SV + drr_SV + dsn_SV + Tsf_SV + cld_SV +'                 &
+     & '+ coszSV + za__SV + rhT_SV + ExnrSV+'                           &
+     &            ,/,' W/m2   + W/m2   + m/s    + K      + kg/kg    ',  &
+     & '+ Pa     + kg/m2/s+ kg/m2/s+ K      + /1     +'        &
+     & '+ -      + m      + kg/m3  +       +'                           &
+     &            ,/,'++++++++++++++++++++++++++++++++++++++++++++++',  &
+     & '++++++++++++++++++++++++++++++++++++++++++++++',                &
+     & '++++++++++++++++++++++++++++++++++++++++++++++')
+        END IF
+
+! +--Read restart file
+! +  =================================================   
+        
+! Martin
+       PRINT*, 'On debranche sisvatetat0'
+! Martin
+
+       ! CALL sisvatetat0("startsis.nc",ikl2i)
+
+ 
+      END IF  ! firstcall                        
+! +                                
+! +  +++  INITIALISATION:  END  +++                               
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! + READ FORCINGS  
+! + ------------------------ 
+! + Update Forcings for SISVAT given by the LMDZ model.
+! +
+      DO ikl=1,knon
+
+! +--Atmospheric Forcing                                    (INPUT)            
+! +  ^^^^^^^^^^^^^^^^^^^                                     ^^^^^ 
+        zSBLSV      = 1000.                         ! [m]                
+        za__SV(ikl) = bl_height(ikl)                ! Height boundary layer [m]
+        Ua_min      = epsi                          !
+! #VM   Ua_min      = 0.2 * sqrt(za__SV(ikl)   )    !                    
+        Ua_min      = 0.2 * sqrt(za__SV(ikl)   )    !                    
+        VV__SV(ikl) = max(Ua_min, wind_velo(ikl))   ! Wind velocity       [m/s]
+        Us_min      = 0.01
+        us__SV(ikl) = max(Us_min, us__SV(ikl) ) 
+        TaT_SV(ikl) = temp_air(ikl)                 ! BL top Temperature    [K]
+        ExnrSV(ikl) = pexner(ikl)                   ! Exner potential          
+        rhT_SV(ikl) = dens_air(ikl)                 ! Air density           
+        QaT_SV(ikl) = spechum(ikl)                  ! Specific humidity 
+! #VX   dQa_SV(ikl) = 0. !hj   dtDiff/zsigma(mz)    ! Water Vapor Flux
+        ps__SV(ikl) = ps(ikl)                       ! surface pressure     [Pa]
+        p1l_SV(ikl) = p1lay(ikl)                  ! lowest atm. layer press[Pa]
+
+! +--Energy Fluxes                                          (INPUT)           
+! +  ^^^^^^^^^^^^^                                           ^^^^^             
+        coszSV(ikl) = max(czemin,rmu0(ikl))         ! cos(zenith.Dist.)  
+        sol_SV(ikl) = swdown(ikl)                   ! downward Solar  
+        IRd_SV(ikl) = lwdown(ikl)                   ! downward IR    
+        rsolSV(ikl) = radsol(ikl)                   ! surface absorbed rad.   
+!hj 110511
+!hj 121011        IRs_SV(ikl) = min(IRs_SV(ikl),-epsi)        ! check upward IR    
+!hj
+! +--Water  Fluxes                                          (INPUT)           
+! +  ^^^^^^^^^^^^^                                           ^^^^^             
+        drr_SV(ikl) = precip_rain(ikl)              ! Rain fall rate  [kg/m2/s]
+        dsn_SV(ikl) = precip_snow(ikl)              ! Snow fall rate  [kg/m2/s]
+!c #BS  dbsnow      = -SLussl(i,j,n)                ! Erosion    
+!c #BS.               *dtPhys     *rhT_SV(ikl) /ro_Wat                    
+!c #BS  dsnbSV(ikl) = snow_adv(ikl)  ! min(max(zero,dbsnow)              
+!c #BS.                    /    max(epsi,d_snow),unun)                    
+!c #BS  dbs_SV(ikl) = snow_cont_air(ikl)
+!c #BS                  blowSN(i,j,n)               !          [kg/m2]  
+                                                                              
+! +--Soil/Canopy                                            (INPUT)            
+! +  ^^^^^^^^^^^                                             ^^^^^            
+        alb0SV(ikl) = alb_soil(ikl)                 ! Soil background Albedo 
+        AcoHSV(ikl) = AcoefH(ikl)  
+        BcoHSV(ikl) = BcoefH(ikl)                     
+        AcoQSV(ikl) = AcoefQ(ikl)  
+        BcoQSV(ikl) = BcoefQ(ikl)
+        cdH_SV(ikl) = cdragh(ikl)                         
+        Tsf_SV(ikl) = tsurf(ikl)        !hj 12 03 2010
+
+! +--Energy Fluxes                                          (INPUT/OUTPUT)    
+! +  ^^^^^^^^^^^^^                                           ^^^^^^^^^^^^    
+        IF (.not.firstcall) THEN  
+! active hj 110411
+        cld_SV(ikl) = cloudf(ikl)                    ! Cloudiness         
+        END IF
+ 
+! +--Time Averages of wind and surface-atmosphere temperature difference 
+! +--for turbulence calculations                                       ! #AA
+! Update stored arrays
+      DO nt=1,ntaver-1                                                 ! #AW   
+        V__mem(ikl,nt    ) = V__mem(ikl,nt+1)                          ! #AH   
+        T__mem(ikl,nt    ) = T__mem(ikl,nt+1)                          ! #AA  
+      ENDDO                                                            ! #AW
+        V__mem(ikl,ntaver)=wind_velo(ikl)                              ! #AH
+        T__mem(ikl,ntaver)=temp_air(ikl)-tsurf(ikl)                    ! #AW
+! Calculate averages
+        VVmmem(ikl)        = 0.0                                       ! #AH
+        dTmmem(ikl)        = 0.0                                       ! #AA
+      DO nt=1,ntaver                                                   ! #AW
+        VVmmem(ikl)        = VVmmem(ikl)+V__mem(ikl,nt)                ! #AH
+        dTmmem(ikl)        = dTmmem(ikl)+T__mem(ikl,nt)                ! #AA 
+      ENDDO                                                            ! #AW 
+        VVmmem(ikl)        = VVmmem(ikl)/ntaver                        ! #AH 
+        dTmmem(ikl)        = dTmmem(ikl)/ntaver                   
+      END DO
+
+!                            
+! +  +++  READ FORCINGS:  END  +++    
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! +  OUTPUT FORCING
+!
+      IF (ok_outfor) THEN
+        ikl=gp_outfor
+        write(un_outfor,5000) sol_SV(ikl), IRd_SV(ikl), VV__SV(ikl),    &    
+     &                        TaT_SV(ikl), QaT_SV(ikl), ps__SV(ikl),    &
+     &                        drr_SV(ikl), dsn_SV(ikl), Tsf_SV(ikl),    &
+     &                        cld_SV(ikl), coszSV(ikl), za__SV(ikl),    &
+     &                        rhT_SV(ikl), ExnrSV(ikl) 
+      
+ 5000     format(f8.3,' ',f8.3,' ',f8.4,' ',f8.4,' ',f10.8,' ',f8.1,' ', &
+     &           f8.6,' ',f8.6,' ',f8.4,' ',f8.6,' ',f8.6,' ',f8.3,' ',  &
+     &           f8.4,' ',f8.6)
+
+      ENDIF
+!                            
+! +  OUTPUT FORCINGS:  END  +++    
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! +--SISVAT EXECUTION                                                          
+! +  ----------------                                                          
+! +             
+!      write(*,*) '  Start SISVAT execution!'
+
+      call  SISVAT(SnoMod,.false.,1) 
+!                          BloMod,jjtime)
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! + RETURN RESULTS  
+! + -------------- 
+! + Return (compressed) SISVAT variables to LMDZ             
+! + 
+      DO  ikl=1,knon                  ! use only 1:knon (actual ice sheet..) 
+        runoff_lic(ikl)    = RnofSV(ikl)*dtime   ! RunOFF: intensity* time step
+        dflux_s(ikl)       = dSdTSV(ikl)         ! Sens.H.Flux T-Der. 
+        dflux_l(ikl)       = dLdTSV(ikl)         ! Latn.H.Flux T-Der. 
+        fluxsens(ikl)      = HSs_sv(ikl)         ! HS                 
+        fluxlat(ikl)       = HLs_sv(ikl)         ! HL                 
+        evap(ikl)          = HLs_sv(ikl)/RLVTT   ! Evaporation RLVTT=LhvH2O   
+        z0_new(ikl)        = Z0h_SV(ikl)         ! Moment.Roughn.L.
+
+
+        snow(ikl)          = 0.
+        snowhgt(ikl)       = 0.
+        qsnow(ikl)         = 0.
+        qsol(ikl)          = 0. 
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! +   Check snow thickness, add if too thin, substract if too thick     
+
+        sissnow(ikl)       = 0.  !()
+      DO  isn = 1,isnoSV(ikl)                                               
+        sissnow(ikl)       = sissnow(ikl)+dzsnSV(ikl,isn)* ro__SV(ikl,isn)   
+      END DO
+
+      IF (sissnow(ikl) .LE. sn_low) THEN  !add snow 
+      IF (isnoSV(ikl).GE.1) THEN
+        dzsnSV(ikl,1)      = dzsnSV(ikl,1) + sn_add/max(ro__SV(ikl,1),epsi)  
+        toicSV(ikl)        = toicSV(ikl)   - sn_add
+      ELSE
+        write(*,*) 'Attention, bare ice... point ',ikl
+        isnoSV(ikl)        = 1
+        istoSV(ikl,1)      = 100
+!ym        istoSV(ikl)     = 100
+        ro__SV(ikl,1)      = 400.      
+        dzsnSV(ikl,1)      = sn_add/max(ro__SV(ikl,1),epsi)  ! 1.
+        eta_SV(ikl,1)      = epsi
+        TsisSV(ikl,1)      = min(TsisSV(ikl,0),TfSnow-0.2)   
+        G1snSV(ikl,1)      = 99.
+        G2snSV(ikl,1)      = 0.3 
+        agsnSV(ikl,1)      = 10.    
+        toicSV(ikl)        = toicSV(ikl)   - sn_add
+      END IF
+      END IF
+
+      IF (sissnow(ikl) .ge. sn_upp) THEN  !thinnen snow layer below
+        dzsnSV(ikl,1)      = dzsnSV(ikl,1)/sn_div
+        toicSV(ikl) = toicSV(ikl)+dzsnSV(ikl,1)*ro__SV(ikl,1)/sn_div
+      END IF
+
+        sissnow(ikl)       = 0.  !()
+      DO  isn = 1,isnoSV(ikl)                                               
+        sissnow(ikl) = sissnow(ikl)+dzsnSV(ikl,isn)* ro__SV(ikl,isn)           
+! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        snowhgt(ikl) = snowhgt(ikl)+dzsnSV(ikl,isn)              
+        qsnow(ikl)   = qsnow(ikl)+1e03*eta_SV(ikl,isn)*dzsnSV(ikl,isn)   
+      END DO
+        snow(ikl)    = sissnow(ikl)+toicSV(ikl)
+        to_ice(ikl)  = toicSV(ikl)
+! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+      DO  isl =   -nsol,0    
+        tsoil(ikl,1-isl)   = TsisSV(ikl,isl)       ! Soil Temperature  
+        qsol(ikl)          = qsol(ikl)                      &    
+                       +eta_SV(ikl,isl) * dz_dSV(isl)  
+      END DO                                               
+        agesno(ikl)        = agsnSV(ikl,isnoSV(ikl))        !          [day] 
+
+        alb1(ikl)          = alb1sv(ikl)             ! Albedo VIS  
+        alb2(ikl)          = ((So1dSV-f1)*alb1sv(ikl)                   &
+     &                       +So2dSV*alb2sv(ikl)+So3dSV*alb3sv(ikl))/f1    
+                                                     ! Albedo NIR 
+        alb3(ikl)          = alb3sv(ikl)             ! Albedo FIR  
+        tsurf_new(ikl)     = TsfnSV(ikl)
+!hj220711          Tsrfsv(ikl)              ! Surf.Temperature   
+!                TsisSV(ikl,0) *(1-min(1,isnoSV(ikl))) &                   
+!                +TsisSV(ikl,max(1,isnoSV(ikl))) * min(1,isnoSV(ikl)) 
+!        tsurf_new(ikl)   = max(Ts_Min,tsurf_new(ikl) )
+!        tsurf_new(ikl)   = min(Ts_Max,tsurf_new(ikl) )
+        qsurf(ikl)         = QaT_SV(ikl) 
+        emis_new(ikl)      = eps0SL(ikl)  
+
+!!!hjp 230611 sorties
+!!        qsnow(ikl)=TsisSV(ikl,isnoSV(ikl))
+!!        sissnow(ikl)=TsisSV(ikl,isnoSV(ikl)-1)
+!!        snowhgt(ikl)=TsisSV(ikl,isnoSV(ikl)-2)
+!!        qsol(ikl)=dzsnSV(ikl,isnoSV(ikl)-1)
+!!        agesno(ikl)=dzsnSV(ikl,isnoSV(ikl))
+
+
+      END DO 
+
+
+! +  -----------------------------                              
+! +  END --- RETURN RESULTS    
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! + Uncompress SISVAT output variables & store
+! +  -----------------------------            
+! +
+!      DO  ikl = 1,knon                                                     
+!        i   = ikl2i(ikl)                             ! Compression index  
+!      IF (i.GE.0) THEN
+!        SOsoNC(i)       = SOsoKL(ikl)                ! Absorb.Sol.Rad.    
+!        IRsoNC(i)       = IRsoKL(ikl)                ! Absorb.IR  Rad.    
+!        HSsoNC(i)       = HSsoKL(ikl)                ! HS                 
+!        HLsoNC(i)       = HLsoKL(ikl)                ! HL                 
+!        HLs_NC(i)       = HLs_KL(ikl)                ! Evaporation          
+!        HLv_NC(i)       = HLv_KL(ikl)                ! Transpiration      
+!        
+!        DO isl =   -nsol,0      
+!          eta_NC(i,1-isl) = eta_SV(ikl,isl)          ! Soil Humidity      
+!          tsolNC(i,1-isl) = TsisSV(ikl,isl)          ! Soil Temperature   
+!        END DO                                                  
+!        snowNC(i)       = snow(ikl)                  ! Snow mass    
+!        isnoNC(i)       = isnoSV(ikl)                ! Nb Snow/Ice Lay.   
+!        ispiNC(i)       = ispiSV(ikl)                ! Nb Supr.Ice Lay.   
+!        iiceNC(i)       = iiceSV(ikl)                ! Nb      Ice Lay.   
+!        swaNC(i)        = rusnSV(ikl)                ! Surficial Water    
+!        swsNC(i)        = SWS_SV(ikl)                ! Surficial Wat.St.    
+!        DO  isn = 1,nsno                                                   
+!          istoNC(i,isn)   = istoSV(ikl,isn)          !            [-]     
+!          dzsnNC(i,isn)   = dzsnSV(ikl,isn)          !            [m]     
+!          rhosnNC(i,isn)  = ro__SV(ikl,isn)          !        [kg/m3]     
+!          etasnNC(i,isn)  = eta_SV(ikl,isn)          !        [m3/m3]     
+!          tsnNC(i,isn)    = TsisSV(ikl,isn)          !            [K]     
+!          g1snNC(i,isn)   = G1snSV(ikl,isn)          ! [-]        [-]     
+!          g2snNC(i,isn)   = G2snSV(ikl,isn)          ! [-] [0.0001 m]     
+!          agsnNC(i,isn)   = agsnSV(ikl,isn)          !          [day]   
+!        END DO                                                            
+!!?c #IB  depsubNC(i)    = wes_SV(ikl)                ! Depo. / Subli.     
+!        meltNC(i)       = wem_SV(ikl)                ! Melting            
+!        refrNC(i)       = wer_SV(ikl)                ! Refreezing         
+!        alb1NC(i)       = alb1sv(ikl)                ! Albedo SW  
+!        alb2NC(i)       = (alb1sv(ikl)+3*alb2sv(ikl)+alb3sv(ikl))/5  
+                                                      ! Albedo LW
+!        rnofNC(i)       = RnofSV(ikl)              ! Run OFF Intensity
+!   
+!!?        SL_z0(i)       = Z0m_SV(ikl)                 ! Moment.Roughn.L.   
+!!?        SL_r0(i,j,n)   = Z0h_SV(ikl)                 ! Heat   Roughn.L.  
+!!!        zWE_NC(i)       = zWE_SV(ikl)                ! Current  *Thick.   
+!!!        zWEcNC(i)       = zWEcSV(ikl)                ! Non-Erod.*Thick.   
+!!!        hSalNC(i)       = hSalSV(ikl)                ! Salt.Layer Height  
+!!!        hsenSL(i) = -SLuts(i,j)  *  rhAir    *cp     ! Sensible Heat Flux
+!!!        hlatSL(i) = -SLuqs(i,j)  *  rhAir    *Lv_H2O ! Latent   Heat Flux 
+!      END IF
+!      END DO   
+
+!hj + Put storage to Output file here!                                     
+      IF (lafin) THEN
+
+        fichnom = "restartsis.nc"
+        CALL sisvatredem("restartsis.nc",ikl2i,rlon,rlat)            
+        IF (ok_outfor) THEN
+          close(unit=un_outfor)                    
+        END IF
+      END IF                                                          
+! +  -----------------------------                              
+! +  END --- RETURN RESULTS    
+! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+  END SUBROUTINE surf_sisvat
+
+
+
+
+
+
+
+  SUBROUTINE get_soil_levels(dz1, dz2, lambda)
+! ======================================================================
+! Routine to compute the vertical discretization of the soil in analogy
+! to LMDZ. In LMDZ it is done in soil.F, which is not used in the case 
+! of SISVAT, therefore it's needed here.
+!
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    USE mod_phys_lmdz_para
+
+    INCLUDE "dimsoil.h"
+
+    REAL, DIMENSION(nsoilmx), INTENT(OUT) :: dz2, dz1
+    REAL, INTENT(OUT)                     :: lambda
+!$OMP THREADPRIVATE(dz1)
+
+
+!-----------------------------------------------------------------------
+!   Depthts:
+!   --------
+    REAL fz,rk,fz1,rk1,rk2
+    REAL min_period, dalph_soil
+    INTEGER ierr,jk
+
+    fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
+
+!    write(*,*)'Start soil level computation' 
+!-----------------------------------------------------------------------
+! Calculation of some constants
+! NB! These constants do not depend on the sub-surfaces
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!   ground levels 
+!   grnd=z/l where l is the skin depth of the diurnal cycle:
+!-----------------------------------------------------------------------
+
+     min_period=1800. ! en secondes
+     dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
+! !$OMP MASTER
+!     IF (is_mpi_root) THEN
+!        OPEN(99,file='soil.def',status='old',form='formatted',iostat=ierr)
+!        IF (ierr == 0) THEN ! Read file only if it exists
+!           READ(99,*) min_period
+!           READ(99,*) dalph_soil
+!           PRINT*,'Discretization for the soil model'
+!           PRINT*,'First level e-folding depth',min_period, &
+!                '   dalph',dalph_soil
+!           CLOSE(99)
+!        END IF
+!     ENDIF
+! !$OMP END MASTER
+!     CALL bcast(min_period)
+!     CALL bcast(dalph_soil)
+
+!   la premiere couche represente un dixieme de cycle diurne
+     fz1=SQRT(min_period/3.14)
+     
+     DO jk=1,nsoilmx
+        rk1=jk
+        rk2=jk-1
+        dz2(jk)=fz(rk1)-fz(rk2) 
+     ENDDO
+     DO jk=1,nsoilmx-1
+        rk1=jk+.5
+        rk2=jk-.5
+        dz1(jk)=1./(fz(rk1)-fz(rk2))
+     ENDDO
+     lambda=fz(.5)*dz1(1)
+     PRINT*,'full layers, intermediate layers (seconds)'
+     DO jk=1,nsoilmx
+        rk=jk
+        rk1=jk+.5
+        rk2=jk-.5
+        PRINT *,'fz=', &
+             fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
+     ENDDO
+
+  END SUBROUTINE get_soil_levels
+
+  SUBROUTINE SISVAT_ini(knon)                                                     
+                                                                               
+!C +------------------------------------------------------------------------+  
+!C | MAR          SISVAT_ini                             Jd 11-10-2007  MAR | 
+!C |   SubRoutine SISVAT_ini generates non time dependant SISVAT parameters |  
+!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:   dt__SV   : Time  Step                                   [s] | 
+!C |   ^^^^^    dz_dSV   : Layer Thickness                              [m] |  
+!C |                                                                        |  
+!C |   OUTPUT:  RF__SV   : Root Fraction in Layer isl                   [-] |  
+!C |   ^^^^^^   rocsSV   : Soil Contrib. to (ro c)_s exclud.Water  [J/kg/K] |  
+!C |            etamSV   : Soil Minimum Humidity                    [m3/m3] |  
+!C |                      (based on a prescribed Soil Relative Humidity)    |  
+!C |            s1__SV   : Factor of eta**( b+2) in Hydraul.Diffusiv.       |  
+!C |            s2__SV   : Factor of eta**( b+2) in Hydraul.Conduct.        |  
+!C |            aKdtSV   : KHyd: Piecewise Linear Profile:  a * dt    [m]   |  
+!C |            bKdtSV   : KHyd: Piecewise Linear Profile:  b * dt    [m/s] |  
+!C |            dzsnSV(0): Soil first Layer Thickness                   [m] |  
+!C |            dzmiSV   : Distance between two contiguous levels       [m] |  
+!C |            dz78SV   : 7/8 (Layer Thickness)                        [m] | 
+!C |            dz34SV   : 3/4 (Layer Thickness)                        [m] | 
+!C |            dz_8SV   : 1/8 (Layer Thickness)                        [m] | 
+!C |            dzAvSV   : 1/8  dz_(i-1) + 3/4 dz_(i) + 1/8 dz_(i+1)    [m] | 
+!C |            dtz_SV   : dt/dz                                      [s/m] | 
+!C |            OcndSV   : Swab Ocean / Soil Ratio                      [-] |
+!C |            Implic   : Implicit Parameter  (0.5:  Crank-Nicholson)      |  
+!C |            Explic   : Explicit Parameter = 1.0 - Implic                |  
+!C |                                                                        | 
+!C | # OPTIONS: #ER: Richards Equation is not smoothed                      |
+!C | # ^^^^^^^  #kd: De Ridder   Discretization                             |
+!C | #          #SH: Hapex-Sahel Values                                     !  
+!C |                                                                        | 
+!C +------------------------------------------------------------------------+  
+!                                                                              
+!                                                                             
+                                                                              
+!C +--Global Variables                                                         
+!C +  ================         
+
+      USE VARphy, ra_earth=>ra                                           
+      USE VAR_SV                                                     
+      USE VARdSV                                                         
+      USE VAR0SV                                                           
+      USE VARxSV
+      USE VARtSV
+      USE VARxSV
+      USE VARySV
+      IMPLICIT NONE                                                           
+                                                                              
+                                                                              
+                                                                              
+!C +--Arguments                                                     
+!C +  ==================                                                      
+       INTEGER,INTENT(IN) ::  knon                                       
+
+!C +--Internal Variables                                                     
+!C +  ==================                                                      
+                                                                               
+      INTEGER ::  ivt   ,ist   ,ivg   ,ikl   ,isl   ,isn   ,ikh               
+      INTEGER ::  misl_2,nisl_2                                              
+      REAL    ::  zDepth                                                       
+      REAL    ::  d__eta,eta__1,eta__2,Khyd_1,Khyd_2                           
+      REAL,PARAMETER  ::  RHsMin=  0.001        ! Min.Soil Relative Humidity   
+      REAL    ::  PsiMax                        ! Max.Soil Water    Potential 
+      REAL    ::  a_Khyd,b_Khyd                 ! Piecewis.Water Conductivity 
+
+
+!c #WR REAL    ::  Khyd_x,Khyd_y                                               
+                                                                              
+                                                                              
+                                                                 
+!C +--Non Time Dependant SISVAT parameters                                    
+!C +  ====================================                                
+                                                                              
+!C +--Soil Discretization                                                     
+!C +  -------------------                                                     
+                                                                              
+!C +--Numerical Scheme Parameters                                             
+!C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^                                             
+        Implic = 0.75                           ! 0.5  <==> Crank-Nicholson  
+        Explic = 1.00 - Implic                  !                            
+                                                                             
+!C +--Soil/Snow Layers Indices                                                
+!C +  ^^^^^^^^^^^^^^^^^^^^^^^^                                                
+      DO  isl=-nsol,0                                                          
+        islpSV(isl) =           isl+1                                         
+        islpSV(isl) = min(      islpSV(isl),0)                                
+        islmSV(isl) =           isl-1                                         
+        islmSV(isl) = max(-nsol,islmSV(isl))                                 
+      END DO                                                                  
+                                                                               
+      DO  isn=1,nsno                                                           
+        isnpSV(isn) =           isn+1                                          
+        isnpSV(isn) = min(      isnpSV(isn),nsno)                            
+      END DO                                                                 
+                                                                              
+!C +--Soil      Layers Thicknesses                                             
+!C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^  
+! Not used here as LMDZ method is applied, see SUBROUTINE get_soil_levels!    
+!c #kd IF (nsol.gt.4)                                              THEN        
+!c #kd   DO isl=-5,-nsol,-1                                                    
+!c #kd     dz_dSV(isl)=   1.                                                  
+!c #kd   END DO                                                                
+!c #kd END IF                                                                 
+!                                                                             
+!      IF (nsol.ne.4)                                              THEN        
+!        DO isl= 0,-nsol,-1                                                   
+!          misl_2 =     -mod(isl,2)                                          
+!          nisl_2 =         -isl/2                                            
+!          dz_dSV(isl)=(((1-misl_2) * 0.001                                   
+!     .                  +  misl_2  * 0.003) * 10**(nisl_2)) * 4.             
+!C +...    dz_dSV(0)  =         Hapex-Sahel Calibration:       4 mm            
+!                                                                             
+!c +SH     dz_dSV(isl)=(((1-misl_2) * 0.001                                   
+!c +SH.                  +  misl_2  * 0.003) * 10**(nisl_2)) * 1.              
+!                                                                             
+!c #05     dz_dSV(isl)=(((1-misl_2) * 0.001                                    
+!c #05.                  +  misl_2  * 0.008) * 10**(nisl_2)) * 0.5             
+!        END DO                                                                
+!          dz_dSV(0)  =               0.001                                    
+!          dz_dSV(-1) = dz_dSV(-1)  - dz_dSV(0)              + 0.004         
+!      END IF                                                                 
+                                                                               
+        zz_dSV      = 0.                                                      
+      DO  isl=-nsol,0                                                        
+        dzmiSV(isl) = 0.500*(dz_dSV(isl)        +dz_dSV(islmSV(isl)))        
+        dziiSV(isl) = 0.500* dz_dSV(isl)        /dzmiSV(isl)                  
+        dzi_SV(isl) = 0.500* dz_dSV(islmSV(isl))/dzmiSV(isl)                   
+        dtz_SV(isl) =        dt__SV             /dz_dSV(isl)                  
+        dz78SV(isl) = 0.875* dz_dSV(isl)                                      
+        dz34SV(isl) = 0.750* dz_dSV(isl)                                      
+        dz_8SV(isl) = 0.125* dz_dSV(isl)                                       
+        dzAvSV(isl) = 0.125* dz_dSV(islmSV(isl))                        &
+     &              + 0.750* dz_dSV(isl)                                &
+     &              + 0.125* dz_dSV(islpSV(isl))                          
+!c #ER   dz78SV(isl) =        dz_dSV(isl)                                     
+!c #ER   dz34SV(isl) =        dz_dSV(isl)                                      
+!c #ER   dz_8SV(isl) = 0.                                                      
+!c #ER   dzAvSV(isl) =        dz_dSV(isl)                                      
+        zz_dSV      = zz_dSV+dz_dSV(isl)                                      
+      END DO                                                                  
+      DO ikl=1,knon !v                                                          
+        dzsnSV(ikl,0) =      dz_dSV(0)                                        
+      END DO                                                                  
+                                                                              
+!C +--Conversion to a 50 m Swab Ocean Discretization                           
+!C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                           
+        OcndSV = 0.                                                           
+      DO isl=-nsol,0                                                          
+        OcndSV = OcndSV +dz_dSV(isl)                                           
+      END DO                                                                   
+        OcndSV = 50.    /OcndSV                                                
+                                                                               
+                                                                               
+!C +--Secondary Vegetation Parameters                                          
+!C +  -------------------------------                                          
+!                                                                              
+!C +--Minimum Stomatal Resistance (Hapex Sahel Data)                           
+!C +  (Taylor et al. 1997, J.Hydrol 188-189, p.1047)                           
+!C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                           
+!c #SH DO ivg=1,3                       !                                     
+!c #SH   StodSV(ivg) = 210.             ! Millet                               
+!c #SH END DO                           !                                      
+!c #SH   StodSV(  4) = 120.             ! Sparse Tiger Bush                    
+!c #SH DO ivg=5,6                       !                                     
+!c #SH   StodSV(ivg) =  80.             ! Dense  Tiger Bush                   
+!c #SH END DO                           !                                     
+!c #SH   StodSV(  7) =  80.             ! Low    Trees (Fallow)               
+!c #SH   StodSV( 10) =  80.             !                                     
+!                                                                             
+!C +--Minimum Stomatal Resistance (Tropical Forest)                          
+!C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                           
+!c #SH   StodSV(  8) =  60.             ! Medium Trees                        
+!c #SH   StodSV( 11) =  60.             !                                     
+!c #SH   StodSV(  9) =  40.             ! High   Trees                        
+!c #SH   StodSV( 12) =  40.             !                                     
+                                                                              
+!C +--Root Fraction                                                           
+!C +  ^^^^^^^^^^^^^                                                          
+!C +  * GENERAL REFERENCE                                                     
+!C +    Jackson et al., 1996: A global analysis of root distributions for     
+!C +    terrestrial biomes. In Oecologia, 108, 389-411.                       
+                                                                             
+!C +  * ROOT PROFILE                                                           
+!C +    The cumulative root fraction Y is given by                             
+!C +        Y = 1 - beta**d   with d    the depth (in cm),                    
+!C +                               beta a coefficient (vegetation dependent).
+                                                                             
+!C +  * BETA VALUES (for 11 world biomes)                                      
+!C +  1  boreal forest                0.943                                    
+!C +  2  crops                        0.961                                    
+!C +  3  desert                       0.975                                   
+!C +  4  sclerophyllous shrubs        0.964                                   
+!C +  5  temperate coniferous forest  0.976                                   
+!C +  6  temperate deciduous forest   0.966                                   
+!C +  7  temperate grassland          0.943                                    
+!C +  8  tropical deciduous forest    0.961                                    
+!C +  9  tropical evergreen forest    0.962                                   
+!C +  10 tropical grassland savanna   0.972                                    
+!C +  11 tundra                       0.914                                   
+!                                                                              
+!C +  * ADVISED BETA VALUES FOR MAR                                           
+!C +    (see 'block data SISVAT_dat', variable rbtdSV)                         
+!C +                                                                           
+!C +    SVAT veg. type         default      West Africa                        
+!C +    0  barren soil         0.000        0.000                              
+!C +    1  crops low           0.961 (2)    0.961 (2)                          
+!C +    2  crops medium        0.961 (2)    0.961 (2)                          
+!C +    3  crops high          0.961 (2)    0.961 (2)                          
+!C +    4  grass low           0.943 (7)    0.943 (7)                          
+!C +    5  grass medium        0.943 (7)    0.964 (4)                         
+!C +    6  grass high          0.943 (7)    0.972 (10)                        
+!C +    7  broadleaf low       0.966 (6)    0.968 (4,10)                      
+!C +    8  broadleaf medium    0.966 (6)    0.962 (8,9)                       
+!C +    9  broadleaf high      0.966 (6)    0.962 (8,9)                        
+!C +    10 needleleaf low      0.976 (5)    0.971 (5,6)                       
+!C +    11 needleleaf medium   0.976 (5)    0.976 (5)                         
+!C +    12 needleleaf high     0.976 (5)    0.976 (5)                          
+                                                                             
+!C +    Numbers between brackets refer to Jackson's biomes. For more details  
+!C +    about some choices, see the correspondance between the IGBP and SVAT   
+!C +    vegetation classes (i.e. in NESTOR).                                 
+                                                                              
+!C +  * WARNING                                                                
+!C +    Most of the roots are located in the first 2 m of soil. The root       
+!C +    fraction per layer depends on the definition of the soil layer         
+!C +    thickness. It will get wrong if a thick layer is defined around 2 m    
+!C +    deep.                                                                  
+                                                                               
+      write(*,'(/a)') 'ROOT PROFILES (Jackson, 1996) :'                        
+                                                                              
+      DO ivt = 0, nvgt                                                        
+        zDepth = 0.                                                           
+        DO isl = 0, -nsol, -1                                                 
+          IF (ivt .ne. 0) THEN                                                
+            RF__SV(ivt,isl) =  rbtdSV(ivt)**zDepth *                     &
+     &                         (1. - rbtdSV(ivt)**(dz_dSV(isl)*100) )        
+            zDepth = zDepth + dz_dSV(isl)*100  !in cm                        
+          ELSE                                                                 
+            RF__SV(ivt,isl) = 0.                                              
+          END IF                                                              
+        END DO                                                                
+        write(*,'(a,i2,a,i3,a,99f10.5:)')                                &
+     &       '  RF__SV(', ivt, ',', -nsol, ':0) =', RF__SV(ivt,:)            
+      END DO                                                                  
+!      write(6, format(                                                  &
+!     &  '  NOTE: If root fraction is not close to 0  around 2 m deep,', &
+!     &/,'        Then you should redefine the soil layer thicknesses.', &
+!     &/,'        See the code for more details.'))                         
+                                                                              
+                                                                               
+!C +--Secondary Soil       Parameters                                          
+!C +  -------------------------------                                         
+                                                                               
+      DO  ist=0,nsot                                                           
+         rocsSV(ist)=(1.0-etadSV(ist))*1.2E+6  ! Soil Contrib. to (ro c)_s    
+         s1__SV(ist)=     bCHdSV(ist)          & ! Factor of (eta)**(b+2)     
+     &  *psidSV(ist)     *Ks_dSV(ist)          & !    in DR97, Eqn.(3.36)     
+     & /(etadSV(ist)**(   bCHdSV(ist)+3.))     !                              
+         s2__SV(ist)=     Ks_dSV(ist)          & ! Factor of (eta)**(2b+3)     
+     & /(etadSV(ist)**(2.*bCHdSV(ist)+3.))     !    in DR97, Eqn.(3.35)       
+                                                                             
+!C +--Soil Minimum Humidity (from a prescribed minimum relative Humidity)     
+!C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^    
+         Psimax = -(log(RHsMin))/7.2E-5        ! DR97, Eqn 3.15 Inversion   
+         etamSV(ist) =  etadSV(ist)                                      &
+     &         *(PsiMax/psidSV(ist))**(-min(10.,1./bCHdSV(ist)))             
+      END DO                                                                  
+         etamSV(12)  =  0.                                                   
+                                                                             
+!C +--Piecewise Hydraulic Conductivity Profiles                               
+!C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                               
+      DO   ist=0,nsot                                                          
+!c #WR      write(6, format(' Type |    etaSat | No |    eta__1 |    eta__2 |', &
+!c #WR&           '    Khyd_1 |    Khyd_x |    Khyd_2 |    Khyd_y |'        &
+!c #WR&         /,' -----+-----------+----+-----------+-----------+',       &
+!c #WR&           '-----------+-----------+-----------+-----------+'))        
+                                                                             
+          d__eta          =  etadSV(ist)/nkhy                                 
+          eta__1          =  0.                                              
+          eta__2          =  d__eta                                           
+        DO ikh=0,nkhy                                                         
+          Khyd_1          =  s2__SV(ist)             & ! DR97, Eqn.(3.35)      
+     &  *(eta__1      **(2. *bCHdSV(ist)+3.))        !                       
+          Khyd_2          =  s2__SV(ist)             &!                       
+     &  *(eta__2      **(2. *bCHdSV(ist)+3.))        !                       
+                                                                             
+          a_Khyd          = (Khyd_2-Khyd_1)/d__eta   !                       
+          b_Khyd          =  Khyd_1-a_Khyd *eta__1   !                       
+!c #WR     Khyd_x          =  a_Khyd*eta__1 +b_Khyd   !                       
+!c #WR     Khyd_y          =  a_Khyd*eta__2 +b_Khyd   !                       
+          aKdtSV(ist,ikh) =  a_Khyd       * dt__SV   !                       
+          bKdtSV(ist,ikh) =  b_Khyd       * dt__SV   !                         
+!c #WR     write(6,format(i5,' |',e10.2,' |',i3,' |', 6(e10.2,' |'))      & 
+!c #WR&           ist,etadSV(ist),ikh,eta__1,                             &
+!c #WR&          eta__2,Khyd_1,Khyd_x,Khyd_2,Khyd_y                       
+                                                                          
+          eta__1          = eta__1  + d__eta                              
+          eta__2          = eta__2  + d__eta                              
+        END DO                                                             
+      END DO                                                               
+
+
+!c
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! + INITIALISATION: ARRAYS on grid  +++ 
+! + -----------------------------------
+! +                                                      
+        DO ikl=1,knon                                
+
+! + Water Fluxes, roughness length  
+          us__SV(ikl) = 0.25                             ! Frict. Velocity  
+                                      ! (approx ETH-Camp Lefebre etal CD 2005
+          uts_SV(ikl) = 1.                               ! u*T*  arbitrary  
+          uqs_SV(ikl) = 0.25 ! turb_vel(ikl,3)           ! u*q*    " 
+          uss_SV(ikl) = 0.25 ! turb_vel(ikl,4)           ! u*s*    "
+!!c #AE   usthSV(ikl) = 0. 
+          Z0h_SV(ikl) = 0. ! rlength(ikl,9)
+          Z0m_SV(ikl) = 0.                               ! Moment.Roughn.L.  
+          Z0h_SV(ikl) = 0.                               ! Heat   Roughn.L.  
+!!c #OR   Z0roSV(ikl) = 0.                               ! Orogr. Roughn.L.
+          LMO_SV(ikl) = 0.
+          VVs_SV(ikl) = 0.
+          RRs_SV(ikl) = 0.
+          DDs_SV(ikl) = 0.
+
+! + Snow
+          isnoSV(ikl) = 0                        ! # snow layers 
+          BufsSV(ikl) = 0.    
+          zzsnsv(ikl,:) = 0.                         ! Snow pack thickness
+          qsnoSV(ikl) = 0.                        ! BL snow content  
+          zWEcSV(ikl) = 0.
+          dbs_SV(ikl) = 0.
+          dsnbSV(ikl) = 0.
+          esnbSV(ikl) = 0.
+          BrosSV(ikl) = 0.
+          BG1sSV(ikl) = 0.          
+          BG2sSV(ikl) = 0.
+          SWS_SV(ikl) = 0.
+          RnofSV(ikl) = 0.                             ! RunOFF Intensity 
+          toicSV(ikl) = 0.         !hj preli
+! + Clouds !hj1602
+          cld_SV(ikl) = 0.            
+
+! + Vegetation
+          LSmask(ikl) = 1                          ! Land/Sea   Mask    
+          isotSV(ikl) = 12                         ! Soil       Type    
+          iWaFSV(ikl) = 1                          ! Soil Drainage          
+          Rootsv(ikl,:) = 0.
+          ivgtSV(ikl) = 0                          ! Vegetation Type    
+          LAI0SV(ikl) = 0                          ! LAI                
+          glf0SV(ikl) = 0                          ! Green Leaf Frac.
+!          TVegSV(ikl) = 0. 
+          SnCaSV(ikl) = 0. 
+          rrCaSV(ikl) = 0. 
+          pSivSV(ikl) = 0. 
+
+! + z0(Sastrugi)                                        
+! #SZ     Z0SaSL(ikl) = 0.                                           
+! #ZM   DO nt=1,ntavSL                                                      
+! #ZM     SLn_z0(ikl,nt) = 0.5e-6                                       
+! #ZM     SLn_b0(ikl,nt) = 0.5e-6                                       
+! #ZM     SLn_r0(ikl,nt) = 0.5e-6                                       
+! #ZM   END DO 
+
+
+! +--z0(Orography Roughness)                                 
+! #OR     SL_z0 (ikl) = min(SL_z0 (ikl),zsigma/3.)                    
+! #OR     SLzoro(ikl) = min(SLzoro(ikl),zsigma/3.)                    
+
+! +--SBL  Characteristics                                                          
+! #AA   DO nt=  1,ntaver                                                     
+! #AW     V_0aSL(ikl,nt)  = ssvSL(ikl)    
+! #AH     dT0aSL(ikl,nt)  = temp_air(ikl)-tsurf(ikl)                     
+! #AA   END DO                                                               
+
+
+        END DO
+
+
+                                                                           
+      return                                                               
+
+  END SUBROUTINE SISVAT_ini
+
+
+
+
+
+
+
+!***************************************************************************
+
+    SUBROUTINE sisvatetat0 (fichnom,ikl2i)
+
+    USE dimphy
+    USE mod_grid_phy_lmdz
+    USE mod_phys_lmdz_para
+
+    USE iostart
+    USE VAR_SV
+    USE VARdSV
+    USE VARxSV          
+    USE VARtSV
+    USE control_mod
+    USE indice_sol_mod
+
+      IMPLICIT none
+!======================================================================
+! Auteur(s) HJ PUNGE (LSCE) date: 07/2009
+! Objet: Ecriture de l'etat de redemarrage pour SISVAT
+!======================================================================
+    include "netcdf.inc"
+!    include "indicesol.h"
+
+    include "dimsoil.h"
+    include "clesphys.h"
+    include "temps.h"
+    include "thermcell.h"
+    include "compbl.h"
+
+!======================================================================
+    CHARACTER(LEN=*) :: fichnom
+
+
+    INTEGER, DIMENSION(klon), INTENT(IN) :: ikl2i
+    REAL, DIMENSION(klon) :: rlon
+    REAL, DIMENSION(klon) :: rlat
+
+! les variables globales ecrites dans le fichier restart
+    REAL, DIMENSION(klon) :: isno
+    REAL, DIMENSION(klon) :: ispi
+    REAL, DIMENSION(klon) :: iice
+    REAL, DIMENSION(klon) :: rusn 
+    REAL, DIMENSION(klon, nsno) :: isto
+
+    REAL, DIMENSION(klon, nsismx) :: Tsis
+    REAL, DIMENSION(klon, nsismx) :: eta
+    REAL, DIMENSION(klon, nsismx) :: ro 
+
+    REAL, DIMENSION(klon, nsno) :: dzsn      
+    REAL, DIMENSION(klon, nsno) :: G1sn
+    REAL, DIMENSION(klon, nsno) :: G2sn
+    REAL, DIMENSION(klon, nsno) :: agsn
+
+    REAL, DIMENSION(klon) :: toic
+
+!    REAL, DIMENSION(klon) :: IRs
+!    REAL, DIMENSION(klon) :: LMO
+!    REAL, DIMENSION(klon) :: Bufs
+!    REAL, DIMENSION(klon, 9) :: rlength
+!    REAL, DIMENSION(klon, 5) :: turb_vel
+
+    INTEGER  :: isl, ikl, i, isn , errT, erreta, errro, errdz, snopts
+    CHARACTER (len=2) :: str2
+    LOGICAL :: found
+  
+    errT=0
+    errro=0
+    erreta=0
+    errdz=0
+    snopts=0
+! Ouvrir le fichier contenant l'etat initial:
+
+    CALL open_startphy(fichnom)
+
+! Lecture des latitudes, longitudes (coordonnees):
+
+      CALL get_field("latitude",rlat,found)
+      CALL get_field("longitude",rlon,found)
+
+      CALL get_field("n_snows", isno,found)
+      IF (.NOT. found) THEN
+        PRINT*, 'phyetat0: Le champ <n_snows> est absent'
+        PRINT *, 'fichier startsisvat non compatible avec sisvatetat0'
+      ENDIF
+
+      CALL get_field("n_ice_top",ispi,found)
+      CALL get_field("n_ice",iice,found)
+      CALL get_field("surf_water",rusn,found)
+!      IF (.NOT. found) THEN
+!        PRINT*, 'phyetat0: Le champ <surf_water> est absent'
+!        rusn(:)=0.  
+!      ENDIF
+
+
+      CALL get_field("to_ice",toic,found)
+      IF (.NOT. found) THEN
+        PRINT*, 'phyetat0: Le champ <to_ice> est absent'
+        toic(:)=0.  
+      ENDIF
+
+
+!      CALL get_field("IR_soil",IRs,found)
+!      CALL get_field("LMO",LMO,found)
+!      CALL get_field("snow_buffer",Bufs,found)
+!      DO i = 1, 5
+!            WRITE(str2,'(i2.2)') i
+!            CALL get_field("turb_veloc"//str2, &
+!                          turb_vel(:,i),found)
+!      ENDDO
+!      DO i = 1, 9
+!            WRITE(str2,'(i2.2)') i
+!            CALL get_field("rough_length"//str2, &
+!                          rlength(:,i),found)
+!      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("AGESNOW"//str2, &
+                          agsn(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("DZSNOW"//str2, &
+                          dzsn(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("G2SNOW"//str2, &
+                          G2sn(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("G1SNOW"//str2, &
+                          G1sn(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsismx
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("ETA"//str2, &
+                          eta(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsismx
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("RO"//str2, &
+                          ro(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsismx
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("TSS"//str2, &
+                          Tsis(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL get_field("HISTORY"//str2, &
+                          isto(:,isn),found)
+        ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+        ENDIF
+      ENDDO
+      write(*,*)'Read ',fichnom,' finished!!'
+
+!*********************************************************************************
+! Compress restart file variables for SISVAT
+
+
+      isnoSV(:)        = 0       
+      ispiSV(:)        = 0 
+      iiceSV(:)        = 0                                
+       
+      eta_SV(:,1:nsno) = 0.     
+      TsisSV(:,1:nsno) = 0.         
+      istoSV(:,:)      = 0 
+      ro__SV(:,1:nsno) = 0.        
+      G1snSV(:,:)      = 0.    
+      G2snSV(:,:)      = 0. 
+      dzsnSV(:,1:nsno) = 0.        
+      agsnSV(:,:)      = 0.
+      rusnSV(:)        = 0.   
+      toicSV(:)        = 0.
+
+      DO  ikl = 1,klon                                                   
+          i   = ikl2i(ikl)   
+          IF (i > 0) THEN
+              isnoSV(ikl)     = INT(isno(i))          ! Nb Snow/Ice Lay.   
+              ispiSV(ikl)     = INT(ispi(i))          ! Nb Supr.Ice Lay.  
+              iiceSV(ikl)     = INT(iice(i))          ! Nb      Ice Lay.   
+                                                                              
+!!              IRs_SV(ikl)     = IRs(i)
+!              LMO_SV(ikl)     = LMO(i)               !?              
+!              us__SV(ikl)     = turb_vel(i,1)        
+!              uts_SV(ikl)     = turb_vel(i,2)
+!              uqs_SV(ikl)     = turb_vel(i,3) 
+!              uss_SV(ikl)     = turb_vel(i,4) 
+!              usthSV(ikl)     = turb_vel(i,5)
+!              Z0m_SV(ikl)     = rlength(i,1)         ! Moment.Roughn.L. 
+!              Z0mmSV(ikl)     = rlength(i,2)         ! Moment.Roughn.L.   
+!              Z0mnSV(ikl)     = rlength(i,3)         ! Moment.Roughn.L.   
+!              Z0SaSV(ikl)     = rlength(i,4)         ! Moment.Roughn.L.   
+!              Z0e_SV(ikl)     = rlength(i,5)         ! Moment.Roughn.L.   
+!              Z0emSV(ikl)     = rlength(i,6)         ! Moment.Roughn.L.   
+!              Z0enSV(ikl)     = rlength(i,7)         ! Moment.Roughn.L.   
+!              Z0roSV(ikl)     = rlength(i,8)         ! Moment.Roughn.L.   
+!!              Z0h_SV(ikl)     = rlength(i,9)         ! Moment.Roughn.L.   
+
+            DO isl =   -nsol,0    
+              ro__SV(ikl,isl) = ro(i,nsno+1-isl)       !                    
+              eta_SV(ikl,isl) = eta(i,nsno+1-isl)         ! Soil Humidity      
+!hjp 15/10/2010
+              IF (eta_SV(ikl,isl) <= 1.e-6) THEN          !hj check
+                eta_SV(ikl,isl) = 1.e-6
+              ENDIF
+              TsisSV(ikl,isl) = Tsis(i,nsno+1-isl)        ! Soil Temperature  
+              IF (TsisSV(ikl,isl) <= 1.) THEN          !hj check
+!                errT=errT+1
+                TsisSV(ikl,isl) = 273.15
+              ENDIF
+
+            END DO        
+            write(*,*)'Copy histo', ikl
+
+ 
+              istoSV(ikl,0) = 0                     ! Snow     History 
+
+              G1snSV(ikl,0) = 0.5                   !      [-]     
+              G2snSV(ikl,0) = 3.                    ! [-] [0.0001 m] 
+              dzsnSV(ikl,0) = dz_dSV(0)             !            [m] 
+              agsnSV(ikl,0) = 0.                    !          [day]     
+   
+            DO  isn = 1,isnoSV(ikl) !nsno      
+              snopts=snopts+1 
+              IF (isto(i,isn) > 10.) THEN          !hj check
+                write(*,*)'Irregular isto',ikl,i,isn,isto(i,isn)
+                isto(i,isn) = 1.
+              ENDIF
+
+              istoSV(ikl,isn) = INT(isto(i,isn))     ! Snow     History 
+              ro__SV(ikl,isn) = ro(i,isn)            !        [kg/m3]     
+              eta_SV(ikl,isn) = eta(i,isn)           !        [m3/m3]  
+              TsisSV(ikl,isn) = Tsis(i,isn)          !            [K]  
+
+             IF (TsisSV(ikl,isn) <= 1.) THEN          !hj check
+              errT=errT+1
+              TsisSV(ikl,isn) = TsisSV(ikl,0)
+             ENDIF  
+             IF (TsisSV(ikl,isn) <= 1.) THEN          !hj check
+              TsisSV(ikl,isn) = 263.15
+             ENDIF
+             IF (eta_SV(ikl,isn) < 1.e-9) THEN          !hj check
+              eta_SV(ikl,isn) = 1.e-6  
+              erreta=erreta+1
+             ENDIF  
+             IF (ro__SV(ikl,isn) <= 10.) THEN          !hj check
+              ro__SV(ikl,isn) = 11.
+              errro=errro+1
+             ENDIF 
+              write(*,*)ikl,i,isn,Tsis(i,isn),G1sn(i,isn)
+              G1snSV(ikl,isn) = G1sn(i,isn)          ! [-]        [-]     
+              G2snSV(ikl,isn) = G2sn(i,isn)          ! [-] [0.0001 m] 
+              dzsnSV(ikl,isn) = dzsn(i,isn)          !            [m] 
+!             IF (dzsnSV(ikl,isn) < 5.e-6) THEN          !hj check
+!              dzsnSV(ikl,isn) = 0.000005
+!              errdz=errdz+1
+!             ENDIF         
+              agsnSV(ikl,isn) = agsn(i,isn)          !          [day]     
+            END DO  
+              rusnSV(ikl)     = rusn(i)              ! Surficial Water    
+              toicSV(ikl)     = toic(i)              ! bilan snow to ice   
+!!              BufsSV(ikl)     = Bufs(i)    
+          END IF                       
+        END DO    
+!        write(*,*)snopts,'snow pts',errT,' T errors,',errro,'ro,'
+!        write(*,*)'   ',erreta,'eta,',errdz,'dz' 
+    END SUBROUTINE sisvatetat0
+
+
+
+
+    SUBROUTINE sisvatredem (fichnom,ikl2i,rlon,rlat)
+!======================================================================
+! Auteur(s) HJ PUNGE (LSCE) date: 07/2009
+! Objet: Ecriture de l'etat de redemarrage pour SISVAT
+!======================================================================
+    USE mod_grid_phy_lmdz
+    USE mod_phys_lmdz_para
+    USE iostart
+    USE VAR_SV
+    USE VARxSV          
+    USE VARySV !hj tmp 12 03 2010
+    USE VARtSV
+    USE control_mod
+    USE indice_sol_mod
+
+    IMPLICIT none
+
+    include "netcdf.inc"
+!    include "indicesol.h" 
+    include "dimsoil.h"
+    include "clesphys.h" 
+    include "temps.h"
+    include "thermcell.h"
+    include "compbl.h"
+
+!======================================================================
+
+    CHARACTER(LEN=*) :: fichnom
+    INTEGER, DIMENSION(klon), INTENT(IN) :: ikl2i
+    REAL, DIMENSION(klon), INTENT(IN) :: rlon
+    REAL, DIMENSION(klon), INTENT(IN) :: rlat
+
+! les variables globales ecrites dans le fichier restart
+    REAL, DIMENSION(klon) :: isno
+    REAL, DIMENSION(klon) :: ispi
+    REAL, DIMENSION(klon) :: iice
+    REAL, DIMENSION(klon, nsnowmx) :: isto
+
+    REAL, DIMENSION(klon, nsismx) :: Tsis
+    REAL, DIMENSION(klon, nsismx) :: eta
+    REAL, DIMENSION(klon, nsnowmx) :: dzsn
+    REAL, DIMENSION(klon, nsismx) :: ro        
+    REAL, DIMENSION(klon, nsnowmx) :: G1sn
+    REAL, DIMENSION(klon, nsnowmx) :: G2sn
+    REAL, DIMENSION(klon, nsnowmx) :: agsn
+    REAL, DIMENSION(klon) :: IRs
+    REAL, DIMENSION(klon) :: LMO
+    REAL, DIMENSION(klon) :: rusn 
+    REAL, DIMENSION(klon) :: toic
+    REAL, DIMENSION(klon) :: Bufs
+    REAL, DIMENSION(klon) :: alb1,alb2,alb3
+    REAL, DIMENSION(klon, 9) :: rlength
+    REAL, DIMENSION(klon, 5) :: turb_vel
+
+    INTEGER isl, ikl, i, isn
+    CHARACTER (len=2) :: str2
+
+      isno(:)       = 0       
+      ispi(:)       = 0 
+      iice(:)       = 0                                
+      IRs(:)        = 0.
+      LMO(:)        = 0.                             
+      turb_vel(:,:) = 0.
+      rlength(:,:)  = 0.                                  
+      eta(:,:)      = 0.     
+      Tsis(:,:)     = 0.         
+      isto(:,:)     = 0 
+      ro(:,:)       = 0.        
+      G1sn(:,:)     = 0.    
+      G2sn(:,:)     = 0. 
+      dzsn(:,:)     = 0.        
+      agsn(:,:)     = 0. 
+      rusn(:)       = 0.   
+      toic(:)       = 0.   
+      Bufs(:)       = 0.   
+      alb1(:)       = 0.
+      alb2(:)       = 0.
+      alb3(:)       = 0.
+
+!***************************************************************************
+! Uncompress SISVAT output variables for storage
+           
+      DO  ikl = 1,klon                                                   
+        i   = ikl2i(ikl)
+      IF (i > 0) THEN
+        isno(i)       = 1.*isnoSV(ikl)               ! Nb Snow/Ice Lay.   
+        ispi(i)       = 1.*ispiSV(ikl)               ! Nb Supr.Ice Lay.   
+        iice(i)       = 1.*iiceSV(ikl)               ! Nb      Ice Lay.       
+   
+!        IRs(i)        = IRs_SV(ikl)
+!        LMO(i)        = LMO_SV(ikl)                             
+!        turb_vel(i,1) = us__SV(ikl) 
+!        turb_vel(i,2) = uts_SV(ikl) 
+!        turb_vel(i,3) = uqs_SV(ikl) 
+!        turb_vel(i,4) = uss_SV(ikl) 
+!        turb_vel(i,5) = usthSV(ikl) 
+!        rlength(i,1)  = Z0m_SV(ikl)                  ! Moment.Roughn.L. 
+!        rlength(i,2)  = Z0mmSV(ikl)                  !  
+!        rlength(i,3)  = Z0mnSV(ikl)                  !  
+!        rlength(i,4)  = Z0SaSV(ikl)                  !   
+!        rlength(i,5)  = Z0e_SV(ikl)                  !    
+!        rlength(i,6)  = Z0emSV(ikl)                  !   
+!        rlength(i,7)  = Z0enSV(ikl)                  !    
+!        rlength(i,8)  = Z0roSV(ikl)                  !   
+!        rlength(i,9)  = Z0h_SV(ikl)                  !    
+
+        DO isl =   -nsol,0                           !                    
+          eta(i,nsno+1-isl)  = eta_SV(ikl,isl)            ! Soil Humidity      
+          Tsis(i,nsno+1-isl) = TsisSV(ikl,isl)            ! Soil Temperature   
+          ro(i,nsno+1-isl)   = ro__SV(ikl,isl)            !        [kg/m3]    
+        END DO        
+ 
+  
+        DO  isn = 1,nsno              
+          isto(i,isn)   = 1.*istoSV(ikl,isn)         ! Snow     History 
+          ro(i,isn)     = ro__SV(ikl,isn)            !        [kg/m3]     
+          eta(i,isn)    = eta_SV(ikl,isn)            !        [m3/m3]  
+          Tsis(i,isn)   = TsisSV(ikl,isn)            !            [K]    
+          G1sn(i,isn)   = G1snSV(ikl,isn)            ! [-]        [-]     
+          G2sn(i,isn)   = G2snSV(ikl,isn)            ! [-] [0.0001 m] 
+          dzsn(i,isn)   = dzsnSV(ikl,isn)            !            [m]         
+          agsn(i,isn)   = agsnSV(ikl,isn)            !          [day]     
+        END DO  
+        rusn(i)       = rusnSV(ikl)                  ! Surficial Water  
+        toic(i)       = toicSV(ikl)                  ! Surficial Water  
+        alb1(i)       = alb1sv(ikl) 
+        alb2(i)       = alb2sv(ikl)
+        alb3(i)       = alb3sv(ikl)
+!        Bufs(i)       = BufsSV(ikl)      
+      END IF                     
+      END DO                                                
+
+      CALL open_restartphy(fichnom)
+      CALL put_field("longitude", &
+                    "Longitudes de la grille physique",rlon)     
+      CALL put_field("latitude","Latitudes de la grille physique",rlat)
+
+      CALL put_field("n_snows", "number of snow/ice layers",isno)
+      CALL put_field("n_ice_top", "number of top ice layers",ispi)
+      CALL put_field("n_ice", "number of ice layers",iice)
+      CALL put_field("IR_soil", "Soil IR flux",IRs)
+      CALL put_field("LMO", "Monin-Obukhov Scale",LMO)
+      CALL put_field("surf_water", "Surficial water",rusn)
+      CALL put_field("snow_buffer", "Snow buffer layer",Bufs)
+      CALL put_field("alb_1", "albedo sw",alb1)
+      CALL put_field("alb_2", "albedo nIR",alb2)
+      CALL put_field("alb_3", "albedo fIR",alb3)
+      CALL put_field("to_ice", "Snow passed to ice",toic)
+
+ !     DO i = 1, 5
+ !       WRITE(str2,'(i2.2)') i
+ !       CALL put_field("turb_veloc"//str2, &
+ !                      "various turbulent velocities"//str2, &
+ !                      turb_vel(:,i))
+ !     ENDDO
+ !     DO i = 1, 9
+ !       WRITE(str2,'(i2.2)') i
+ !       CALL put_field("rough_length"//str2, &
+ !                      "various roughness lengths"//str2, &
+ !                      rlength(:,i))
+ !     ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("AGESNOW"//str2, &
+                         "Age de la neige layer No."//str2, &
+                         agsn(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("DZSNOW"//str2, &
+                         "Snow/ice thickness layer No."//str2, &
+                         dzsn(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("G2SNOW"//str2, &
+                         "Snow Property 2, layer No."//str2, &
+                         G2sn(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("G1SNOW"//str2, &
+                         "Snow Property 1, layer No."//str2, &
+                         G1sn(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsismx
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("ETA"//str2, &
+                         "Soil/snow water content layer No."//str2, &
+                         eta(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsismx   !nsno
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("RO"//str2, &
+                         "Snow density layer No."//str2, &
+                         ro(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsismx
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("TSS"//str2, &
+                         "Soil/snow temperature layer No."//str2, &
+                         Tsis(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+      DO isn = 1,nsno
+        IF (isn.LE.99) THEN
+          WRITE(str2,'(i2.2)') isn
+          CALL put_field("HISTORY"//str2, &
+                         "Snow history layer No."//str2, &
+                         isto(:,isn))
+        ELSE
+          PRINT*, "Trop de couches"
+          CALL abort
+        ENDIF
+      ENDDO
+
+  END SUBROUTINE sisvatredem
+
+END MODULE surf_sisvat_mod
Index: LMDZ5/trunk/libf/phylmd/surf_landice_mod.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/surf_landice_mod.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/surf_landice_mod.F90	(revision 1865)
@@ -9,4 +9,6 @@
 !
   SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
+       rlon, rlat, debut, lafin, &
+       rmu0, lwdownm, albedo, pphi1, &
        swnet, lwnet, tsurf, p1lay, &
        cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
@@ -17,12 +19,18 @@
        tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
        tsurf_new, dflux_s, dflux_l, &
+       slope, cloudf, &
+       snowhgt, qsnow, to_ice, sissnow, &
+       alb3, runoff, &
        flux_u1, flux_v1)
 
     USE dimphy
-    USE surface_data,     ONLY : type_ocean, calice, calsno
+    USE surface_data,     ONLY : type_ocean, calice, calsno, ok_snow
     USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
     USE cpl_mod,          ONLY : cpl_send_landice_fields
     USE calcul_fluxs_mod
     USE phys_output_var_mod
+#ifdef CPP_SISVAT
+    USE surf_sisvat_mod,  ONLY : surf_sisvat
+#endif
     USE indice_sol_mod
 
@@ -52,4 +60,14 @@
     REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
 
+    LOGICAL,  INTENT(IN)                          :: debut   !true if first step
+    LOGICAL,  INTENT(IN)                          :: lafin   !true if last step
+    REAL, DIMENSION(klon), INTENT(IN)             :: rlon, rlat
+    REAL, DIMENSION(klon), INTENT(IN)             :: rmu0
+    REAL, DIMENSION(klon), INTENT(IN)             :: lwdownm !ylwdown
+    REAL, DIMENSION(klon), INTENT(IN)             :: albedo  !mean albedo
+    REAL, DIMENSION(klon), INTENT(IN)             :: pphi1    
+    REAL, DIMENSION(klon), INTENT(IN)             :: slope   !mean slope in grid box  
+    REAL, DIMENSION(klon), INTENT(IN)             :: cloudf  !total cloud fraction
+
 ! In/Output variables
 !****************************************************************************************
@@ -69,4 +87,12 @@
     REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
 
+    REAL, DIMENSION(klon), INTENT(OUT)           :: alb3
+    REAL, DIMENSION(klon), INTENT(OUT)           :: qsnow   !column water in snow [kg/m2]
+    REAL, DIMENSION(klon), INTENT(OUT)           :: snowhgt !Snow height (m)
+    REAL, DIMENSION(klon), INTENT(OUT)           :: to_ice
+    REAL, DIMENSION(klon), INTENT(OUT)           :: sissnow
+    REAL, DIMENSION(klon), INTENT(OUT)           :: runoff  !Land ice runoff
+ 
+
 ! Local variables
 !****************************************************************************************
@@ -78,11 +104,26 @@
     INTEGER                  :: i,j
 
+    REAL, DIMENSION(klon)    :: emis_new                  !Emissivity
+    REAL, DIMENSION(klon)    :: swdown,lwdown
+    REAL, DIMENSION(klon)    :: precip_snow_adv, snow_adv !Snow Drift precip./advection
+    REAL, DIMENSION(klon)    :: bl_height, wind_velo      !height boundary layer, wind spd
+    REAL, DIMENSION(klon)    :: dens_air,  snow_cont_air  !air density; snow content air
+    REAL, DIMENSION(klon)    :: alb_soil                  !albedo of underlying ice
+    REAL, DIMENSION(klon)    :: pexner                    !Exner potential
+    REAL                     :: pref
+    REAL, DIMENSION(klon,nsoilmx) :: tsoil0 !modfi
+
+    CHARACTER (len = 20)                      :: modname = 'surf_landice'
+    CHARACTER (len = 80)                      :: abort_message
+
 ! End definition
 !****************************************************************************************
 !
 ! Initialize output variables
+    alb3(:) = 999999.
     alb2(:) = 999999.
     alb1(:) = 999999.
-
+    
+    runoff(:) = 0.
 !****************************************************************************************
 ! Calculate total absorbed radiance at surface
@@ -91,4 +132,75 @@
     radsol(:) = 0.0
     radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+!****************************************************************************************
+!   ok_snow = TRUE  : prepare and call SISVAT snow model
+!   ok_snow = FALSE : soil_model, calcul_flux, fonte_neige, ... 
+!
+!****************************************************************************************
+    IF (ok_snow) THEN
+#ifdef CPP_SISVAT
+       ! Prepare for calling SISVAT
+       
+       ! Calculate incoming flux for SW and LW interval: swdown, lwdown
+       swdown(:)        = 0.0
+       lwdown(:)        = 0.0
+       DO i = 1, knon
+          swdown(i)        = swnet(i)/(1-albedo(i))
+          lwdown(i)        = lwdownm(i)
+       END DO
+       
+       ! Set constants and compute some input for SISVAT
+       snow_adv(:)      = 0.                          ! no snow blown in for now
+       snow_cont_air(:) = 0.       
+       alb_soil(:)      = albedo(:)
+       pref             = 100000.                     ! = 1000 hPa
+       DO i = 1, knon
+          wind_velo(i)     = u1(i)**2 + v1(i)**2
+          wind_velo(i)     = wind_velo(i)**0.5
+          pexner(i)        = (p1lay(i)/pref)**(RD/RCPD)
+          dens_air(i)      = p1lay(i)/RD/temp_air(i)  ! dry air density
+          bl_height(i)     = pphi1(i)/RG              
+       END DO
+
+!****************************************************************************************
+! CALL to SISVAT interface
+!
+!****************************************************************************************
+       ! config: compute everything with SV but temperatures afterwards with soil/calculfluxs
+       DO i = 1, knon
+          tsoil0(i,:)=tsoil(i,:)
+       END DO
+	   ! Martin
+	   PRINT*, 'on appelle surf_sisvat'
+	   ! Martin
+       CALL surf_sisvat(knon, rlon, rlat, knindex, itime, dtime, debut, lafin, &
+            rmu0, swdown, lwdown, pexner, ps, p1lay, &
+            precip_rain, precip_snow, precip_snow_adv, snow_adv, &
+            bl_height, wind_velo, temp_air, dens_air, spechum, tsurf, &
+            rugoro, snow_cont_air, alb_soil, slope, cloudf, &
+            radsol, qsol, tsoil0, snow, snowhgt, qsnow, to_ice,sissnow, agesno, &
+            AcoefH, AcoefQ, BcoefH, BcoefQ, cdragh, &
+            run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &        
+            tsurf_new, alb1, alb2, alb3, &
+            emis_new, z0_new, qsurf)
+       
+       ! Suppose zero surface speed
+       u0(:)            = 0.0
+       v0(:)            = 0.0
+       ! The calculation of heat/water fluxes, otherwise done by "CALL calcul_fluxs" is 
+       ! integrated in SISVAT, using the same method. It can be found in "sisvat.f", in the
+       ! subroutine "SISVAT_TS2". 
+       ! u0, v0=0., dif_grnd=0. and beta=1 are assumed there! 
+       
+       CALL calcul_flux_wind(knon, dtime, &
+            u0, v0, u1, v1, cdragm, &
+            AcoefU, AcoefV, BcoefU, BcoefV, &
+            p1lay, temp_air, &
+            flux_u1, flux_v1)
+#else
+       abort_message='Pb de coherence: ok_snow = .true. mais CPP_SISVAT = .false.'
+       CALL abort_gcm(modname,abort_message,1)
+#endif
+    ELSE ! ok_snow=FALSE
 
 !****************************************************************************************
@@ -168,8 +280,10 @@
 !****************************************************************************************
     z0_new(:) = MAX(1.E-3,rugoro(:))
+    END IF ! ok_snow
+
 
 !****************************************************************************************
 ! Send run-off on land-ice to coupler if coupled ocean.
-! run_off_lic has been calculated in fonte_neige
+! run_off_lic has been calculated in fonte_neige or surf_sisvat
 !
 !****************************************************************************************
@@ -177,4 +291,8 @@
        CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic)
     ENDIF
+
+ ! transfer runoff rate [kg/m2/s](!) to physiq for output
+    runoff(1:knon)=run_off_lic(1:knon)/dtime
+
   
 !****************************************************************************************
Index: LMDZ5/trunk/libf/phylmd/surface_data.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/surface_data.F90	(revision 1863)
+++ LMDZ5/trunk/libf/phylmd/surface_data.F90	(revision 1865)
@@ -11,4 +11,8 @@
   CHARACTER(len=10), SAVE :: type_veget    ! orchidee/y/bucket/n/betaclim
   !$OMP THREADPRIVATE(ok_veget)
+  ! Martin
+  LOGICAL, SAVE          :: ok_snow       ! true for coupling to snow model SISVAT
+  !$OMP THREADPRIVATE(ok_snow)
+  ! Martin
 
   CHARACTER(len=6), SAVE :: type_ocean    ! force/slab/couple
