Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/dustemission_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/dustemission_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/dustemission_mod.F90	(revision 3851)
@@ -153,4 +153,15 @@
 !======================================================================================
 !--------------------------------------------------------------------------------------
+
+  SUBROUTINE dustemis_out_init()
+
+    USE dimphy
+
+    !AS: moved here from subroutine initdust
+    ALLOCATE( m1dflux(klon) )
+    ALLOCATE( m2dflux(klon) )
+    ALLOCATE( m3dflux(klon) )
+
+  END SUBROUTINE dustemis_out_init
 
   SUBROUTINE dustemission( debutphy, xlat, xlon, &    !Input
@@ -625,7 +636,4 @@
     ALLOCATE( srel(nats,nclass) )
     ALLOCATE( srel2(nats,nclass) )
-    ALLOCATE( m1dflux(klon) )
-    ALLOCATE( m2dflux(klon) )
-    ALLOCATE( m3dflux(klon) )
 
 
@@ -672,5 +680,4 @@
       !&      .and.pctsrf(i)>0.5.and.Pini(i,nts)>0.)THEN
   ! JE20150605<< easier to read
-  !    IF(pctsrf(i)>0.5.and.Pini(i,nts)>0.)THEN
       IF(pctsrf(i,is_ter)>0.5.and.Pini(i,nts)>0.)THEN
   ! JE20150605>>
@@ -1263,17 +1270,5 @@
                       modwm=sqrt((wind10ms(kwb)**2)+(1.2*zwstar(i))**2)
                       ustarns=cdnms*modwm*100.
-!JE20150202 <<
-! Do not have too much sense.. and is not anymore in the chimere14b version.
-!
-!                      utmin=umin/(cdnms*ceff)
-!                   IF(wind10cm(kwb).ge.utmin)THEN
-!                      ustarsalt=ustarns+  &
-!                    (0.3*(wind10cm(kwb)/100.-utmin/100.)**2.)
-!                   ELSE
-!                      ustarsalt=ustarns
-!                   ENDIF
-! ustarsalt should be :
                     ustarsalt=ustarns
-!JE20150202 >>
 
 
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/lsc_scav_spl.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/lsc_scav_spl.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/lsc_scav_spl.F90	(revision 3851)
@@ -179,5 +179,5 @@
 
 !  pressure and size of the layer
-  DO k=klev-1, 1, -1
+  DO k=klev, 1, -1
    DO i=1, klon 
      zrho(i,k)=pplay(i,k)/t(i,k)/RD   
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/phys_output_write_spl_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 3851)
@@ -68,5 +68,5 @@
        flux_sparam_sscoa,u10m_ss,v10m_ss
 
-  USE dustemission_mod, ONLY : m1dflux, m2dflux, m3dflux
+  USE dustemission_mod, ONLY : m1dflux, m2dflux, m3dflux 
 
 !  USE phytrac_mod, ONLY : d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, &
@@ -82,5 +82,5 @@
 CONTAINS 
 
-  ! ug Routine pour définir (los du premier passageà) ET sortir les variables
+  ! ug Routine pour définir (lors du premier passageà) ET sortir les variables
   SUBROUTINE phys_output_write_spl(itap, pdtphys, paprs, pphis, &
        pplay, lmax_th, aerosol_couple,         &
@@ -90,5 +90,5 @@
 
     ! This subroutine does the actual writing of diagnostics that were
-    ! defined and initialised in phys_output_mod.F90
+    ! defined and initialised mainly in phytracr_spl_mod.F90 (SPLA tracers, subroutine phytracr_spl_out_init)
 
     USE dimphy, ONLY: klon, klev, klevp1
@@ -148,15 +148,17 @@
          o_alp_bl_fluct_m, o_alp_bl_fluct_tke, &
          o_alp_bl_conv, o_alp_bl_stat, &
-         o_slab_qflux, o_tslab, o_slab_bils, &
+         o_slab_qflux, o_tslab, &
+         !o_slab_bils, &
          o_slab_bilg, o_slab_sic, o_slab_tice, &
          o_weakinv, o_dthmin, o_cldtau, &
          o_cldemi, o_pr_con_l, o_pr_con_i, &
          o_pr_lsc_l, o_pr_lsc_i, o_re, o_fl, &
-         o_rh2m, o_rh2m_min, o_rh2m_max, &
+         o_rh2m, &
+         !o_rh2m_min, o_rh2m_max, &
          o_qsat2m, o_tpot, o_tpote, o_SWnetOR, &
          o_LWdownOR, o_snowl, &
          o_solldown, o_dtsvdfo, o_dtsvdft, &
          o_dtsvdfg, o_dtsvdfi, o_z0m, o_z0h, o_od550aer, &
-         o_od865aer, o_absvisaer, o_od550lt1aer, &
+         o_od865aer, o_abs550aer, o_od550lt1aer, &
          o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, &
          o_sconcss, o_sconcdust, o_concso4, o_concno3, &
@@ -300,4 +302,5 @@
          ema_cbmf, Ma, fm_therm, ale_bl, alp_bl, ale, &
          alp, cin, wake_pe, wake_s, wake_deltat, &
+         ale_wake, ale_bl_stat, &
          wake_deltaq, ftd, fqd, ale_bl_trig, albsol1, &
          rnebcon, wo, falb1, albsol2, coefh, clwcon0, &
@@ -323,13 +326,16 @@
          t2m, fluxt, fluxlat, fsollw, fsolsw, &
          wfbils, wfbilo, cdragm, cdragh, cldl, cldm, &
-         cldh, cldt, JrNt, cldljn, cldmjn, cldhjn, &
-         cldtjn, cldq, flwp, fiwp, ue, ve, uq, vq, &
+         cldh, cldt, JrNt, &
+         ! cldljn, cldmjn, cldhjn, cldtjn &
+         cldq, flwp, fiwp, ue, ve, uq, vq, &
          plcl, plfc, wbeff, upwd, dnwd, dnwd0, prw, &
          s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, &
          vwriteSTD, wwriteSTD, phiwriteSTD, qwriteSTD, &
-         twriteSTD, ale_wake, alp_wake, wake_h, &
+         twriteSTD, alp_wake, wake_h, &
+         !ale_wake, &
          wake_omg, d_t_wake, d_q_wake, Vprecip, &
          wdtrainA, wdtrainM, n2, s2, proba_notrig, &
-         random_notrig, ale_bl_stat, &
+         random_notrig, &
+         !ale_bl_stat, &
          alp_bl_det, alp_bl_fluct_m, alp_bl_conv, &
          alp_bl_stat, alp_bl_fluct_tke, slab_wfbils, &
@@ -337,5 +343,5 @@
          pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, &
          qsat2m, tpote, tpot, d_ts, od550aer, &
-         od865aer, absvisaer, od550lt1aer, sconcso4, sconcno3, &
+         od865aer, abs550aer, od550lt1aer, sconcso4, sconcno3, &
          sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, &
          concoa, concbc, concss, concdust, loadso4, &
@@ -372,10 +378,10 @@
          bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
          itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando
-    USE ocean_slab_mod, ONLY: tslab, slab_bils, slab_bilg, tice, seaice
+    USE ocean_slab_mod, ONLY: tslab, slab_bilg, tice, seaice
     USE pbl_surface_mod, ONLY: snow
     USE indice_sol_mod, ONLY: nbsrf
     USE infotrac, ONLY: nqtot, nqo, nbtr, type_trac
     USE geometry_mod, ONLY: cell_area
-    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, ok_snow
+    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, landice_opt
 !    USE aero_mod, ONLY: naero_spc
     USE aero_mod, ONLY: naero_tot, id_STRAT_phy
@@ -405,4 +411,5 @@
     INTEGER, DIMENSION(klon) :: lmax_th
     LOGICAL :: aerosol_couple, ok_sync
+    LOGICAL :: ok_ade, ok_aie
     LOGICAL, DIMENSION(klon, klev) :: ptconv, ptconvth
     REAL :: pdtphys
@@ -442,9 +449,12 @@
     CALL set_itau_iophy(itau_w)
 
-    IF (.NOT.vars_defined) THEN
-       iinitend = 2
-    ELSE
-       iinitend = 1
-    ENDIF
+!AS, vu avec LF : le test est fait maintenant au debut du pdt, pas a la fin, alors on ne passe plus qu'une fois
+! Donc le "IF (.NOT.vars_defined)" devient inutile, et la boucle "DO iinit=1, iinitend" pourra etre eliminee 
+!  ainsi que iinit, iinitend
+!    IF (.NOT.vars_defined) THEN
+!       iinitend = 2
+!    ELSE
+!       iinitend = 1
+!    ENDIF
 
     ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage:
@@ -667,5 +677,5 @@
        CALL histwrite_phy(o_tauy, zx_tmp_fi2d)
 
-       IF (ok_snow) THEN
+       IF (landice_opt .GE. 1 ) THEN
           CALL histwrite_phy(o_snowsrf, snow_o)
           CALL histwrite_phy(o_qsnow, qsnow)
@@ -735,8 +745,18 @@
        CALL histwrite_phy(o_cldt, cldt)
        CALL histwrite_phy(o_JrNt, JrNt)
-       CALL histwrite_phy(o_cldljn, cldl*JrNt)
-       CALL histwrite_phy(o_cldmjn, cldm*JrNt)
-       CALL histwrite_phy(o_cldhjn, cldh*JrNt)
-       CALL histwrite_phy(o_cldtjn, cldt*JrNt)
+
+       !CALL histwrite_phy(o_cldljn, cldl*JrNt)
+       IF (vars_defined)  zx_tmp_fi2d=cldl*JrNt
+       CALL histwrite_phy(o_cldljn, zx_tmp_fi2d)
+       !CALL histwrite_phy(o_cldmjn, cldm*JrNt)
+       IF (vars_defined)  zx_tmp_fi2d=cldm*JrNt
+       CALL histwrite_phy(o_cldmjn, zx_tmp_fi2d)
+       !CALL histwrite_phy(o_cldhjn, cldh*JrNt)
+       IF (vars_defined)  zx_tmp_fi2d=cldh*JrNt
+       CALL histwrite_phy(o_cldhjn, zx_tmp_fi2d)
+       !CALL histwrite_phy(o_cldtjn, cldt*JrNt)
+       IF (vars_defined)  zx_tmp_fi2d=cldt*JrNt
+       CALL histwrite_phy(o_cldtjn, zx_tmp_fi2d)
+
        CALL histwrite_phy(o_cldq, cldq)
        IF (vars_defined)       zx_tmp_fi2d(1:klon) = flwp(1:klon)
@@ -932,5 +952,5 @@
        IF (type_ocean=='slab ') THEN
           CALL histwrite_phy(o_slab_qflux, slab_wfbils)
-          CALL histwrite_phy(o_slab_bils, slab_bils)
+          !CALL histwrite_phy(o_slab_bils, slab_bils)
           IF (nslay.EQ.1) THEN
               zx_tmp_fi2d(:)=tslab(:,1)
@@ -967,5 +987,5 @@
           ENDDO
        ENDIF
-       CALL histwrite_phy(o_rh2m_min, zx_tmp_fi2d)
+       !CALL histwrite_phy(o_rh2m_min, zx_tmp_fi2d)
 
        IF (vars_defined) THEN
@@ -974,5 +994,5 @@
           ENDDO
        ENDIF
-       CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d)
+       !CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d)
 
        CALL histwrite_phy(o_qsat2m, qsat2m)
@@ -996,5 +1016,5 @@
           CALL histwrite_phy(o_od550aer, od550aer)
           CALL histwrite_phy(o_od865aer, od865aer)
-          CALL histwrite_phy(o_absvisaer, absvisaer)
+          CALL histwrite_phy(o_abs550aer, abs550aer)
           CALL histwrite_phy(o_od550lt1aer, od550lt1aer)
           CALL histwrite_phy(o_sconcso4, sconcso4)
@@ -1136,12 +1156,17 @@
        CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d)
        CALL histwrite_phy(o_rhum, zx_rh)
-       CALL histwrite_phy(o_ozone, &
-            wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
+       !CALL histwrite_phy(o_ozone, &
+       !     wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
+       IF (vars_defined) zx_tmp_fi3d = wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd
+       CALL histwrite_phy(o_ozone, zx_tmp_fi3d)
 
        IF (read_climoz == 2) THEN
-          CALL histwrite_phy(o_ozone_light, &
-               wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
-       ENDIF
-
+         !CALL histwrite_phy(o_ozone_light, &
+         !     wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
+         IF (vars_defined) zx_tmp_fi3d = wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd
+         CALL histwrite_phy(o_ozone_light, zx_tmp_fi3d)
+       ENDIF
+
+       !AS: dans phys_output_write il y a en plus : CALL histwrite_phy(o_duphy, d_u) 
        CALL histwrite_phy(o_dtphy, d_t)
        CALL histwrite_phy(o_dqphy,  d_qx(:,:,ivap))
@@ -1585,8 +1610,9 @@
 #endif
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-        IF (nqtot.GE.nqo+1) THEN
-            DO iq=nqo+1,nqtot
-              IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
-
+       IF (nqtot.GE.nqo+1) THEN
+         !AS: type_trac = 'lmdz' par defaut dans libf/dyn3d/conf_gcm.F90
+         !Changé par inca, repr(obus), coag(ulation), co2i(nteractif), PAS par SPLA
+         !Cet "if" est donc inutile : IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
+           DO iq=nqo+1,nqtot
              CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
              CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
@@ -1612,6 +1638,6 @@
              ENDIF
              CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
-             ENDIF
-          ENDDO
+           ENDDO
+         !ENDIF
        ENDIF
 
@@ -1639,5 +1665,5 @@
        ENDIF
 
-    ENDDO
+    ENDDO ! iinit
 
     IF (vars_defined) THEN
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/phytracr_spl_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 3851)
@@ -3,5 +3,4 @@
 
 MODULE phytracr_spl_mod
-
 
 ! Recuperation des morceaux de la physique de Jeronimo specifiques
@@ -35,7 +34,4 @@
   CHARACTER*800 fileregionsdimsbb
   CHARACTER*800 fileregionsdimswstar
-!  CHARACTER*800 filescaleparamsind
-!  CHARACTER*800 filescaleparamsdust
-!  CHARACTER*800 filescaleparamsbb
   CHARACTER*100 paramname_ind
   CHARACTER*100 paramname_bb
@@ -424,1470 +420,26 @@
 !$OMP THREADPRIVATE(flux_sparam_sscoa,u10m_ss,v10m_ss)
 
-! Select dust emission scheme ver the Sahara:
+! Select dust emission scheme for the Sahara:
 !      LOGICAL,PARAMETER,SAVE ::  ok_chimeredust=.FALSE.
       LOGICAL,PARAMETER ::  ok_chimeredust=.TRUE.
 !!!!!! !$OMP THREADPRIVATE(ok_chimeredust)
 
-!OH   REAL,SAVE :: scale_param_ssacc  !Scaling parameter for Fine Sea Salt
-!OH   REAL,SAVE :: scale_param_sscoa  !Scaling parameter for Coarse Sea Salt
-!OH   REAL,ALLOCATABLE,SAVE :: scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissionsi of SO2
-!OH   REAL,ALLOCATABLE,SAVE :: scale_param_bb(nbreg_bb)  !Scaling parameter for biomas burning (SO2, BC & OM)
-!OH   REAL,ALLOCATABLE,SAVE :: scale_param_ff(nbreg_ind)  !Scaling parameter for industrial emissions (fossil fuel)
-!OH   REAL,ALLOCATABLE,SAVE :: scale_param_dustacc(nbreg_dust)  !Scaling parameter for Fine Dust
-!OH   REAL,ALLOCATABLE,SAVE :: scale_param_dustcoa(nbreg_dust)  !Scaling parameter for Coarse Dust
-!OH   REAL,ALLOCATABLE,SAVE :: scale_param_dustsco(nbreg_dust)  !Scaling parameter for SCoarse Dust
-!OH   REAL,ALLOCATABLE,SAVE :: param_wstarBLperregion(nbreg_wstardust)
-!OH   REAL,ALLOCATABLE,SAVE :: param_wstarWAKEperregion(nbreg_wstardust)
-!!!! !$OMP THREADPRIVATE( scale_param_ssacc, scale_param_sscoa, scale_param_ind, scale_param_bb, scale_param_ff, scale_param_dustacc, scale_param_dustcoa, scale_param_dustsco, param_wstarBLperregion, param_wstarWAKEperregion)
-
 
 CONTAINS
 !
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-SUBROUTINE phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust)
+SUBROUTINE phytracr_spl_out_init()
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-  IMPLICIT NONE
-  INTEGER klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust
-
-  ALLOCATE(  tsol(klon)              )
-  fileregionsdimsind='regions_ind_meta'
-  fileregionsdimsdust='regions_dustacc_meta'
-!  fileregionsdimsdust='regions_dust_meta'
-  fileregionsdimsbb='regions_bb_meta'
-  fileregionsdimswstar='regions_pwstarwake_meta'
-  call  readregionsdims2_spl(nbreg_ind,fileregionsdimsind)
-  call  readregionsdims2_spl(nbreg_dust,fileregionsdimsdust)
-  call  readregionsdims2_spl(nbreg_bb,fileregionsdimsbb)
-  call  readregionsdims2_spl(nbreg_wstardust,fileregionsdimswstar)
-
-!readregions_spl()
-
-  ALLOCATE(scale_param_ind(nbreg_ind))
-  ALLOCATE(scale_param_bb(nbreg_bb))
-  ALLOCATE(scale_param_ff(nbreg_ind))
-  ALLOCATE(scale_param_dustacc(nbreg_dust))
-  ALLOCATE(scale_param_dustcoa(nbreg_dust))
-  ALLOCATE(scale_param_dustsco(nbreg_dust))
-  ALLOCATE(param_wstarBLperregion(nbreg_wstardust))
-  ALLOCATE(param_wstarWAKEperregion(nbreg_wstardust))
-  ALLOCATE(  dust_ec(klon)           )
-  ALLOCATE(  u10m_ec(klon)           )
-  ALLOCATE(  v10m_ec(klon)           )
-  ALLOCATE(  lmt_so2volc_cont(klon)  )
-  ALLOCATE(  lmt_altvolc_cont(klon)  )
-  ALLOCATE(  lmt_so2volc_expl(klon)  )
-  ALLOCATE(  lmt_altvolc_expl(klon)  )
-  ALLOCATE(  lmt_so2ff_l(klon)       )   
-  ALLOCATE(  lmt_so2ff_h(klon)       )  
-  ALLOCATE(  lmt_so2nff(klon)        )  
-  ALLOCATE(  lmt_so2ba(klon)         )  
-  ALLOCATE(  lmt_so2bb_l(klon)       )
-  ALLOCATE(  lmt_so2bb_h(klon)       )  
-  ALLOCATE(  lmt_dmsconc(klon)       )  
-  ALLOCATE(  lmt_dmsbio(klon)        )  
-  ALLOCATE(  lmt_h2sbio(klon)        )  
-  ALLOCATE(  lmt_bcff(klon)          )
-  ALLOCATE(  lmt_bcnff(klon)         )
-  ALLOCATE(  lmt_bcbb_l(klon)        )
-  ALLOCATE(  lmt_bcbb_h(klon)        )
-  ALLOCATE(  lmt_bcba(klon)          )
-  ALLOCATE(  lmt_omff(klon)          )  
-  ALLOCATE(  lmt_omnff(klon)         )  
-  ALLOCATE(  lmt_ombb_l(klon)        )  
-  ALLOCATE(  lmt_ombb_h(klon)        )  
-  ALLOCATE(  lmt_omnat(klon)         )  
-  ALLOCATE(  lmt_omba(klon)          )           
-  ALLOCATE(lmt_sea_salt(klon,ss_bins)) 
-
-
-
-
-  !temporal hardcoded null inicialization of assimilation emmision factors
-  scale_param_ssacc=1.
-  scale_param_sscoa=1.
-  scale_param_ind(:)=1.
-  scale_param_bb(:)=1.
-  scale_param_ff(:)=1.
-  scale_param_dustacc(:)=1.
-  scale_param_dustcoa(:)=1.
-  scale_param_dustsco(:)=1.
-  param_wstarBLperregion(:)=0.
-  param_wstarWAKEperregion(:)=0.
-
-
-
-RETURN
-END SUBROUTINE phytracr_spl_ini
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      SUBROUTINE phytracr_spl ( debutphy,lafin,jD_cur,jH_cur,iflag_conv, &  ! I
-                      pdtphys,ftsol,                                   &  ! I
-                      t_seri,q_seri,paprs,pplay,RHcl,                  &  ! I
-                      pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,          &  ! I
-                      coefh, cdragh, cdragm, yu1, yv1,                 &  ! I
-                      u_seri, v_seri, rlat,rlon,                       &  ! I
-                      pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,            &  ! I
-                      da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,     &  ! I
-                      epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,      &  ! I
-                      evapls,wdtrainA,  wdtrainM,wght_cvfd,              &  ! I
-                      fm_therm, entr_therm, rneb,                      &  ! I
-                      beta_fisrt,beta_v1,                              &  ! I
-                      zu10m,zv10m,wstar,ale_bl,ale_wake,               &  ! I
-                      d_tr_dyn,tr_seri)                                            ! O
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      USE mod_grid_phy_lmdz
-      USE mod_phys_lmdz_para
-      USE IOIPSL
-      USE dimphy
-      USE infotrac
-      USE indice_sol_mod
-      USE write_field_phy
-     
-
-      USE mod_phys_lmdz_transfert_para
-
-  USE phys_cal_mod, only: jD_1jan,year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
-       mth_cur, phys_cal_update
-
-!
-      IMPLICIT none
-!
-
-!======================================================================
-! Auteur(s) FH
-! Objet: Moniteur general des tendances traceurs
-!
-! Remarques en vrac:
-! ------------------
-! 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien 
-! les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
-!======================================================================
-#include "dimensions.h"
-#include "chem.h"
-#include "chem_spla.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "paramet.h"
-#include "thermcell.h"
-
-!======================================================================
-
-! Arguments:
-!
-!  EN ENTREE:
-!  ==========
-!
-!  divers:
-!  -------
-!
-      real,intent(in) :: pdtphys  ! pas d'integration pour la physique (seconde)
-      REAL, intent(in):: jD_cur, jH_cur
-      real, intent(in) ::  ftsol(klon,nbsrf)  ! temperature du sol par type
-      real, intent(in) ::  t_seri(klon,klev)  ! temperature
-      real, intent(in) ::  u_seri(klon,klev)  ! vent
-      real , intent(in) :: v_seri(klon,klev)  ! vent
-      real , intent(in) :: q_seri(klon,klev)  ! vapeur d eau kg/kg
-
-LOGICAL,  INTENT(IN)                          :: lafin
-
-      real tr_seri(klon,klev,nbtr) ! traceur  
-      real tmp_var(klon,klev) ! auxiliary variable to replace traceur  
-      real tmp_var2(klon,nbtr) ! auxiliary variable to replace source
-      real tmp_var3(klon,klev,nbtr) ! auxiliary variable 3D  
-      real dummy1d ! JE auxiliary variable
-      real aux_var2(klon) ! auxiliary variable to replace traceur  
-      real aux_var3(klon,klev) ! auxiliary variable to replace traceur  
-      real d_tr(klon,klev,nbtr)    ! traceur  tendance
-      real sconc_seri(klon,nbtr) ! surface concentration of traceur  
-!
-      integer nbjour
-      save nbjour
-!$OMP THREADPRIVATE(nbjour)
-!
-      INTEGER  masque_aqua_cur(klon)
-      INTEGER  masque_terra_cur(klon)
-      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_aqua  !mask for 1 day
-      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_terra !
-!$OMP THREADPRIVATE(masque_aqua,masque_terra)
-!!$OMP THREADPRIVATE(aod550_aqua,aod550_terra,aod670_aqua,aod670_terra)
-!!$OMP THREADPRIVATE(aod865_aqua,aod865_terra)
-
-  INTEGER, SAVE :: nbreg_dust, nbreg_ind, nbreg_bb, nbreg_ss,nbreg_wstardust
-  !$OMP THREADPRIVATE(nbreg_dust, nbreg_ind, nbreg_bb,nbreg_ss,nbreg_wstardust)
-
-
-
-      REAL lmt_dms(klon)           ! emissions de dms
-
-!JE20150518<<
-      REAL, DIMENSION(klon_glo)  :: aod550_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
-
-      REAL, DIMENSION(klon_glo)  :: aod550_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod550_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod670_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-      REAL, DIMENSION(klon_glo)  :: aod865_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
-!!!!!!!!!!!!!
-!JE20150518>>
-
-
-
-
-      real , intent(in) :: paprs(klon,klev+1)  ! pression pour chaque inter-couche (en Pa)
-      real , intent(in) :: pplay(klon,klev)  ! pression pour le mileu de chaque couche (en Pa)
-      real , intent(in) :: RHcl(klon,klev)  ! humidite relativen ciel clair
-      real znivsig(klev)  ! indice des couches
-      real paire(klon)
-      real, intent(in) ::  pphis(klon)
-      real, intent(in) ::  pctsrf(klon,nbsrf)
-      logical , intent(in) :: debutphy   ! le flag de l'initialisation de la physique
-!
-!  Scaling Parameters:
-!  ----------------------
-!
-      CHARACTER*50 c_Directory
-      CHARACTER*80 c_FileName1 
-      CHARACTER*80 c_FileName2
-      CHARACTER*130 c_FullName1
-      CHARACTER*130 c_FullName2
-      INTEGER :: xidx, yidx
-      INTEGER,DIMENSION(klon) :: mask_bbreg
-      INTEGER,DIMENSION(klon) :: mask_ffso2reg
-      INTEGER :: aux_mask1
-      INTEGER :: aux_mask2
-      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4
-      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind  !Defines regions for SO2, BC & OM
-      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb   !Defines regions for SO2, BC & OM
-      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_dust !Defines  dust regions
-      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_wstardust !Defines  dust regions
-!$OMP THREADPRIVATE(iregion_so4,iregion_ind,iregion_bb,iregion_dust,iregion_wstardust)
-
-!  Emissions:
-
-!
-!---------------------------- SEA SALT & DUST emissions ------------------------
-      REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um
-      REAL u10m_ec1(klon),v10m_ec1(klon)
-      REAL u10m_ec2(klon),v10m_ec2(klon),dust_ec2(klon)
-      REAL dust_ec(klon)
-!     new dust emission chimere je20140522
-      REAL,DIMENSION(klon),INTENT(IN)                     :: zu10m
-      REAL,DIMENSION(klon),INTENT(IN)                     :: zv10m
-      REAL,DIMENSION(klon),INTENT(IN)  :: wstar,ale_bl,ale_wake
-
-
-!
-!  Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     !Dynamique
-     !--------
-      REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)    :: d_tr_dyn
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!  convection:
-!  -----------
-!
-      REAL , intent(in) :: pmfu(klon,klev)  ! flux de masse dans le panache montant
-      REAL , intent(in) :: pmfd(klon,klev)  ! flux de masse dans le panache descendant
-      REAL, intent(in) ::  pen_u(klon,klev) ! flux entraine dans le panache montant
-      REAL, intent(in) ::  pde_u(klon,klev) ! flux detraine dans le panache montant
-      REAL, intent(in) ::  pen_d(klon,klev) ! flux entraine dans le panache descendant
-      REAL, intent(in) ::  pde_d(klon,klev) ! flux detraine dans le panache descendant
-!
-!  Convection KE scheme:
-!  ---------------------
-!
-!! Variables pour le lessivage convectif
-       REAL,DIMENSION(klon,klev),INTENT(IN)     :: da
-       REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
-       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
-       REAL,DIMENSION(klon,klev),INTENT(IN)      :: d1a,dam
-       REAL,DIMENSION(klon,klev),INTENT(IN)     :: mp
-       REAL,DIMENSION(klon,klev),INTENT(IN)     :: upwd      ! saturated
-!            updraft mass flux
-       REAL,DIMENSION(klon,klev),INTENT(IN)     :: dnwd      ! saturated
-!            downdraft mass flux
-       INTEGER,DIMENSION(klon),INTENT(IN)     :: itop_con
-       INTEGER,DIMENSION(klon),INTENT(IN)     :: ibas_con
-       REAL,DIMENSION(klon,klev)      :: evapls
-       REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainA
-       REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainM
-
-
-       REAL,DIMENSION(klon,klev),INTENT(IN)      :: ep
-       REAL,DIMENSION(klon),INTENT(IN)           :: sigd
-       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
-       REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw
-       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
-       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
-       REAL,DIMENSION(klon,klev),INTENT(IN)      :: eplaMm
-       REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd          !RL
-
-
-!     KE: Tendances de traceurs (Td) et flux de traceurs:
-!     ------------------------
-       REAL,DIMENSION(klon,klev)      :: Mint
-       REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
-       REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
-       REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
-
-!                                                        !tra dans pluie LS a la surf.
-!      outputs for cvltr_spl
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv_o  
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav_o
-     !!!!!!!!!!!!!!!!!
-     !!!!!!!!!!!!!!!!!
-     !!!!!!!!!!!!!!!!!
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dyn_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl_o
-       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th_o
-     !!!!!!!!!!!!!!!!!
-     !!!!!!!!!!!!!!!!!
-     !!!!!!!!!!!!!!!!!
-
-!$OMP THREADPRIVATE(d_tr_cv_o,d_tr_trsp_o,d_tr_sscav_o,d_tr_sat_o,d_tr_uscav_o)
-!$OMP THREADPRIVATE(d_tr_insc_o,d_tr_bcscav_o,d_tr_evapls_o,d_tr_ls_o)
-!$OMP THREADPRIVATE(d_tr_dyn_o,d_tr_cl_o,d_tr_th_o)
-
-
-       INTEGER ::  nsplit
-!
-
-     
-
-!
-!  Lessivage
-!  ---------
-!
-      REAL, intent(in) ::  pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--convection
-      REAL, intent(in) ::  prfl(klon,klev+1),   psfl(klon,klev+1)     !--large-scale
-! JE      REAL pmflxr(klon,klev), pmflxs(klon,klev)   !--convection       ! Titane
-! JE      REAL prfl(klon,klev),   psfl(klon,klev)     !--large-scale      ! Titane
-      REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
-      REAL  :: ql_incloud_ref    ! ref value of in-cloud condensed water content
-
-       REAL,DIMENSION(klon,klev),INTENT(IN)   :: rneb    ! fraction nuageuse (grande echelle)
-!
-
-      REAL,DIMENSION(klon,klev) :: beta_fisrt ! taux de conversion
-!                                                          ! de l'eau cond (de fisrtilp)
-      REAL,DIMENSION(klon,klev) :: beta_v1    ! -- (originale version)
-      INTEGER,SAVE  :: iflag_lscav_omp,iflag_lscav
-!$OMP THREADPRIVATE(iflag_lscav_omp,iflag_lscav)
-
-
-
-
-!Thermiques:
-!----------
-      REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: fm_therm
-      REAL,DIMENSION(klon,klev),INTENT(IN)     :: entr_therm
-
-
-!
-!  Couche limite:
-!  --------------
-!
-      REAL , intent(in) :: coefh(klon,klev) ! coeff melange CL
-      REAL , intent(in) :: cdragh(klon), cdragm(klon)
-      REAL, intent(in) ::  yu1(klon)        ! vent dans la 1iere couche
-      REAL, intent(in) ::  yv1(klon)        ! vent dans la 1iere couche
-!
-!
-!----------------------------------------------------------------------
-      REAL his_ds(klon,nbtr)
-      REAL his_dh(klon,nbtr)
-      REAL his_dhlsc(klon,nbtr)        ! in-cloud scavenging lsc
-      REAL his_dhcon(klon,nbtr)       ! in-cloud scavenging con
-      REAL his_dhbclsc(klon,nbtr)      ! below-cloud scavenging lsc
-      REAL his_dhbccon(klon,nbtr)      ! below-cloud scavenging con
-      REAL trm(klon,nbtr)
-!
-      REAL u10m_ec(klon), v10m_ec(klon)
-!
-      REAL his_th(klon,nbtr)
-      REAL his_dhkecv(klon,nbtr)
-      REAL his_dhkelsc(klon,nbtr)
-
-
-!
-!  Coordonnees
-!  -----------
-!
-      REAL, intent(in) ::  rlat(klon)       ! latitudes pour chaque point 
-      REAL, intent(in) ::  rlon(klon)       ! longitudes pour chaque point 
-!
-      INTEGER i, k, it, j, ig 
-!
-! DEFINITION OF DIAGNOSTIC VARIABLES
-!
-      REAL diag_trm(nbtr), diag_drydep(nbtr) 
-      REAL diag_wetdep(nbtr), diag_cvtdep(nbtr)
-      REAL diag_emissn(nbtr), diag_g2part
-      REAL diag_sedimt
-      REAL trm_aux(nbtr), src_aux(nbtr)
-!
-! Variables locales pour effectuer les appels en serie
-!----------------------------------------------------
-      REAL source_tr(klon,nbtr)
-      REAL flux_tr(klon,nbtr)
-      REAL m_conc(klon,klev)
-!      REAL sed_ss(klon)    ! corresponds to tracer 3
-!      REAL sed_dust(klon)  ! corresponds to tracer 4
-!      REAL sed_dustsco(klon)  ! corresponds to tracer 4
-      REAL henry(nbtr)  !--cste de Henry  mol/l/atm
-      REAL kk(nbtr)     !--coefficient de var avec T (K)
-      REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie
-      REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige
-      REAL vdep_oce(nbtr), vdep_sic(nbtr)
-      REAL vdep_ter(nbtr), vdep_lic(nbtr)
-      REAL ccntrAA_spla(nbtr)
-      REAL ccntrENV_spla(nbtr)
-      REAL coefcoli_spla(nbtr)
-      REAL dtrconv(klon,nbtr)
-      REAL zrho(klon,klev), zdz(klon,klev)
-      REAL zalt(klon,klev)
-      REAL,DIMENSION(klon,klev)      :: zmasse    ! densité atmosphérique
-!     .                                              Kg/m2
-      REAL,DIMENSION(klon,klev)      :: ztra_th
-      REAL qmin, qmax, aux
-!      PARAMETER (qmin=0.0, qmax=1.e33)
-      PARAMETER (qmin=1.e33, qmax=-1.e33)
-
-! Variables to save data into file
-!----------------------------------
-   
-      CHARACTER*2 str2
-      LOGICAL ok_histrac
-!JE2014124      PARAMETER (ok_histrac=.true.)
-      PARAMETER (ok_histrac=.false.)
-!      PARAMETER (ok_chimeredust=.false.) 
-!      PARAMETER (ok_chimeredust=.true.) 
-      INTEGER ndex2d(iim*(jjm+1)), ndex3d(iim*(jjm+1)*klev)
-      INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
-      INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
-      SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
-!$OMP THREADPRIVATE(nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5)
-      INTEGER itra
-      SAVE itra                    ! compteur pour la physique
-!$OMP THREADPRIVATE(itra)
-      INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m
-      SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m
-!$OMP THREADPRIVATE(ecrit_tra, ecrit_tra_h, ecrit_tra_m)
-      REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
-      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
-      REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev)
-!      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
-      REAL zx_lon_glo(nbp_lon,nbp_lat), zx_lat_glo(nbp_lon,nbp_lat)
-      REAL zsto, zout, zout_h, zout_m, zjulian
-
-!------Molar Masses
-      REAL masse(nbtr)
-!
-      REAL fracso2emis                              !--fraction so2 emis en so2
-      PARAMETER (fracso2emis=0.95) 
-      REAL frach2sofso2                             !--fraction h2s from so2
-      PARAMETER (frach2sofso2=0.0426)
-!
-!  Controles
-!-------------
-      LOGICAL convection,lessivage,lminmax,lcheckmass
-      DATA convection,lessivage,lminmax,lcheckmass &
-          /.true.,.true.,.true.,.false./
-!
-      REAL xconv(nbtr)
-!
-      LOGICAL anthropo, bateau, edgar
-      DATA anthropo,bateau,edgar/.true.,.true.,.true./
-!
-!c bc_source
-      INTEGER kminbc, kmaxbc
-!JE20150715      PARAMETER (kminbc=3, kmaxbc=5)
-      PARAMETER (kminbc=4, kmaxbc=7)
-!
-      REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont
-!
-! JE for updating in  cltrac
-      REAL,DIMENSION(klon,klev)             :: delp     ! epaisseur de couche (Pa)
-!JE20140507      REAL,DIMENSION(klon,nbtr)       :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE  jyg
-!JE20140507      REAL,DIMENSION(klon,nbtr)        ::  flux_tr_dry
-!      SAVE  d_tr_dry
-!! JE for include gas to particle conversion in output
-!      REAL his_g2pgas(klon)      ! gastoparticle in gas units (check!)
-!      REAL his_g2paer(klon)      ! gastoparticle in aerosol units (check!)
-!
-      INTEGER ,intent(in) :: iflag_conv
-      LOGICAL iscm3  ! debug variable. for checkmass ! JE
-
-!------------------------------------------------------------------------
-!  only to compute time consumption of each process
-!----
-      INTEGER clock_start,clock_end,clock_rate,clock_start_spla
-      INTEGER clock_end_outphytracr,clock_start_outphytracr
-      INTEGER ti_init,dife,ti_inittype,ti_inittwrite
-      INTEGER ti_spla,ti_emis,ti_depo,ti_cltr,ti_ther
-      INTEGER ti_sedi,ti_gasp,ti_wetap,ti_cvltr,ti_lscs,ti_brop,ti_outs
-      INTEGER ti_nophytracr,clock_per_max
-      REAL tia_init,tia_inittype,tia_inittwrite
-      REAL tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
-      REAL tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
-      REAL tia_brop,tia_outs
-      REAL tia_nophytracr
- 
-      SAVE tia_init,tia_inittype,tia_inittwrite
-      SAVE tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
-      SAVE tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
-      SAVE tia_brop,tia_outs
-      SAVE ti_nophytracr
-      SAVE tia_nophytracr
-      SAVE clock_end_outphytracr,clock_start_outphytracr
-      SAVE clock_per_max
-      LOGICAL logitime
-!$OMP THREADPRIVATE(tia_init,tia_inittype,tia_inittwrite)
-!$OMP THREADPRIVATE(tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther)
-!$OMP THREADPRIVATE(tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs)
-!$OMP THREADPRIVATE(tia_brop,tia_outs)
-!$OMP THREADPRIVATE(ti_nophytracr)
-!$OMP THREADPRIVATE(tia_nophytracr)
-!$OMP THREADPRIVATE(clock_end_outphytracr,clock_start_outphytracr)
-!$OMP THREADPRIVATE(clock_per_max)
-
-!     utils parallelization
-      REAL :: auxklon_glo(klon_glo)
-      INTEGER :: iauxklon_glo(klon_glo)
-      REAL, DIMENSION(klon_glo,nbp_lev) :: auxklonnbp_lev
-      REAL, DIMENSION(klon_glo,nbp_lev,nbtr)  :: auxklonklevnbtr_glo
-      REAL,DIMENSION(nbp_lon,nbp_lat) ::  zx_tmp_2d_glo
-      REAL,DIMENSION(nbp_lon,nbp_lat,nbp_lev) :: zx_tmp_3d_glo
-      REAL,DIMENSION(klon_glo) :: zx_tmp_fi2d_glo
-      REAL,DIMENSION(klon_glo , nbp_lev) :: zx_tmp_fi3d_glo
-      REAL,DIMENSION(klon_glo,nbtr) :: auxklonnbtr_glo
-
-
-
-      source_tr=0.
-
-
-
-      if (debutphy) then
-#ifdef IOPHYS_DUST
-         CALL iophys_ini
-#endif
-         nbreg_ind=1
-         nbreg_bb=1
-         nbreg_dust=1
-         nbreg_wstardust=1
-         CALL phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust)
-      endif
-
-
-#ifdef IOPHYS_DUST
-      do it=1,nbtr
-         write(str2,'(i2.2)') it
-         call iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,it))
-      enddo
-#endif
-
-  
-
-
-  ijulday=jD_cur-jD_1jan+1
-  nbjour = 1
-
-  paramname_ind='ind'
-  paramname_bb='bb'
-  paramname_ff='ind'
-  paramname_dustacc='dustacc'
-  paramname_dustcoa='dustcoasco'
-  paramname_dustsco='dustcoasco'
-!  paramname_dustacc='dust'
-!  paramname_dustcoa='dust'
-!  paramname_dustsco='dust'
-  paramname_wstarBL='pwstarbl'
-  paramname_wstarWAKE='pwstarwake'
-  paramname_ssacc='ssacc'
-  paramname_sscoa='sscoa'
-
-  filescaleparams='modvalues.nc'
-  CALL readscaleparamsnc_spl(scale_param_ind,                        &
-        nbreg_ind, paramname_ind,                                    &
-        scale_param_ff, nbreg_ind,paramname_ff,                      &
-        scale_param_bb, nbreg_bb,paramname_bb,                       &
-        scale_param_dustacc, nbreg_dust,paramname_dustacc,           &
-        scale_param_dustcoa, nbreg_dust,paramname_dustcoa,           &
-        scale_param_dustsco, nbreg_dust,paramname_dustsco,           &
-        param_wstarBLperregion, nbreg_wstardust, paramname_wstarBL, &
-        param_wstarWAKEperregion, nbreg_wstardust, paramname_wstarWAKE, &
-        scale_param_ssacc  ,  paramname_ssacc,                    &
-        scale_param_sscoa  ,  paramname_sscoa,                    &
-           filescaleparams,ijulday,jH_cur, pdtphys,debutphy)
-! add seasalt
-
-  print *,'JE : check scale_params'
-
-  print *, 'nbreg_ind', nbreg_ind   
-  print *, 'nbreg_dust', nbreg_dust  
-  print *, 'nbreg_bb', nbreg_bb   
-  print *, 'ind', scale_param_ind   
-  print *, 'dustacc', scale_param_dustacc  
-  print *, 'dustcoa', scale_param_dustcoa  
-  print *, 'dustsco', scale_param_dustsco
-  print *, 'wstardustBL', param_wstarBLperregion
-  print *, 'wstardustWAKE', param_wstarWAKEperregion
-  print *, 'ff', scale_param_ff  
-  print *, 'bb', scale_param_bb  
-  print *, 'ssacc', scale_param_ssacc
-  print *, 'sscoa', scale_param_sscoa
-
-  print *,'JE: before read_newemissions '
-  print *,'JE: jD_cur:',jD_cur,' ijulday:',ijulday,' jH_cur:',jH_cur,' pdtphys:',pdtphys
-  print *,'JE: now read_newemissions:'
-  print *,'lmt_so2ff_l AVANT' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
-  call read_newemissions(ijulday,jH_cur ,edgar, flag_dms,debutphy, & !I
-                         pdtphys, lafin, nbjour, pctsrf,  &       !I
-                         t_seri, rlat, rlon, &                         !I
-                         pmflxr, pmflxs, prfl, psfl, &            !I
-                                 u10m_ec, v10m_ec, dust_ec, &     !O
-                                 lmt_sea_salt, lmt_so2ff_l, &     !O
-                                 lmt_so2ff_h, lmt_so2nff, &       !O
-                                 lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, &  !O
-                                 lmt_so2volc_cont, lmt_altvolc_cont, &   !O
-                                 lmt_so2volc_expl, lmt_altvolc_expl, &   !O
-                                 lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, &  !O
-                                 lmt_bcff, lmt_bcnff, lmt_bcbb_l, &      !O
-                                 lmt_bcbb_h, lmt_bcba, lmt_omff, &       !O
-                                 lmt_omnff, lmt_ombb_l, lmt_ombb_h, &    !O
-                                 lmt_omnat, lmt_omba)                    !O
-
-
-  print *,'Check emissions'
-  print *,'lmt_so2ff_l' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
-  print *,'lmt_so2ff_h' , MINVAL(lmt_so2ff_h), MAXVAL(lmt_so2ff_h)
-  print *,'lmt_so2nff' , MINVAL(lmt_so2nff), MAXVAL(lmt_so2nff)
-  print *,'lmt_so2ba' , MINVAL(lmt_so2ba), MAXVAL(lmt_so2ba)
-  print *,'lmt_so2bb_l' , MINVAL(lmt_so2bb_l), MAXVAL(lmt_so2bb_l)
-  print *,'lmt_so2bb_h' , MINVAL(lmt_so2bb_h), MAXVAL(lmt_so2bb_h)
-  print *,'lmt_so2volc_cont' , MINVAL(lmt_so2volc_cont), MAXVAL(lmt_so2volc_cont)
-  print *,'lmt_altvolc_cont' , MINVAL(lmt_altvolc_cont), MAXVAL(lmt_altvolc_cont)
-  print *,'lmt_so2volc_expl' , MINVAL(lmt_so2volc_expl), MAXVAL(lmt_so2volc_expl)
-  print *,'lmt_altvolc_expl' , MINVAL(lmt_altvolc_expl), MAXVAL(lmt_altvolc_expl)
-  print *,'lmt_dmsbio' , MINVAL(lmt_dmsbio), MAXVAL(lmt_dmsbio)
-  print *,'lmt_h2sbio' , MINVAL(lmt_h2sbio), MAXVAL(lmt_h2sbio)
-  print *,'lmt_dmsconc' , MINVAL(lmt_dmsconc), MAXVAL(lmt_dmsconc)
-  print *,'lmt_bcff' , MINVAL(lmt_bcff), MAXVAL(lmt_bcff)
-  print *,'lmt_bcnff' , MINVAL(lmt_bcnff), MAXVAL(lmt_bcnff)
-  print *,'lmt_bcbb_l' , MINVAL(lmt_bcbb_l), MAXVAL(lmt_bcbb_l)
-  print *,'lmt_bcbb_h' , MINVAL(lmt_bcbb_h), MAXVAL(lmt_bcbb_h)
-  print *,'lmt_bcba' , MINVAL(lmt_bcba), MAXVAL(lmt_bcba)
-  print *,'lmt_omff' , MINVAL(lmt_omff), MAXVAL(lmt_omff)
-  print *,'lmt_omnff' , MINVAL(lmt_omnff), MAXVAL(lmt_omnff)
-  print *,'lmt_ombb_l' , MINVAL(lmt_ombb_l), MAXVAL(lmt_ombb_l)
-  print *,'lmt_ombb_h' , MINVAL(lmt_ombb_h), MAXVAL(lmt_ombb_h)
-  print *,'lmt_omnat' , MINVAL(lmt_omnat), MAXVAL(lmt_omnat)
-  print *,'lmt_omba' , MINVAL(lmt_omba), MAXVAL(lmt_omba)
-  print *,'JE iflag_con',iflag_conv
-
-
-!JE_dbg
-   do i=1,klon
-      tsol(i)=0.0
-      do j=1,nbsrf
-          tsol(i)=tsol(i)+ftsol(i,j)*pctsrf(i,j)
-      enddo
-   enddo
-
-
-!======================================================================
-!  INITIALISATIONS
-!======================================================================
-!             CALL checknanqfi(da(:,:),1.,-1.,' da_ before
-!     . phytracr_inphytracr')
-
-!
-! computing time
-!        logitime=.true.
-        logitime=.false.
-        IF (logitime) THEN
-        clock_start=0
-        clock_end=0
-        clock_rate=0
-       CALL SYSTEM_CLOCK(COUNT_RATE=clock_rate,COUNT_MAX=clock_per_max)
-        CALL SYSTEM_CLOCK(COUNT=clock_start_spla)
-        clock_start=clock_start_spla
-        clock_end_outphytracr=clock_start_spla
-        ENDIF
-
-
-! Definition of tracers index.
-      print*,'OK ON PASSSE BIEN LA'
-      CALL minmaxsource(source_tr,qmin,qmax,'A1 maxsource init phytracr')
-
-
-      IF (debutphy) THEN
-        id_prec=-1
-        id_fine=-1
-        id_coss=-1
-        id_codu=-1
-        id_scdu=-1
-       !print *,nbtr
-       do it=1,nbtr
-        print *, it, tname(it+nqo)
-        if (tname(it+nqo) == 'PREC' ) then
-            id_prec=it
-        endif
-        if (tname(it+nqo) == 'FINE' ) then
-            id_fine=it
-        endif
-        if (tname(it+nqo) == 'COSS' ) then
-            id_coss=it
-        endif
-        if (tname(it+nqo) == 'CODU' ) then
-            id_codu=it
-        endif
-        if (tname(it+nqo) == 'SCDU' ) then
-            id_scdu=it
-        endif
-       enddo
-       ! check consistency with dust emission scheme:
-       if (ok_chimeredust) then
-          if (.not.( id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then
-             call abort_gcm('phytracr_mod', 'pb in ok_chimdust 0',1)
-          endif
-       else 
-          if (id_scdu>0) then 
-       call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU',1)
-          endif
-          if ( (id_codu .le. 0) .or. ( id_fine.le.0)  ) then  
-          call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1',1) 
-          endif
-       endif
-
-
-       !print *,id_prec,id_fine,id_coss,id_codu,id_scdu
-       ENDIF
-
-
-
-
-
-
-!---fraction of tracer that is convected (Tiedke)
-      xconv(:)=0.
-      if(id_prec>0)  xconv(id_prec)=0.8
-      if(id_fine>0)  xconv(id_fine)=0.5
-      if(id_coss>0)  xconv(id_coss)=0.5
-      if(id_codu>0)  xconv(id_codu)=0.6
-      if(id_scdu>0)  xconv(id_scdu)=0.6  !!JE fix
-
-      masse(:)=1.
-      if(id_prec>0)  masse(id_prec)=32.
-      if(id_fine>0)  masse(id_fine)=6.02e23
-      if(id_coss>0)  masse(id_coss)=6.02e23
-      if(id_codu>0)  masse(id_codu)=6.02e23 
-      if(id_scdu>0)  masse(id_scdu)=6.02e23 
-
-      henry(:)=0.
-      if(id_prec>0)  henry(id_prec)=1.4
-      if(id_fine>0)  henry(id_fine)=0.0
-      if(id_coss>0)  henry(id_coss)=0.0
-      if(id_codu>0)  henry(id_codu)=0.0
-      if(id_scdu>0)  henry(id_scdu)=0.0
-      !henry= (/1.4, 0.0, 0.0, 0.0/)
-      kk(:)=0.
-      if(id_prec>0)  kk(id_prec)=2900.
-      if(id_fine>0)  kk(id_fine)=0.0
-      if(id_coss>0)  kk(id_coss)=0.0
-      if(id_codu>0)  kk(id_codu)=0.0
-      if(id_scdu>0)  kk(id_scdu)=0.0
-      !kk = (/2900., 0., 0., 0./)
-      alpha_r(:)=0.
-      if(id_prec>0)  alpha_r(id_prec)=0.0
-      if(id_fine>0)  alpha_r(id_fine)=0.001
-      if(id_coss>0)  alpha_r(id_coss)=0.001
-      if(id_codu>0)  alpha_r(id_codu)=0.001
-      if(id_scdu>0)  alpha_r(id_scdu)=0.001  !JE fix
-      alpha_s(:)=0.
-      if(id_prec>0)  alpha_s(id_prec)=0.0
-      if(id_fine>0)  alpha_s(id_fine)=0.01
-      if(id_coss>0)  alpha_s(id_coss)=0.01
-      if(id_codu>0)  alpha_s(id_codu)=0.01
-      if(id_scdu>0)  alpha_s(id_scdu)=0.01  !JE fix
-
-!      alpha_r =  (/0., 0.001, 0.001, 0.001/)
-!      alpha_s = (/0., 0.01, 0.01, 0.01/)
-
-! nhl      DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
-! nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
-      !vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
-      vdep_oce(:)=0.
-      if(id_prec>0)  vdep_oce(id_prec) = 0.28
-      if(id_fine>0)  vdep_oce(id_fine) = 0.28
-      if(id_coss>0)  vdep_oce(id_coss) = 1.2
-      if(id_codu>0)  vdep_oce(id_codu) = 1.2
-      if(id_scdu>0)  vdep_oce(id_scdu) = 1.2
-      vdep_sic(:)=0.
-      if(id_prec>0)  vdep_sic(id_prec) = 0.2
-      if(id_fine>0)  vdep_sic(id_fine) = 0.17
-      if(id_coss>0)  vdep_sic(id_coss) = 1.2
-      if(id_codu>0)  vdep_sic(id_codu) = 1.2
-      if(id_scdu>0)  vdep_sic(id_scdu) = 1.2
-
-      !vdep_sic = (/0.2, 0.17, 1.2, 1.2/)     
-      !vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
-      vdep_ter(:)=0.
-      if(id_prec>0)  vdep_ter(id_prec) = 0.3
-      if(id_fine>0)  vdep_ter(id_fine) = 0.14
-      if(id_coss>0)  vdep_ter(id_coss) = 1.2
-      if(id_codu>0)  vdep_ter(id_codu) = 1.2
-      if(id_scdu>0)  vdep_ter(id_scdu) = 1.2
-
-      vdep_lic(:)=0.
-      if(id_prec>0)  vdep_lic(id_prec) = 0.2
-      if(id_fine>0)  vdep_lic(id_fine) = 0.17
-      if(id_coss>0)  vdep_lic(id_coss) = 1.2
-      if(id_codu>0)  vdep_lic(id_codu) = 1.2
-      if(id_scdu>0)  vdep_lic(id_scdu) = 1.2
-
-
-      ! convective KE lessivage aer params:
-      ccntrAA_spla(:)=0.
-      if(id_prec>0)  ccntrAA_spla(id_prec)=-9999.
-      if(id_fine>0)  ccntrAA_spla(id_fine)=0.7
-      if(id_coss>0)  ccntrAA_spla(id_coss)=1.0
-      if(id_codu>0)  ccntrAA_spla(id_codu)=0.7
-      if(id_scdu>0)  ccntrAA_spla(id_scdu)=0.7
-
-      ccntrENV_spla(:)=0.
-      if(id_prec>0)  ccntrENV_spla(id_prec)=-9999.
-      if(id_fine>0)  ccntrENV_spla(id_fine)=0.7
-      if(id_coss>0)  ccntrENV_spla(id_coss)=1.0
-      if(id_codu>0)  ccntrENV_spla(id_codu)=0.7
-      if(id_scdu>0)  ccntrENV_spla(id_scdu)=0.7
-
-      coefcoli_spla(:)=0.
-      if(id_prec>0)  coefcoli_spla(id_prec)=-9999.
-      if(id_fine>0)  coefcoli_spla(id_fine)=0.001
-      if(id_coss>0)  coefcoli_spla(id_coss)=0.001
-      if(id_codu>0)  coefcoli_spla(id_codu)=0.001
-      if(id_scdu>0)  coefcoli_spla(id_scdu)=0.001
-
-      !vdep_lic = (/0.2, 0.17, 1.2, 1.2/)      
-!
-
-      iscm3=.false.
-      if (debutphy) then
-!$OMP MASTER
-         CALL suphel
-         print *, 'let s check nbtr=', nbtr
-! JE before put in zero
-      IF (lminmax) THEN
-        DO it=1,nbtr
-        CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan init phytracr')
-        ENDDO        
-        DO it=1,nbtr
-        CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'minmax init phytracr')
-        ENDDO
-        CALL minmaxsource(source_tr,qmin,qmax,'maxsource init phytracr')
-      ENDIF
-! JE   initializon to cero the tracers     
-!         DO it=1, nbtr
-!            tr_seri(:,:,it)=0.0
-!         ENDDO
-! JE end     
-! Initializing to zero tr_seri for comparison purposes
-!        tr_seri(:,:,:)=0.0
-!
-!        DO it=1,nbtr
-!           trm_aux(it)=0.0
-!           src_aux(it)=0.0
-!           diag_trm(it)=0.0
-!           diag_drydep(it)=0.0
-!           diag_wetdep(it)=0.0
-!           diag_cvtdep(it)=0.0
-!           diag_emissn(it)=0.0
-!        ENDDO
-!        diag_g2part=0.0
-         print *,'PREPARE FILES TO SAVE VARIABLES'
-!
-         nbjour=30
-         ecrit_tra =   NINT(86400./pdtphys)                    !--1-day  average
-         ecrit_tra_h = NINT(86400./pdtphys*0.25)               !--6-hour average
-         ecrit_tra_m = NINT(86400./pdtphys*FLOAT(nbjour))      !--1-mth  average
-         print *,'ecrit_tra=', pdtphys, ecrit_tra
-
-         IF (ok_histrac) THEN
-           IF (is_mpi_root .AND. is_omp_root) THEN
-  
-           itra=0
-!
-           CALL ymds2ju(1900, 1, 1, 0.0, zjulian)
-!
-!           print *, 'klon,iim,jjm+1 = ',klon,iim,jjm+1
-           print *, 'glo klon,iim,jjm+1 = ',klon_glo,nbp_lon,nbp_lat
-           CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,rlon,zx_lon_glo)
-!
-!           DO i = 1, iim
-           DO i = 1, nbp_lon
-             zx_lon_glo(i,1) = rlon(i+1)
-             zx_lon_glo(i,nbp_lat) = rlon(i+1)
-           ENDDO
-!
-      CALL histbeg("histrac_spl", nbp_lon,zx_lon_glo,            &
-                       nbp_lat,zx_lat_glo,                       &
-                       1,nbp_lon,1,nbp_lat, 0, zjulian, pdtphys, &
-                       nhori1, nid_tra1)
-!
-      CALL histbeg("lessivage_spl", nbp_lon,zx_lon_glo,            &
-                       nbp_lat,zx_lat_glo,                         &
-                       1,nbp_lon,1,nbp_lat, 0, zjulian, pdtphys,   &
-                       nhori2, nid_tra2)
-! 
-      CALL histbeg("traceur_spl", nbp_lon,zx_lon_glo,               &
-                       nbp_lat,zx_lat_glo,                         &
-                      1,nbp_lon,1,nbp_lat, 0, zjulian, pdtphys,    &
-                       nhori3, nid_tra3)
-!
-      CALL histvert(nid_tra1, "presnivs", "Vertical levels", "mb",  &
-                      nbp_lev, presnivs, nvert)
-!
-      CALL histvert(nid_tra2, "presnivs", "Vertical levels", "mb",  &
-                      nbp_lev, presnivs, nvert)
-!
-      CALL histvert(nid_tra3, "presnivs", "Vertical levels", "mb",  &
-                      nbp_lev, presnivs, nvert)
-!
-           zsto = pdtphys
-           zout = pdtphys * FLOAT(ecrit_tra)
-           zout_h = pdtphys * FLOAT(ecrit_tra_h)
-           zout_m = pdtphys * FLOAT(ecrit_tra_m)
-           print *,'zsto zout=', zsto, zout
-
-!
-!----------------- HISTORY FILES OF TRACER EMISSIONS -------------------
-!
-! HISTRAC
-!
-       CALL histdef(nid_tra1, "fluxbb", "Flux BB", "mg/m2/s",       &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,     &
-                       "ave(X)", zsto,zout)                         
-!                                                                   
-      CALL histdef(nid_tra1, "fluxff", "Flux FF", "mg/m2/s",        & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,      &
-                       "ave(X)", zsto,zout)                          
-!                                                                    
-      CALL histdef(nid_tra1, "fluxbcbb", "Flux BC-BB", "mg/m2/s",    &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1, "fluxbcff", "Flux BC-FF", "mg/m2/s",     &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,        &
-                       "ave(X)", zsto,zout)                            
-!                                                                      
-      CALL histdef(nid_tra1, "fluxbcnff", "Flux BC-NFF", "mg/m2/s",    &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                             
-!                                                                       
-      CALL histdef(nid_tra1, "fluxbcba", "Flux BC-BA", "mg/m2/s",       &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,          &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-      CALL histdef(nid_tra1, "fluxbc", "Flux BC", "mg/m2/s",    &         
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,  &
-                       "ave(X)", zsto,zout)                      
-!                                                                
-      CALL histdef(nid_tra1, "fluxombb", "Flux OM-BB", "mg/m2/s" ,  &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,      &
-                       "ave(X)", zsto,zout)                          
-!                                                                    
-      CALL histdef(nid_tra1, "fluxomff", "Flux OM-FF", "mg/m2/s",    &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1, "fluxomnff", "Flux OM-NFF", "mg/m2/s",  & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1, "fluxomba", "Flux OM-BA", "mg/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1, "fluxomnat", "Flux OM-NT", "mg/m2/s",   & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1, "fluxom", "Flux OM", "mg/m2/s",         & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1,"fluxh2sff","Flux H2S FF","mgS/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1,"fluxh2snff","Flux H2S non-FF",          & 
-                       "mgS/m2/s",nbp_lon,nbp_lat,nhori1, 1,1,1,     &
-                        -99, 32,                                     & 
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1,"fluxso2ff","Flux SO2 FF","mgS/m2/s",    &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,       &
-                       "ave(X)", zsto,zout)                           
-!                                                                     
-      CALL histdef(nid_tra1,"fluxso2nff","Flux SO2 non-FF",          & 
-                       "mgS/m2/s",nbp_lon,nbp_lat,nhori1, 1,1,1,     &
-                        -99, 32,                                     &
-                       "ave(X)", zsto,zout)                           
-!                                                                      
-      CALL histdef(nid_tra1, "fluxso2bb", "Flux SO2 BB","mgS/m2/s",   & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,        &  
-                       "ave(X)", zsto,zout)                           
-!                                                                      
-      CALL histdef(nid_tra1,"fluxso2vol","Flux SO2 Vol","mgS/m2/s",    &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1, "fluxso2ba", "Flux SO2 Ba","mgS/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1, "fluxso2", "Flux SO2","mgS/m2/s",         & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxso4ff","Flux SO4 FF","mgS/m2/s",      & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxso4nff","Flux SO4 non-FF",            & 
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, &
-                   "ave(X)", zsto,zout)                                
-!                                                                       
-      CALL histdef(nid_tra1, "fluxso4bb", "Flux SO4 BB","mgS/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1, "fluxso4ba", "Flux SO4 Ba","mgS/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1, "fluxso4", "Flux SO4","mgS/m2/s",         & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1, "fluxdms", "Flux DMS", "mgS/m2/s",        & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxh2sbio","Flux H2S Bio","mgS/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1, "fluxdustec",                             & 
-                                      "Flux Dust EC", "mg/m2/s",       &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                             
-!                                                                       
-      CALL histdef(nid_tra1,"fluxddfine","DD Fine Mode","mg/m2/s",     &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxddcoa","DD Coarse Mode","mg/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxddsco","DD SCoarse Mode","mg/m2/s",   & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxdd","Flux DD","mg/m2/s",              & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxssfine","SS Fine Mode","mg/m2/s",     & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxsscoa","SS Coarse Mode","mg/m2/s",    & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-      CALL histdef(nid_tra1,"fluxss","Flux SS","mg/m2/s",              & 
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                            
-!                                                                       
-!nhl          CALL histdef(nid_tra1,"fluxso4chem","SO4 chem prod",      
-!nhl    .                  "gAer/kgAir",
-!nhl    .                  nbp_lon,nbp_lat,nhori1, nbp_lev,1,nbp_lev,nvert, 32,
-!nhl    .                  "ave(X)", zsto,zout)
-!
-          CALL histdef(nid_tra1,"flux_sparam_ind","Ind emiss",      &
-                       "mg/m2/s",                                   &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,      & 
-                       "ave(X)", zsto,zout)                           
-!                                                                    
-          CALL histdef(nid_tra1,"flux_sparam_bb","BB emiss",        &
-                       "mg/m2/s",                                   &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,      &
-                       "ave(X)", zsto,zout)                          
-!                                                                    
-          CALL histdef(nid_tra1,"flux_sparam_ff","FF emiss",        &
-                       "mg/m2/s",                                   &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,      &
-                       "ave(X)", zsto,zout)                          
-!                                                                    
-          CALL histdef(nid_tra1,"flux_sparam_ddfine","DD fine emiss",  &
-                       "mg/m2/s",                                      &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                             
-!                                                                       
-          CALL histdef(nid_tra1,"flux_sparam_ddcoa","DD coarse emiss",  & 
-                       "mg/m2/s",                                       &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,          &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-          CALL histdef(nid_tra1,"flux_sparam_ddsco","DD Scoarse emiss", &
-                       "mg/m2/s",                                       &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,          &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-          CALL histdef(nid_tra1,"flux_sparam_ssfine","SS fine emiss",   &
-                       "mg/m2/s",                                       &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,          &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-          CALL histdef(nid_tra1,"flux_sparam_sscoa","SS coarse emiss",  &
-                       "mg/m2/s",                                       &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,          &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-          CALL histdef(nid_tra1,"u10m","Zonal wind at 10 m",            &
-                       "m/s",                                           &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,          &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-          CALL histdef(nid_tra1,"v10m","Meridional wind at 10 m",       &
-                       "m/s",                                           &
-                       nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32,          &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-!nhl          CALL histdef(nid_tra1,"flux_sparam_sulf","SO4 chem prod", 
-!nhl    .                  "gAer/kgAir",
-!nhl    .                  nbp_lon,nbp_lat,nhori1, nbp_lev,1,nbp_lev,nvert, 32,
-!nhl    .                  "ave(X)", zsto,zout)
-!
-! TRACEUR
-!
-          CALL histdef(nid_tra3, "taue550", "Tau ext 550", " ",           &
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            &
-                       "ave(X)", zsto,zout)                                  
-!                                                                           
-          CALL histdef(nid_tra3, "taue670", "Tau ext 670", " ",            &  
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue865", "Tau ext 865", " ",            & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue550_tr2", "Tau ext 550tr2", " ",     & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue670_tr2", "Tau ext 670tr2", " ",     & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue865_tr2", "Tau ext 865tr2", " ",     & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue550_ss", "Tau ext 550ss", " ",       & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue670_ss", "Tau ext 670ss", " ",       & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue865_ss", "Tau ext 865ss", " ",       & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,             &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue550_dust", "Tau ext 550dust", " "    & 
-                       ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue670_dust", "Tau ext 670dust", " "    & 
-                       ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra3, "taue865_dust", "Tau ext 865dust", " "    & 
-                       ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            &
-                       "ave(X)", zsto,zout)                                 
-                                                                            
-          CALL histdef(nid_tra3, "taue550_dustsco",                     &   
-                       "Tau ext 550dustsco", " "                        &
-                       ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-           CALL histdef(nid_tra3, "taue670_dustsco",                    &
-                       "Tau ext 670dustsco", " "                        &
-                       ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                              
-!                                                                        
-           CALL histdef(nid_tra3, "taue865_dustsco",                    &
-                       "Tau ext 865dustsco", " "                        &
-                       ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,         &
-                       "ave(X)", zsto,zout)                              
-                                                                         
-                                                                        
-        CALL histdef(nid_tra3, "taue550_aqua", "Tau ext 550 aqua", " ",   & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            &
-                       "inst(X)", zout,zout)                               
-      CALL histdef(nid_tra3, "taue550_terra", "Tau ext 550 terra", " ",   & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            & 
-                       "inst(X)", zout,zout)                               
-        CALL histdef(nid_tra3, "taue670_aqua", "Tau ext 670 aqua", " ",   & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            & 
-                       "inst(X)", zout,zout)                               
-      CALL histdef(nid_tra3, "taue670_terra", "Tau ext 670 terra", " ",   & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            & 
-                       "inst(X)", zout,zout)                               
-        CALL histdef(nid_tra3, "taue865_aqua", "Tau ext 865 aqua", " ",   & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            & 
-                       "inst(X)", zout,zout)                               
-      CALL histdef(nid_tra3, "taue865_terra", "Tau ext 865 terra", " ",   & 
-                       nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,            & 
-                       "inst(X)", zout,zout)                               
-                                                                           
-                                                                           
-          DO it=1, nbtr
-!
-          WRITE(str2,'(i2.2)') it
-!
-          CALL histdef(nid_tra3, "trm"//str2, "Burden No."//str2,         & 
-                     "mgS/m2", nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,    &
-                       "ave(X)", zsto,zout)                                
-!                                                                          
-          CALL histdef(nid_tra3, "sconc"//str2, "Surf Conc. No."//str2,   & 
-                       "mg/m3", nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32,   &
-                       "ave(X)", zsto,zout)                                
-!                                                                          
-! LESSIVAGE                                                                 
-!
-          CALL histdef(nid_tra2, "flux"//str2, "emission"//str2,           &  
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,     &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra2, "ds"//str2, "Depot sec No."//str2,        & 
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,     &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra2,"dh"//str2,                                 &
-                    "Depot hum No."//str2,                                 &
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,     &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra2,"dtrconv"//str2,                           &
-                     "Tiedke convective"//str2,                            &
-                  "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,      &
-                       "ave(X)", zsto,zout)                                 
-                                                                            
-          CALL histdef(nid_tra2,"dtherm"//str2,                            &
-                       "Thermals dtracer"//str2,                           &
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,     &
-                       "ave(X)", zsto,zout)                                 
-                                                                            
-          CALL histdef(nid_tra2,"dhkecv"//str2,                            &
-                       "KE dep hum convective"//str2,                      &
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,     &
-                       "ave(X)", zsto,zout)                                 
-          CALL histdef(nid_tra2,"dhkelsc"//str2,                            &
-                       "KE dep hum large scale"//str2,                      &
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,      &
-                       "ave(X)", zsto,zout)                                  
-                                                                             
-                                
-          CALL histdef(nid_tra2,"d_tr_ds"//str2,                            &
-                       " Tendance dep sec"//str2,                      &
-                   "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32,     &
-                       "ave(X)", zsto,zout)                                 
-
-                                            
-          CALL histdef(nid_tra2,"d_tr_cv"//str2,                          & 
-                       "cvltr d_tr_cv"//str2,                             &
-                       "mgS/m2/s",                                        &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,   &
-                       "ave(X)", zsto,zout)                                 
-          CALL histdef(nid_tra2,"d_tr_trsp"//str2                         & 
-                       ,"cvltr d_tr_trsp"//str2,                          &
-                       "mgS/m2/s",                                        &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,   &
-                       "ave(X)", zsto,zout)                                
-          CALL histdef(nid_tra2,"d_tr_sscav"//str2                        & 
-                       ,"cvltr d_tr_sscav"//str2,"mgS/m2/s",                 &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,      &
-                       "ave(X)", zsto,zout)                                  
-          CALL histdef(nid_tra2,"d_tr_sat"//str2                            &  
-                       ,"cvltr d_tr_sat"//str2,                             &  
-                       "mgS/m2/s",                                          & 
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                  
-        CALL histdef(nid_tra2,"d_tr_uscav"//str2,                           & 
-                    "cvltr d_tr_uscav"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                  
-        CALL histdef(nid_tra2,"d_tr_insc"//str2,                           &   !!!
-                    "cvltr d_tr_insc"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                  
-        CALL histdef(nid_tra2,"d_tr_bcscav"//str2,                           & 
-                    "cvltr d_tr_bcscav"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                  
-        CALL histdef(nid_tra2,"d_tr_evapls"//str2,                           & 
-                    "cvltr d_tr_evapls"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                  
-        CALL histdef(nid_tra2,"d_tr_ls"//str2,                           & 
-                    "cvltr d_tr_ls"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                     !!
-        CALL histdef(nid_tra2,"d_tr_dyn"//str2,                           & 
-                    "large-scale d_tr_dyn"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                     !!
-        CALL histdef(nid_tra2,"d_tr_cl"//str2,                           & 
-                    "cvltr d_tr_cl"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                 !!
-        CALL histdef(nid_tra2,"d_tr_th"//str2,                           & 
-                    "cvltr d_tr_th"//str2,                               &
-                       "mgS/m2/s",                                          &
-                   nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32,     &
-                       "ave(X)", zsto,zout)                                 !!
-                                                                             
-
-
-!
-          ENDDO
-!
-          CALL histdef(nid_tra2, "sed_ss", "Sedmet. Tr3",                   & 
-                       "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99,       &
-                         32,                                                &
-                       "ave(X)", zsto,zout)                                  
-!                                                                            
-          CALL histdef(nid_tra2, "sed_dust", "Sedmet. Tr4",                 &
-                       "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1,            &
-                        -99, 32,                                            &
-                       "ave(X)", zsto,zout)                                  
-!                                                                            
-          CALL histdef(nid_tra2, "sed_dustsco", "Sedmet. Tr5",              &
-                       "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1,            &
-                        -99, 32,                                            &
-                       "ave(X)", zsto,zout)                                  
-!                                                                            
-          CALL histdef(nid_tra2, "g2p_gas", "Gas2particle gas sink",       & 
-                   "mg-S/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1,-99, 32,     &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-          CALL histdef(nid_tra2, "g2p_aer", "Gas2particle tr2 src",        & 
-                       "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1,-99,32,    &
-                       "ave(X)", zsto,zout)                                 
-!                                                                           
-!-------------------------------------------------------------------        
-!
-          CALL histend(nid_tra1)
-!
-          CALL histend(nid_tra2)
-!
-          CALL histend(nid_tra3)
-!
-!-------------------------------------------------------------------
-
-!       nbjour=1
-         ENDIF ! mpi root
-         ENDIF !--ok_histrac
-
-!
-!        IF (.NOT.edgar.AND.bateau) THEN
-!        PRINT *,'ATTENTION risque de compter double les bateaux'
-!        STOP
-!        ENDIF
-!
-!
-!
-!$OMP END MASTER
-!$OMP BARRIER
-      endif ! debutphy
-!
-!======================================================================
-! Initialisations
-!======================================================================
-!
-!
-! je  KE init
-      IF (debutphy) THEN
-!$OMP MASTER
-
-      ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
-      ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr))
-      ALLOCATE(d_tr_cv(klon,klev,nbtr))
-      ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
-      ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
-      ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
-      ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
-      ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr))
-      ALLOCATE(qDi(klon,klev,nbtr))
-      ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
-      ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
-      ALLOCATE(d_tr_th(klon,klev,nbtr))
-      ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr))
-      ALLOCATE(d_tr_lessi_nucl(klon,klev,nbtr))
-
+!AS : This subroutine centralises the ALLOCATE needed for the 1st call of
+!     phys_output_write_spl in physiq
+
+    USE dimphy
+    USE infotrac_phy, ONLY: nbtr
+    USE dustemission_mod, ONLY :  dustemis_out_init
+
+    ! pour les variables m[1-3]dflux
+    CALL dustemis_out_init() 
+
+!traceur
       ALLOCATE( diff_aod550_tot(klon)     )
       ALLOCATE( diag_aod670_tot(klon)     )
@@ -1905,5 +457,36 @@
       ALLOCATE( diag_aod670_dustsco(klon)  )
       ALLOCATE( diag_aod865_dustsco(klon)  )
-
+      !AS: les 15 vars _terra et 15 _aqua suivantes sont groupees differemment dans spla_output_write.h
+      ALLOCATE( aod550_terra(klon))
+      ALLOCATE( aod550_tr2_terra(klon))
+      ALLOCATE( aod550_ss_terra(klon))
+      ALLOCATE( aod550_dust_terra(klon))
+      ALLOCATE( aod550_dustsco_terra(klon))
+      ALLOCATE( aod670_terra(klon))
+      ALLOCATE( aod670_tr2_terra(klon))
+      ALLOCATE( aod670_ss_terra(klon))
+      ALLOCATE( aod670_dust_terra(klon))
+      ALLOCATE( aod670_dustsco_terra(klon))
+      ALLOCATE( aod865_terra(klon))
+      ALLOCATE( aod865_tr2_terra(klon))
+      ALLOCATE( aod865_ss_terra(klon))
+      ALLOCATE( aod865_dust_terra(klon))
+      ALLOCATE( aod865_dustsco_terra(klon))
+
+      ALLOCATE( aod550_aqua(klon))
+      ALLOCATE( aod550_tr2_aqua(klon))
+      ALLOCATE( aod550_ss_aqua(klon))
+      ALLOCATE( aod550_dust_aqua(klon))
+      ALLOCATE( aod550_dustsco_aqua(klon))
+      ALLOCATE( aod670_aqua(klon))
+      ALLOCATE( aod670_tr2_aqua(klon))
+      ALLOCATE( aod670_ss_aqua(klon))
+      ALLOCATE( aod670_dust_aqua(klon))
+      ALLOCATE( aod670_dustsco_aqua(klon))
+      ALLOCATE( aod865_aqua(klon))
+      ALLOCATE( aod865_tr2_aqua(klon))
+      ALLOCATE( aod865_ss_aqua(klon))
+      ALLOCATE( aod865_dust_aqua(klon))
+      ALLOCATE( aod865_dustsco_aqua(klon))
 
       ALLOCATE(  sconc01(klon)     )
@@ -1918,5 +501,5 @@
       ALLOCATE(  trm05(klon)     )
 
-
+! Lessivage
       ALLOCATE(  flux01(klon)     )
       ALLOCATE(  flux02(klon)     )
@@ -1984,7 +567,5 @@
       ALLOCATE(  d_tr_uscav04(klon,klev))
       ALLOCATE(  d_tr_uscav05(klon,klev))
-      
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       ALLOCATE(  d_tr_insc01(klon,klev))
       ALLOCATE(  d_tr_insc02(klon,klev))
@@ -2007,4 +588,5 @@
       ALLOCATE(  d_tr_ls04(klon,klev))
       ALLOCATE(  d_tr_ls05(klon,klev))
+
       ALLOCATE(  d_tr_dyn01(klon,klev))
       ALLOCATE(  d_tr_dyn02(klon,klev))
@@ -2012,4 +594,5 @@
       ALLOCATE(  d_tr_dyn04(klon,klev))
       ALLOCATE(  d_tr_dyn05(klon,klev))
+
       ALLOCATE(  d_tr_cl01(klon,klev))
       ALLOCATE(  d_tr_cl02(klon,klev))
@@ -2023,11 +606,4 @@
       ALLOCATE(  d_tr_th05(klon,klev))
 
-      ALLOCATE( sed_ss3D(klon,klev))
-      ALLOCATE( sed_dust3D(klon,klev))
-      ALLOCATE( sed_dustsco3D(klon,klev))
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
       ALLOCATE( sed_ss(klon))
       ALLOCATE( sed_dust(klon))
@@ -2036,4 +612,13 @@
       ALLOCATE( his_g2paer(klon))
 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ALLOCATE( sed_ss3D(klon,klev))
+      ALLOCATE( sed_dust3D(klon,klev))
+      ALLOCATE( sed_dustsco3D(klon,klev))
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! histrac_spl
+!
       ALLOCATE( fluxbb(klon))
       ALLOCATE( fluxff(klon))
@@ -2083,5 +668,968 @@
       ALLOCATE( v10m_ss(klon))
 
-
+!AS: in phys_output_write_spl, but not in spla_output_write.h
+!------------------------------------------------------
+      ALLOCATE(d_tr_cl(klon,klev,nbtr))
+      ALLOCATE(d_tr_th(klon,klev,nbtr))
+      ALLOCATE(d_tr_cv(klon,klev,nbtr))
+      ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr))
+      ALLOCATE(d_tr_lessi_nucl(klon,klev,nbtr))
+      ALLOCATE(d_tr_insc(klon,klev,nbtr))
+      ALLOCATE(d_tr_bcscav(klon,klev,nbtr))
+      ALLOCATE(d_tr_evapls(klon,klev,nbtr))
+      ALLOCATE(d_tr_ls(klon,klev,nbtr))
+      ALLOCATE(d_tr_trsp(klon,klev,nbtr))
+      ALLOCATE(d_tr_sscav(klon,klev,nbtr))
+      ALLOCATE(d_tr_sat(klon,klev,nbtr))
+      ALLOCATE(d_tr_uscav(klon,klev,nbtr))
+      
+END SUBROUTINE phytracr_spl_out_init
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  IMPLICIT NONE
+  INTEGER klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust
+
+  ALLOCATE(  tsol(klon)              )
+
+!AS: IF permettant le debranchage des coefs de Jeronimo Escribano: fichiers *_meta
+! nbreg_* sont initialisés à 1 dans phytracr_spl, if debutphy, 
+! avant d'appeler la subroutine presente, phytracr_spl_ini 
+! (phytracr_spl_ini appele readregionsdims2_spl, 
+! qui lit et fait "bcast" de nbreg_ind,_bb,_dust,_wstardust dans fichiers regions_*_meta)
+IF("ASSIM"=="YES") THEN
+  fileregionsdimsind='regions_ind_meta'
+  fileregionsdimsdust='regions_dustacc_meta'
+!  fileregionsdimsdust='regions_dust_meta'
+  fileregionsdimsbb='regions_bb_meta'
+  fileregionsdimswstar='regions_pwstarwake_meta'
+  call  readregionsdims2_spl(nbreg_ind,fileregionsdimsind)
+  call  readregionsdims2_spl(nbreg_dust,fileregionsdimsdust)
+  call  readregionsdims2_spl(nbreg_bb,fileregionsdimsbb)
+  call  readregionsdims2_spl(nbreg_wstardust,fileregionsdimswstar)
+  ENDIF ! ASSIM
+! fin debranchage
+
+!readregions_spl()
+
+  ALLOCATE(scale_param_ind(nbreg_ind))
+  ALLOCATE(scale_param_bb(nbreg_bb))
+  ALLOCATE(scale_param_ff(nbreg_ind))
+  ALLOCATE(scale_param_dustacc(nbreg_dust))
+  ALLOCATE(scale_param_dustcoa(nbreg_dust))
+  ALLOCATE(scale_param_dustsco(nbreg_dust))
+  ALLOCATE(param_wstarBLperregion(nbreg_wstardust))
+  ALLOCATE(param_wstarWAKEperregion(nbreg_wstardust))
+  ALLOCATE(  dust_ec(klon)           )
+  ALLOCATE(  u10m_ec(klon)           )
+  ALLOCATE(  v10m_ec(klon)           )
+  ALLOCATE(  lmt_so2volc_cont(klon)  )
+  ALLOCATE(  lmt_altvolc_cont(klon)  )
+  ALLOCATE(  lmt_so2volc_expl(klon)  )
+  ALLOCATE(  lmt_altvolc_expl(klon)  )
+  ALLOCATE(  lmt_so2ff_l(klon)       )   
+  ALLOCATE(  lmt_so2ff_h(klon)       )  
+  ALLOCATE(  lmt_so2nff(klon)        )  
+  ALLOCATE(  lmt_so2ba(klon)         )  
+  ALLOCATE(  lmt_so2bb_l(klon)       )
+  ALLOCATE(  lmt_so2bb_h(klon)       )  
+  ALLOCATE(  lmt_dmsconc(klon)       )  
+  ALLOCATE(  lmt_dmsbio(klon)        )  
+  ALLOCATE(  lmt_h2sbio(klon)        )  
+  ALLOCATE(  lmt_bcff(klon)          )
+  ALLOCATE(  lmt_bcnff(klon)         )
+  ALLOCATE(  lmt_bcbb_l(klon)        )
+  ALLOCATE(  lmt_bcbb_h(klon)        )
+  ALLOCATE(  lmt_bcba(klon)          )
+  ALLOCATE(  lmt_omff(klon)          )  
+  ALLOCATE(  lmt_omnff(klon)         )  
+  ALLOCATE(  lmt_ombb_l(klon)        )  
+  ALLOCATE(  lmt_ombb_h(klon)        )  
+  ALLOCATE(  lmt_omnat(klon)         )  
+  ALLOCATE(  lmt_omba(klon)          )           
+  ALLOCATE(lmt_sea_salt(klon,ss_bins)) 
+
+
+
+
+  !temporal hardcoded null inicialization of assimilation emmision factors
+!AS: scale_param sont ensuite lus dans modvalues.nc 
+! par la subroutine read_scalenc, appelee par readscaleparamsnc_spl
+  scale_param_ssacc=1.
+  scale_param_sscoa=1.
+  scale_param_ind(:)=1.
+  scale_param_bb(:)=1.
+  scale_param_ff(:)=1.
+  scale_param_dustacc(:)=1.
+  scale_param_dustcoa(:)=1.
+  scale_param_dustsco(:)=1.
+  param_wstarBLperregion(:)=0.
+  param_wstarWAKEperregion(:)=0.
+
+
+RETURN
+END SUBROUTINE phytracr_spl_ini
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      SUBROUTINE phytracr_spl ( debutphy,lafin,jD_cur,jH_cur,iflag_conv, &  ! I
+                      pdtphys,ftsol,                                   &  ! I
+                      t_seri,q_seri,paprs,pplay,RHcl,                  &  ! I
+                      pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,          &  ! I
+                      coefh, cdragh, cdragm, yu1, yv1,                 &  ! I
+                      u_seri, v_seri, rlat,rlon,                       &  ! I
+                      pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,            &  ! I
+                      da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,     &  ! I
+                      epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,      &  ! I
+                      evapls,wdtrainA,  wdtrainM,wght_cvfd,              &  ! I
+                      fm_therm, entr_therm, rneb,                      &  ! I
+                      beta_fisrt,beta_v1,                              &  ! I
+                      zu10m,zv10m,wstar,ale_bl,ale_wake,               &  ! I
+                      d_tr_dyn,tr_seri)                                            ! O
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE IOIPSL
+      USE dimphy
+      USE infotrac
+      USE indice_sol_mod
+      USE write_field_phy
+     
+
+      USE mod_phys_lmdz_transfert_para
+
+  USE phys_cal_mod, only: jD_1jan,year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
+       mth_cur, phys_cal_update
+
+!
+      IMPLICIT none
+!
+
+!======================================================================
+! Auteur(s) FH
+! Objet: Moniteur general des tendances traceurs
+!
+! Remarques en vrac:
+! ------------------
+! 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien 
+! les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
+!======================================================================
+#include "dimensions.h"
+#include "chem.h"
+#include "chem_spla.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "paramet.h"
+#include "thermcell.h"
+
+!======================================================================
+
+! Arguments:
+!
+!  EN ENTREE:
+!  ==========
+!
+!  divers:
+!  -------
+!
+      real,intent(in) :: pdtphys  ! pas d'integration pour la physique (seconde)
+      REAL, intent(in):: jD_cur, jH_cur
+      real, intent(in) ::  ftsol(klon,nbsrf)  ! temperature du sol par type
+      real, intent(in) ::  t_seri(klon,klev)  ! temperature
+      real, intent(in) ::  u_seri(klon,klev)  ! vent
+      real , intent(in) :: v_seri(klon,klev)  ! vent
+      real , intent(in) :: q_seri(klon,klev)  ! vapeur d eau kg/kg
+
+LOGICAL,  INTENT(IN)                          :: lafin
+
+      real tr_seri(klon,klev,nbtr) ! traceur  
+      real tmp_var(klon,klev) ! auxiliary variable to replace traceur  
+      real tmp_var2(klon,nbtr) ! auxiliary variable to replace source
+      real tmp_var3(klon,klev,nbtr) ! auxiliary variable 3D  
+      real dummy1d ! JE auxiliary variable
+      real aux_var2(klon) ! auxiliary variable to replace traceur  
+      real aux_var3(klon,klev) ! auxiliary variable to replace traceur  
+      real d_tr(klon,klev,nbtr)    ! traceur  tendance
+      real sconc_seri(klon,nbtr) ! surface concentration of traceur  
+!
+      integer nbjour
+      save nbjour
+!$OMP THREADPRIVATE(nbjour)
+!
+      INTEGER  masque_aqua_cur(klon)
+      INTEGER  masque_terra_cur(klon)
+      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_aqua  !mask for 1 day
+      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_terra !
+!$OMP THREADPRIVATE(masque_aqua,masque_terra)
+
+  INTEGER, SAVE :: nbreg_dust, nbreg_ind, nbreg_bb, nbreg_ss,nbreg_wstardust
+  !$OMP THREADPRIVATE(nbreg_dust, nbreg_ind, nbreg_bb,nbreg_ss,nbreg_wstardust)
+
+
+
+      REAL lmt_dms(klon)           ! emissions de dms
+
+!JE20150518<<
+      REAL, DIMENSION(klon_glo)  :: aod550_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
+
+      REAL, DIMENSION(klon_glo)  :: aod550_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod550_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod670_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+      REAL, DIMENSION(klon_glo)  :: aod865_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
+!!!!!!!!!!!!!
+!JE20150518>>
+
+
+
+
+      real , intent(in) :: paprs(klon,klev+1)  ! pression pour chaque inter-couche (en Pa)
+      real , intent(in) :: pplay(klon,klev)  ! pression pour le mileu de chaque couche (en Pa)
+      real , intent(in) :: RHcl(klon,klev)  ! humidite relativen ciel clair
+      real znivsig(klev)  ! indice des couches
+      real paire(klon)
+      real, intent(in) ::  pphis(klon)
+      real, intent(in) ::  pctsrf(klon,nbsrf)
+      logical , intent(in) :: debutphy   ! le flag de l'initialisation de la physique
+!
+!  Scaling Parameters:
+!  ----------------------
+!
+      CHARACTER*50 c_Directory
+      CHARACTER*80 c_FileName1 
+      CHARACTER*80 c_FileName2
+      CHARACTER*130 c_FullName1
+      CHARACTER*130 c_FullName2
+      INTEGER :: xidx, yidx
+      INTEGER,DIMENSION(klon) :: mask_bbreg
+      INTEGER,DIMENSION(klon) :: mask_ffso2reg
+      INTEGER :: aux_mask1
+      INTEGER :: aux_mask2
+      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4 ; AS: PAS UTILISE!
+      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind  !Defines regions for SO2, BC & OM
+      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb   !Defines regions for SO2, BC & OM
+      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_dust !Defines  dust regions
+      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_wstardust !Defines  dust regions
+!$OMP THREADPRIVATE(iregion_so4,iregion_ind,iregion_bb,iregion_dust,iregion_wstardust)
+
+!  Emissions:
+
+!
+!---------------------------- SEA SALT & DUST emissions ------------------------
+      REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um
+      REAL u10m_ec1(klon),v10m_ec1(klon)
+      REAL u10m_ec2(klon),v10m_ec2(klon),dust_ec2(klon)
+      REAL dust_ec(klon)
+!     new dust emission chimere je20140522
+      REAL,DIMENSION(klon),INTENT(IN)                     :: zu10m
+      REAL,DIMENSION(klon),INTENT(IN)                     :: zv10m
+      REAL,DIMENSION(klon),INTENT(IN)  :: wstar,ale_bl,ale_wake
+
+
+!
+!  Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+     !Dynamique
+     !--------
+      REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)    :: d_tr_dyn
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  convection:
+!  -----------
+!
+      REAL , intent(in) :: pmfu(klon,klev)  ! flux de masse dans le panache montant
+      REAL , intent(in) :: pmfd(klon,klev)  ! flux de masse dans le panache descendant
+      REAL, intent(in) ::  pen_u(klon,klev) ! flux entraine dans le panache montant
+      REAL, intent(in) ::  pde_u(klon,klev) ! flux detraine dans le panache montant
+      REAL, intent(in) ::  pen_d(klon,klev) ! flux entraine dans le panache descendant
+      REAL, intent(in) ::  pde_d(klon,klev) ! flux detraine dans le panache descendant
+!
+!  Convection KE scheme:
+!  ---------------------
+!
+!! Variables pour le lessivage convectif
+       REAL,DIMENSION(klon,klev),INTENT(IN)     :: da
+       REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
+       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
+       REAL,DIMENSION(klon,klev),INTENT(IN)      :: d1a,dam
+       REAL,DIMENSION(klon,klev),INTENT(IN)     :: mp
+       REAL,DIMENSION(klon,klev),INTENT(IN)     :: upwd      ! saturated
+!            updraft mass flux
+       REAL,DIMENSION(klon,klev),INTENT(IN)     :: dnwd      ! saturated
+!            downdraft mass flux
+       INTEGER,DIMENSION(klon),INTENT(IN)     :: itop_con
+       INTEGER,DIMENSION(klon),INTENT(IN)     :: ibas_con
+       REAL,DIMENSION(klon,klev)      :: evapls
+       REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainA
+       REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainM
+
+
+       REAL,DIMENSION(klon,klev),INTENT(IN)      :: ep
+       REAL,DIMENSION(klon),INTENT(IN)           :: sigd
+       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
+       REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw
+       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
+       REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
+       REAL,DIMENSION(klon,klev),INTENT(IN)      :: eplaMm
+       REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd          !RL
+
+
+!     KE: Tendances de traceurs (Td) et flux de traceurs:
+!     ------------------------
+       REAL,DIMENSION(klon,klev)      :: Mint
+       REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
+       REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
+       REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
+
+!                                                        !tra dans pluie LS a la surf.
+!      outputs for cvltr_spl
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv_o  
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav_o
+     !!!!!!!!!!!!!!!!!
+     !!!!!!!!!!!!!!!!!
+     !!!!!!!!!!!!!!!!!
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dyn_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl_o
+       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th_o
+     !!!!!!!!!!!!!!!!!
+     !!!!!!!!!!!!!!!!!
+     !!!!!!!!!!!!!!!!!
+
+!$OMP THREADPRIVATE(d_tr_cv_o,d_tr_trsp_o,d_tr_sscav_o,d_tr_sat_o,d_tr_uscav_o)
+!$OMP THREADPRIVATE(d_tr_insc_o,d_tr_bcscav_o,d_tr_evapls_o,d_tr_ls_o)
+!$OMP THREADPRIVATE(d_tr_dyn_o,d_tr_cl_o,d_tr_th_o)
+
+
+       INTEGER ::  nsplit
+!
+
+     
+
+!
+!  Lessivage
+!  ---------
+!
+      REAL, intent(in) ::  pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--convection
+      REAL, intent(in) ::  prfl(klon,klev+1),   psfl(klon,klev+1)     !--large-scale
+      REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
+      REAL  :: ql_incloud_ref    ! ref value of in-cloud condensed water content
+
+       REAL,DIMENSION(klon,klev),INTENT(IN)   :: rneb    ! fraction nuageuse (grande echelle)
+!
+
+      REAL,DIMENSION(klon,klev) :: beta_fisrt ! taux de conversion
+!                                                          ! de l'eau cond (de fisrtilp)
+      REAL,DIMENSION(klon,klev) :: beta_v1    ! -- (originale version)
+      INTEGER,SAVE  :: iflag_lscav_omp,iflag_lscav
+!$OMP THREADPRIVATE(iflag_lscav_omp,iflag_lscav)
+
+
+
+
+!Thermiques:
+!----------
+      REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: fm_therm
+      REAL,DIMENSION(klon,klev),INTENT(IN)     :: entr_therm
+
+
+!
+!  Couche limite:
+!  --------------
+!
+      REAL , intent(in) :: coefh(klon,klev) ! coeff melange CL
+      REAL , intent(in) :: cdragh(klon), cdragm(klon)
+      REAL, intent(in) ::  yu1(klon)        ! vent dans la 1iere couche
+      REAL, intent(in) ::  yv1(klon)        ! vent dans la 1iere couche
+!
+!
+!----------------------------------------------------------------------
+      REAL his_ds(klon,nbtr)
+      REAL his_dh(klon,nbtr)
+      REAL his_dhlsc(klon,nbtr)        ! in-cloud scavenging lsc
+      REAL his_dhcon(klon,nbtr)       ! in-cloud scavenging con
+      REAL his_dhbclsc(klon,nbtr)      ! below-cloud scavenging lsc
+      REAL his_dhbccon(klon,nbtr)      ! below-cloud scavenging con
+      REAL trm(klon,nbtr)
+!
+      REAL u10m_ec(klon), v10m_ec(klon)
+!
+      REAL his_th(klon,nbtr)
+      REAL his_dhkecv(klon,nbtr)
+      REAL his_dhkelsc(klon,nbtr)
+
+
+!
+!  Coordonnees
+!  -----------
+!
+      REAL, intent(in) ::  rlat(klon)       ! latitudes pour chaque point 
+      REAL, intent(in) ::  rlon(klon)       ! longitudes pour chaque point 
+!
+      INTEGER i, k, it, j, ig 
+!
+! DEFINITION OF DIAGNOSTIC VARIABLES
+!
+      REAL diag_trm(nbtr), diag_drydep(nbtr) 
+      REAL diag_wetdep(nbtr), diag_cvtdep(nbtr)
+      REAL diag_emissn(nbtr), diag_g2part
+      REAL diag_sedimt
+      REAL trm_aux(nbtr), src_aux(nbtr)
+!
+! Variables locales pour effectuer les appels en serie
+!----------------------------------------------------
+      REAL source_tr(klon,nbtr)
+      REAL flux_tr(klon,nbtr)
+      REAL m_conc(klon,klev)
+      REAL henry(nbtr)  !--cste de Henry  mol/l/atm
+      REAL kk(nbtr)     !--coefficient de var avec T (K)
+      REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie
+      REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige
+      REAL vdep_oce(nbtr), vdep_sic(nbtr)
+      REAL vdep_ter(nbtr), vdep_lic(nbtr)
+      REAL ccntrAA_spla(nbtr)
+      REAL ccntrENV_spla(nbtr)
+      REAL coefcoli_spla(nbtr)
+      REAL dtrconv(klon,nbtr)
+      REAL zrho(klon,klev), zdz(klon,klev)
+      REAL zalt(klon,klev)
+      REAL,DIMENSION(klon,klev)      :: zmasse    ! densité atmosphérique
+!     .                                              Kg/m2
+      REAL,DIMENSION(klon,klev)      :: ztra_th
+      REAL qmin, qmax, aux
+!      PARAMETER (qmin=0.0, qmax=1.e33)
+      PARAMETER (qmin=1.e33, qmax=-1.e33)
+
+! Variables to save data into file
+!----------------------------------
+   
+      CHARACTER*2 str2
+!!AS:      LOGICAL ok_histrac
+!!!JE2014124      PARAMETER (ok_histrac=.true.)
+!!      PARAMETER (ok_histrac=.false.)
+      INTEGER ndex2d(iim*(jjm+1)), ndex3d(iim*(jjm+1)*klev)
+      INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
+      INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
+      SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
+!$OMP THREADPRIVATE(nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5)
+      INTEGER itra
+      SAVE itra                    ! compteur pour la physique
+!$OMP THREADPRIVATE(itra)
+      INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m
+      SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m
+!$OMP THREADPRIVATE(ecrit_tra, ecrit_tra_h, ecrit_tra_m)
+      REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
+      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
+      REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev)
+      REAL zx_lon_glo(nbp_lon,nbp_lat), zx_lat_glo(nbp_lon,nbp_lat)
+      REAL zsto, zout, zout_h, zout_m, zjulian
+
+!------Molar Masses
+      REAL masse(nbtr)
+!
+      REAL fracso2emis                              !--fraction so2 emis en so2
+      PARAMETER (fracso2emis=0.95) 
+      REAL frach2sofso2                             !--fraction h2s from so2
+      PARAMETER (frach2sofso2=0.0426)
+!
+!  Controles
+!-------------
+      LOGICAL convection,lessivage,lminmax,lcheckmass
+      DATA convection,lessivage,lminmax,lcheckmass &
+          /.true.,.true.,.true.,.false./
+!
+      REAL xconv(nbtr)
+!
+      LOGICAL anthropo, bateau, edgar
+      DATA anthropo,bateau,edgar/.true.,.true.,.true./
+!
+!c bc_source
+      INTEGER kminbc, kmaxbc
+!JE20150715      PARAMETER (kminbc=3, kmaxbc=5)
+      PARAMETER (kminbc=4, kmaxbc=7)
+!
+      REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont
+!
+! JE for updating in  cltrac
+      REAL,DIMENSION(klon,klev)             :: delp     ! epaisseur de couche (Pa)
+!! JE for include gas to particle conversion in output
+!      REAL his_g2pgas(klon)      ! gastoparticle in gas units (check!)
+!      REAL his_g2paer(klon)      ! gastoparticle in aerosol units (check!)
+!
+      INTEGER ,intent(in) :: iflag_conv
+      LOGICAL iscm3  ! debug variable. for checkmass ! JE
+
+!------------------------------------------------------------------------
+!  only to compute time consumption of each process
+!----
+      INTEGER clock_start,clock_end,clock_rate,clock_start_spla
+      INTEGER clock_end_outphytracr,clock_start_outphytracr
+      INTEGER ti_init,dife,ti_inittype,ti_inittwrite
+      INTEGER ti_spla,ti_emis,ti_depo,ti_cltr,ti_ther
+      INTEGER ti_sedi,ti_gasp,ti_wetap,ti_cvltr,ti_lscs,ti_brop,ti_outs
+      INTEGER ti_nophytracr,clock_per_max
+      REAL tia_init,tia_inittype,tia_inittwrite
+      REAL tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
+      REAL tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
+      REAL tia_brop,tia_outs
+      REAL tia_nophytracr
+ 
+      SAVE tia_init,tia_inittype,tia_inittwrite
+      SAVE tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
+      SAVE tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
+      SAVE tia_brop,tia_outs
+      SAVE ti_nophytracr
+      SAVE tia_nophytracr
+      SAVE clock_end_outphytracr,clock_start_outphytracr
+      SAVE clock_per_max
+      LOGICAL logitime
+!$OMP THREADPRIVATE(tia_init,tia_inittype,tia_inittwrite)
+!$OMP THREADPRIVATE(tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther)
+!$OMP THREADPRIVATE(tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs)
+!$OMP THREADPRIVATE(tia_brop,tia_outs)
+!$OMP THREADPRIVATE(ti_nophytracr)
+!$OMP THREADPRIVATE(tia_nophytracr)
+!$OMP THREADPRIVATE(clock_end_outphytracr,clock_start_outphytracr)
+!$OMP THREADPRIVATE(clock_per_max)
+
+!     utils parallelization
+      REAL :: auxklon_glo(klon_glo)
+      INTEGER :: iauxklon_glo(klon_glo)
+      REAL, DIMENSION(klon_glo,nbp_lev) :: auxklonnbp_lev
+      REAL, DIMENSION(klon_glo,nbp_lev,nbtr)  :: auxklonklevnbtr_glo
+      REAL,DIMENSION(nbp_lon,nbp_lat) ::  zx_tmp_2d_glo
+      REAL,DIMENSION(nbp_lon,nbp_lat,nbp_lev) :: zx_tmp_3d_glo
+      REAL,DIMENSION(klon_glo) :: zx_tmp_fi2d_glo
+      REAL,DIMENSION(klon_glo , nbp_lev) :: zx_tmp_fi3d_glo
+      REAL,DIMENSION(klon_glo,nbtr) :: auxklonnbtr_glo
+
+
+
+      source_tr=0.
+
+
+
+      if (debutphy) then
+#ifdef IOPHYS_DUST
+         CALL iophys_ini
+#endif
+         nbreg_ind=1
+         nbreg_bb=1
+         nbreg_dust=1
+         nbreg_wstardust=1
+         CALL phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust)
+      endif
+
+
+#ifdef IOPHYS_DUST
+      do it=1,nbtr
+         write(str2,'(i2.2)') it
+         call iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,it))
+      enddo
+#endif
+
+  
+
+
+  ijulday=jD_cur-jD_1jan+1
+  nbjour = 1
+
+  paramname_ind='ind'
+  paramname_bb='bb'
+  paramname_ff='ind'
+  paramname_dustacc='dustacc'
+  paramname_dustcoa='dustcoasco'
+  paramname_dustsco='dustcoasco'
+!  paramname_dustacc='dust'
+!  paramname_dustcoa='dust'
+!  paramname_dustsco='dust'
+  paramname_wstarBL='pwstarbl'
+  paramname_wstarWAKE='pwstarwake'
+  paramname_ssacc='ssacc'
+  paramname_sscoa='sscoa'
+
+  filescaleparams='modvalues.nc'
+!AS: debranchage de lecture des coefs d'assmilation de Jeronimo Escribano
+  IF("ASSIM"=="YES") THEN
+    CALL readscaleparamsnc_spl(scale_param_ind,                        &
+        nbreg_ind, paramname_ind,                                    &
+        scale_param_ff, nbreg_ind,paramname_ff,                      &
+        scale_param_bb, nbreg_bb,paramname_bb,                       &
+        scale_param_dustacc, nbreg_dust,paramname_dustacc,           &
+        scale_param_dustcoa, nbreg_dust,paramname_dustcoa,           &
+        scale_param_dustsco, nbreg_dust,paramname_dustsco,           &
+        param_wstarBLperregion, nbreg_wstardust, paramname_wstarBL, &
+        param_wstarWAKEperregion, nbreg_wstardust, paramname_wstarWAKE, &
+        scale_param_ssacc  ,  paramname_ssacc,                    &
+        scale_param_sscoa  ,  paramname_sscoa,                    &
+           filescaleparams,ijulday,jH_cur, pdtphys,debutphy)
+  ENDIF ! ASSIM
+!AS: le commentaire suivant "add seasalt" ne semble pas avoir ete mis en pratique.
+! Des fichiers regions_ssacc et _sscoa existent mais ne semblent pas lus.
+! Ca reste donc aux valeurs initialisées: nbreg_ss=1, scale_param_ss*=1, cf fichiers ss et modvalues
+!! add seasalt
+
+  print *,'JE : check scale_params'
+
+  print *, 'nbreg_ind', nbreg_ind   
+  print *, 'nbreg_dust', nbreg_dust  
+  print *, 'nbreg_bb', nbreg_bb   
+  print *, 'ind', scale_param_ind   
+  print *, 'dustacc', scale_param_dustacc  
+  print *, 'dustcoa', scale_param_dustcoa  
+  print *, 'dustsco', scale_param_dustsco
+  print *, 'wstardustBL', param_wstarBLperregion
+  print *, 'wstardustWAKE', param_wstarWAKEperregion
+  print *, 'ff', scale_param_ff  
+  print *, 'bb', scale_param_bb  
+  print *, 'ssacc', scale_param_ssacc
+  print *, 'sscoa', scale_param_sscoa
+
+  print *,'JE: before read_newemissions '
+  print *,'JE: jD_cur:',jD_cur,' ijulday:',ijulday,' jH_cur:',jH_cur,' pdtphys:',pdtphys
+  print *,'JE: now read_newemissions:'
+!AS: La ligne suivante fait planter a l'execution : lmt_so2ff_l pas initialise
+!  print *,'lmt_so2ff_l AVANT' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
+  call read_newemissions(ijulday,jH_cur ,edgar, flag_dms,debutphy, & !I
+                         pdtphys, lafin, nbjour, pctsrf,  &       !I
+                         t_seri, rlat, rlon, &                         !I
+                         pmflxr, pmflxs, prfl, psfl, &            !I
+                                 u10m_ec, v10m_ec, dust_ec, &     !O
+                                 lmt_sea_salt, lmt_so2ff_l, &     !O
+                                 lmt_so2ff_h, lmt_so2nff, &       !O
+                                 lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, &  !O
+                                 lmt_so2volc_cont, lmt_altvolc_cont, &   !O
+                                 lmt_so2volc_expl, lmt_altvolc_expl, &   !O
+                                 lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, &  !O
+                                 lmt_bcff, lmt_bcnff, lmt_bcbb_l, &      !O
+                                 lmt_bcbb_h, lmt_bcba, lmt_omff, &       !O
+                                 lmt_omnff, lmt_ombb_l, lmt_ombb_h, &    !O
+                                 lmt_omnat, lmt_omba)                    !O
+
+
+  print *,'Check emissions'
+  print *,'lmt_so2ff_l' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
+  print *,'lmt_so2ff_h' , MINVAL(lmt_so2ff_h), MAXVAL(lmt_so2ff_h)
+  print *,'lmt_so2nff' , MINVAL(lmt_so2nff), MAXVAL(lmt_so2nff)
+  print *,'lmt_so2ba' , MINVAL(lmt_so2ba), MAXVAL(lmt_so2ba)
+  print *,'lmt_so2bb_l' , MINVAL(lmt_so2bb_l), MAXVAL(lmt_so2bb_l)
+  print *,'lmt_so2bb_h' , MINVAL(lmt_so2bb_h), MAXVAL(lmt_so2bb_h)
+  print *,'lmt_so2volc_cont' , MINVAL(lmt_so2volc_cont), MAXVAL(lmt_so2volc_cont)
+  print *,'lmt_altvolc_cont' , MINVAL(lmt_altvolc_cont), MAXVAL(lmt_altvolc_cont)
+  print *,'lmt_so2volc_expl' , MINVAL(lmt_so2volc_expl), MAXVAL(lmt_so2volc_expl)
+  print *,'lmt_altvolc_expl' , MINVAL(lmt_altvolc_expl), MAXVAL(lmt_altvolc_expl)
+  print *,'lmt_dmsbio' , MINVAL(lmt_dmsbio), MAXVAL(lmt_dmsbio)
+  print *,'lmt_h2sbio' , MINVAL(lmt_h2sbio), MAXVAL(lmt_h2sbio)
+  print *,'lmt_dmsconc' , MINVAL(lmt_dmsconc), MAXVAL(lmt_dmsconc)
+  print *,'lmt_bcff' , MINVAL(lmt_bcff), MAXVAL(lmt_bcff)
+  print *,'lmt_bcnff' , MINVAL(lmt_bcnff), MAXVAL(lmt_bcnff)
+  print *,'lmt_bcbb_l' , MINVAL(lmt_bcbb_l), MAXVAL(lmt_bcbb_l)
+  print *,'lmt_bcbb_h' , MINVAL(lmt_bcbb_h), MAXVAL(lmt_bcbb_h)
+  print *,'lmt_bcba' , MINVAL(lmt_bcba), MAXVAL(lmt_bcba)
+  print *,'lmt_omff' , MINVAL(lmt_omff), MAXVAL(lmt_omff)
+  print *,'lmt_omnff' , MINVAL(lmt_omnff), MAXVAL(lmt_omnff)
+  print *,'lmt_ombb_l' , MINVAL(lmt_ombb_l), MAXVAL(lmt_ombb_l)
+  print *,'lmt_ombb_h' , MINVAL(lmt_ombb_h), MAXVAL(lmt_ombb_h)
+  print *,'lmt_omnat' , MINVAL(lmt_omnat), MAXVAL(lmt_omnat)
+  print *,'lmt_omba' , MINVAL(lmt_omba), MAXVAL(lmt_omba)
+  print *,'JE iflag_con',iflag_conv
+
+
+!JE_dbg
+   do i=1,klon
+      tsol(i)=0.0
+      do j=1,nbsrf
+          tsol(i)=tsol(i)+ftsol(i,j)*pctsrf(i,j)
+      enddo
+   enddo
+
+
+!======================================================================
+!  INITIALISATIONS
+!======================================================================
+!             CALL checknanqfi(da(:,:),1.,-1.,' da_ before
+!     . phytracr_inphytracr')
+
+!
+! computing time
+!        logitime=.true.
+        logitime=.false.
+        IF (logitime) THEN
+        clock_start=0
+        clock_end=0
+        clock_rate=0
+       CALL SYSTEM_CLOCK(COUNT_RATE=clock_rate,COUNT_MAX=clock_per_max)
+        CALL SYSTEM_CLOCK(COUNT=clock_start_spla)
+        clock_start=clock_start_spla
+        clock_end_outphytracr=clock_start_spla
+        ENDIF
+
+
+! Definition of tracers index.
+      print*,'OK ON PASSSE BIEN LA'
+      CALL minmaxsource(source_tr,qmin,qmax,'A1 maxsource init phytracr')
+
+
+      IF (debutphy) THEN
+        id_prec=-1
+        id_fine=-1
+        id_coss=-1
+        id_codu=-1
+        id_scdu=-1
+       !print *,nbtr
+       do it=1,nbtr
+        print *, it, tname(it+nqo)
+        if (tname(it+nqo) == 'PREC' ) then
+            id_prec=it
+        endif
+        if (tname(it+nqo) == 'FINE' ) then
+            id_fine=it
+        endif
+        if (tname(it+nqo) == 'COSS' ) then
+            id_coss=it
+        endif
+        if (tname(it+nqo) == 'CODU' ) then
+            id_codu=it
+        endif
+        if (tname(it+nqo) == 'SCDU' ) then
+            id_scdu=it
+        endif
+       enddo
+       ! check consistency with dust emission scheme:
+       if (ok_chimeredust) then
+          if (.not.( id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then
+             call abort_gcm('phytracr_mod', 'pb in ok_chimdust 0',1)
+          endif
+       else 
+          if (id_scdu>0) then 
+       call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU',1)
+          endif
+          if ( (id_codu .le. 0) .or. ( id_fine.le.0)  ) then  
+          call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1',1) 
+          endif
+       endif
+
+
+       !print *,id_prec,id_fine,id_coss,id_codu,id_scdu
+       ENDIF
+
+
+
+
+
+
+!---fraction of tracer that is convected (Tiedke)
+      xconv(:)=0.
+      if(id_prec>0)  xconv(id_prec)=0.8
+      if(id_fine>0)  xconv(id_fine)=0.5
+      if(id_coss>0)  xconv(id_coss)=0.5
+      if(id_codu>0)  xconv(id_codu)=0.6
+      if(id_scdu>0)  xconv(id_scdu)=0.6  !!JE fix
+
+      masse(:)=1.
+      if(id_prec>0)  masse(id_prec)=32.
+      if(id_fine>0)  masse(id_fine)=6.02e23
+      if(id_coss>0)  masse(id_coss)=6.02e23
+      if(id_codu>0)  masse(id_codu)=6.02e23 
+      if(id_scdu>0)  masse(id_scdu)=6.02e23 
+
+      henry(:)=0.
+      if(id_prec>0)  henry(id_prec)=1.4
+      if(id_fine>0)  henry(id_fine)=0.0
+      if(id_coss>0)  henry(id_coss)=0.0
+      if(id_codu>0)  henry(id_codu)=0.0
+      if(id_scdu>0)  henry(id_scdu)=0.0
+      !henry= (/1.4, 0.0, 0.0, 0.0/)
+      kk(:)=0.
+      if(id_prec>0)  kk(id_prec)=2900.
+      if(id_fine>0)  kk(id_fine)=0.0
+      if(id_coss>0)  kk(id_coss)=0.0
+      if(id_codu>0)  kk(id_codu)=0.0
+      if(id_scdu>0)  kk(id_scdu)=0.0
+      !kk = (/2900., 0., 0., 0./)
+      alpha_r(:)=0.
+      if(id_prec>0)  alpha_r(id_prec)=0.0
+      if(id_fine>0)  alpha_r(id_fine)=0.001
+      if(id_coss>0)  alpha_r(id_coss)=0.001
+      if(id_codu>0)  alpha_r(id_codu)=0.001
+      if(id_scdu>0)  alpha_r(id_scdu)=0.001  !JE fix
+      alpha_s(:)=0.
+      if(id_prec>0)  alpha_s(id_prec)=0.0
+      if(id_fine>0)  alpha_s(id_fine)=0.01
+      if(id_coss>0)  alpha_s(id_coss)=0.01
+      if(id_codu>0)  alpha_s(id_codu)=0.01
+      if(id_scdu>0)  alpha_s(id_scdu)=0.01  !JE fix
+
+!      alpha_r =  (/0., 0.001, 0.001, 0.001/)
+!      alpha_s = (/0., 0.01, 0.01, 0.01/)
+
+! nhl      DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
+! nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
+      !vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
+      vdep_oce(:)=0.
+      if(id_prec>0)  vdep_oce(id_prec) = 0.28
+      if(id_fine>0)  vdep_oce(id_fine) = 0.28
+      if(id_coss>0)  vdep_oce(id_coss) = 1.2
+      if(id_codu>0)  vdep_oce(id_codu) = 1.2
+      if(id_scdu>0)  vdep_oce(id_scdu) = 1.2
+      vdep_sic(:)=0.
+      if(id_prec>0)  vdep_sic(id_prec) = 0.2
+      if(id_fine>0)  vdep_sic(id_fine) = 0.17
+      if(id_coss>0)  vdep_sic(id_coss) = 1.2
+      if(id_codu>0)  vdep_sic(id_codu) = 1.2
+      if(id_scdu>0)  vdep_sic(id_scdu) = 1.2
+
+      !vdep_sic = (/0.2, 0.17, 1.2, 1.2/)     
+      !vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
+      vdep_ter(:)=0.
+      if(id_prec>0)  vdep_ter(id_prec) = 0.3
+      if(id_fine>0)  vdep_ter(id_fine) = 0.14
+      if(id_coss>0)  vdep_ter(id_coss) = 1.2
+      if(id_codu>0)  vdep_ter(id_codu) = 1.2
+      if(id_scdu>0)  vdep_ter(id_scdu) = 1.2
+
+      vdep_lic(:)=0.
+      if(id_prec>0)  vdep_lic(id_prec) = 0.2
+      if(id_fine>0)  vdep_lic(id_fine) = 0.17
+      if(id_coss>0)  vdep_lic(id_coss) = 1.2
+      if(id_codu>0)  vdep_lic(id_codu) = 1.2
+      if(id_scdu>0)  vdep_lic(id_scdu) = 1.2
+
+
+      ! convective KE lessivage aer params:
+      ! AS: #DFB (Binta) a aussi teste ccntrAA_spla=ccntrENV_spla=0.9/1.0/0.9/0.9
+      !     mais effet negligeable sur l'AOD
+      ccntrAA_spla(:)=0.
+      if(id_prec>0)  ccntrAA_spla(id_prec)=-9999.
+      if(id_fine>0)  ccntrAA_spla(id_fine)=0.7
+      if(id_coss>0)  ccntrAA_spla(id_coss)=1.0
+      if(id_codu>0)  ccntrAA_spla(id_codu)=0.7
+      if(id_scdu>0)  ccntrAA_spla(id_scdu)=0.7
+
+      ccntrENV_spla(:)=0.
+      if(id_prec>0)  ccntrENV_spla(id_prec)=-9999.
+      if(id_fine>0)  ccntrENV_spla(id_fine)=0.7
+      if(id_coss>0)  ccntrENV_spla(id_coss)=1.0
+      if(id_codu>0)  ccntrENV_spla(id_codu)=0.7
+      if(id_scdu>0)  ccntrENV_spla(id_scdu)=0.7
+      ! #DFB
+      coefcoli_spla(:)=0.
+      if(id_prec>0)  coefcoli_spla(id_prec)=-9999.
+      if(id_fine>0)  coefcoli_spla(id_fine)=0.001
+      if(id_coss>0)  coefcoli_spla(id_coss)=0.001
+      if(id_codu>0)  coefcoli_spla(id_codu)=0.001
+      if(id_scdu>0)  coefcoli_spla(id_scdu)=0.001
+
+      !vdep_lic = (/0.2, 0.17, 1.2, 1.2/)      
+!
+
+      iscm3=.false.
+      if (debutphy) then
+!$OMP MASTER
+         CALL suphel
+         print *, 'let s check nbtr=', nbtr
+! JE before put in zero
+      IF (lminmax) THEN
+        DO it=1,nbtr
+        CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan init phytracr')
+        ENDDO        
+        DO it=1,nbtr
+        CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'minmax init phytracr')
+        ENDDO
+        CALL minmaxsource(source_tr,qmin,qmax,'maxsource init phytracr')
+      ENDIF
+! JE   initializon to cero the tracers     
+!         DO it=1, nbtr
+!            tr_seri(:,:,it)=0.0
+!         ENDDO
+! JE end     
+! Initializing to zero tr_seri for comparison purposes
+!        tr_seri(:,:,:)=0.0
+!
+!        DO it=1,nbtr
+!           trm_aux(it)=0.0
+!           src_aux(it)=0.0
+!           diag_trm(it)=0.0
+!           diag_drydep(it)=0.0
+!           diag_wetdep(it)=0.0
+!           diag_cvtdep(it)=0.0
+!           diag_emissn(it)=0.0
+!        ENDDO
+!        diag_g2part=0.0
+         print *,'PREPARE FILES TO SAVE VARIABLES'
+!
+         nbjour=30
+         ecrit_tra =   NINT(86400./pdtphys)                    !--1-day  average
+         ecrit_tra_h = NINT(86400./pdtphys*0.25)               !--6-hour average
+         ecrit_tra_m = NINT(86400./pdtphys*FLOAT(nbjour))      !--1-mth  average
+         print *,'ecrit_tra=', pdtphys, ecrit_tra
+
+!!AS deleting lines
+!!         IF (ok_histrac) THEN
+!!           IF (is_mpi_root .AND. is_omp_root) THEN
+!!-----many deleted lines----
+!!!       nbjour=1
+!!         ENDIF ! mpi root
+!!         ENDIF !--ok_histrac
+
+!$OMP END MASTER
+!$OMP BARRIER
+      endif ! debutphy
+!
+!======================================================================
+! Initialisations
+!======================================================================
+!
+!
+! je  KE init
+      IF (debutphy) THEN
+!$OMP MASTER
+
+      ALLOCATE(d_tr_dry(klon,nbtr))
+      ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr))
+      ALLOCATE(qPrls(klon,nbtr),qPr(klon,klev,nbtr))
+      ALLOCATE(qDi(klon,klev,nbtr))
+      ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
+      ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        ALLOCATE(d_tr_cv_o(klon,klev,nbtr))
        ALLOCATE(d_tr_trsp_o(klon,klev,nbtr))
@@ -2110,52 +1658,8 @@
        ALLOCATE(masque_aqua(klon))  
        ALLOCATE(masque_terra(klon))  
-!       ALLOCATE(aod550_aqua(klon))  
-!       ALLOCATE(aod550_terra(klon))  
-!       ALLOCATE(aod670_aqua(klon))  
-!       ALLOCATE(aod670_terra(klon))  
-!       ALLOCATE(aod865_aqua(klon))  
-!       ALLOCATE(aod865_terra(klon)) 
-
-      ALLOCATE( aod550_terra(klon))  
-      ALLOCATE( aod550_tr2_terra(klon))  
-      ALLOCATE( aod550_ss_terra(klon))   
-      ALLOCATE( aod550_dust_terra(klon))   
-      ALLOCATE( aod550_dustsco_terra(klon))   
-      ALLOCATE( aod670_terra(klon))   
-      ALLOCATE( aod670_tr2_terra(klon))  
-      ALLOCATE( aod670_ss_terra(klon))  
-      ALLOCATE( aod670_dust_terra(klon))  
-      ALLOCATE( aod670_dustsco_terra(klon))  
-      ALLOCATE( aod865_terra(klon))   
-      ALLOCATE( aod865_tr2_terra(klon))  
-      ALLOCATE( aod865_ss_terra(klon))  
-      ALLOCATE( aod865_dust_terra(klon))  
-      ALLOCATE( aod865_dustsco_terra(klon))  
-
-      ALLOCATE( aod550_aqua(klon))  
-      ALLOCATE( aod550_tr2_aqua(klon))  
-      ALLOCATE( aod550_ss_aqua(klon))   
-      ALLOCATE( aod550_dust_aqua(klon))   
-      ALLOCATE( aod550_dustsco_aqua(klon))   
-      ALLOCATE( aod670_aqua(klon))   
-      ALLOCATE( aod670_tr2_aqua(klon))  
-      ALLOCATE( aod670_ss_aqua(klon))  
-      ALLOCATE( aod670_dust_aqua(klon))  
-      ALLOCATE( aod670_dustsco_aqua(klon))  
-      ALLOCATE( aod865_aqua(klon))   
-      ALLOCATE( aod865_tr2_aqua(klon))  
-      ALLOCATE( aod865_ss_aqua(klon))  
-      ALLOCATE( aod865_dust_aqua(klon))  
-      ALLOCATE( aod865_dustsco_aqua(klon))  
  
 
        masque_aqua(:)=0
        masque_terra(:)=0
-!       aod550_aqua(:)=0.
-!       aod550_terra(:)=0.
-!       aod670_aqua(:)=0.
-!       aod670_terra(:)=0.
-!       aod865_aqua(:)=0.
-!       aod865_terra(:)=0.
 
       aod550_terra(:)=0.  
@@ -2365,7 +1869,15 @@
 
 
-
-       IF (debutphy) then
-
+      IF (debutphy) then
+
+! AS: initialisation des indices par point de grille physique iregion_*
+! (variables tenant de l'assimilation, a eliminer dans un 2eme temps) 
+       iregion_dust(:)=1
+       iregion_ind(:)=1
+       iregion_bb(:)=1
+       iregion_wstardust(:)=1
+
+!AS: lecture des indices dans fichiers "regions_*" eliminee par IF("ASSIM"="YES") (faux donc)
+       IF("ASSIM"=="YES") THEN
       c_FullName1='regions_dustacc'
       !c_FullName1='regions_dust'
@@ -2450,8 +1962,11 @@
       CLOSE(76)
       CLOSE(77)
+      CLOSE(95)
 
       ENDIF ! mpi root
 !$OMP END MASTER
 !$OMP BARRIER
+
+      ENDIF  ! ASSIM 
 
       ENDIF  ! debutphy
@@ -3682,6 +3197,7 @@
 ! choix du lessivage
       IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN
-      print *,'JE iflag_lscav',iflag_lscav
-       DO it = 1, nbtr
+      !IF (.false.) THEN  ! test #DFB (Binta) sans lsc_scav_spl
+        print *,'JE iflag_lscav',iflag_lscav
+        DO it = 1, nbtr
 
 !       incloud scavenging and removal by large scale rain ! orig : ql_incl
@@ -3694,5 +3210,5 @@
 !     .               t_seri,tr_seri,d_tr_insc, 
 !     .               d_tr_bcscav,d_tr_evapls,qPrls)
-       CALL lsc_scav_spl(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,  &
+          CALL lsc_scav_spl(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,  &
                     rneb,beta_fisrt, beta_v1,pplay,paprs,      &
                     t_seri,tr_seri,d_tr_insc,                  &
@@ -3702,27 +3218,33 @@
 
 !large scale scavenging tendency
-       DO k = 1, klev
-        DO i = 1, klon
-         d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it) &
+          DO k = 1, klev
+           DO i = 1, klon
+                d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it) &
                         +d_tr_evapls(i,k,it)
-         tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)
-          tmp_var(i,k)=d_tr_ls(i,k,it)
-        ENDDO
-       ENDDO
-
-       CALL kg_to_cm3(pplay,t_seri,tmp_var)
-         DO k=1,klev
-            DO i=1,klon
+                tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)
+                         tmp_var(i,k)=d_tr_ls(i,k,it)
+           ENDDO
+          ENDDO
+
+          CALL kg_to_cm3(pplay,t_seri,tmp_var)
+
+          DO k=1,klev
+           DO i=1,klon
             his_dhkelsc(i,it)=his_dhkelsc(i,it)-tmp_var(i,k)    &
                      /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys
      
-            END DO
-         END DO
-
-       END DO  !tr
+           END DO
+          END DO
+
+        END DO  !it=1,nbtr
+
       ELSE
-        his_dhkelsc(i,it)=0.0
         print *,'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4'
-       ENDIF !iflag_lscav
+        DO it = 1, nbtr
+          DO i=1,klon
+            his_dhkelsc(i,it)=0.0
+          END DO  ! klon
+         END DO  !it=1,nbtr
+      ENDIF !iflag_lscav 
 
        print *,' AFTER lsc_scav '
@@ -3844,10 +3366,4 @@
        !new utc day: put in 0 everything
 !JE20150518<<
-!       aod550_aqua(:) =0.
-!       aod550_terra(:) =0.
-!       aod670_aqua(:) =0.
-!       aod670_terra(:) =0.
-!       aod865_aqua(:) =0.
-!       aod865_terra(:) =0.
        masque_aqua(:) =0
        masque_terra(:) =0
@@ -3886,10 +3402,4 @@
 
       DO i=1,klon
-!         aod550_aqua(i)=aod550_aqua(i)+   &
-!                       masque_aqua_cur(i)*diff_aod550_tot(i)
-!         aod670_aqua(i)=aod670_aqua(i)+   &
-!                        masque_aqua_cur(i)*diag_aod670_tot(i)
-!         aod865_aqua(i)=aod865_aqua(i)+   &
-!                       masque_aqua_cur(i)*diag_aod865_tot(i)
 
        aod550_terra(i)=aod550_terra(i)+   &
@@ -3956,11 +3466,6 @@
        aod865_dustsco_aqua(i)= aod865_dustsco_aqua(i) + &
                        masque_aqua_cur(i)*diag_aod865_dustsco(i)
-!         aod550_terra(i)=aod550_terra(i)+  &
-!                       masque_terra_cur(i)*diff_aod550_tot(i)
-!         aod670_terra(i)=aod670_terra(i)+  &
-!                       masque_terra_cur(i)*diag_aod670_tot(i)
-!         aod865_terra(i)=aod865_terra(i)+   &
-!                       masque_terra_cur(i)*diag_aod865_tot(i)
-         masque_aqua(i)=masque_aqua(i)+masque_aqua_cur(i)
+
+               masque_aqua(i)=masque_aqua(i)+masque_aqua_cur(i)
          masque_terra(i)=masque_terra(i)+masque_terra_cur(i)
       ENDDO
@@ -4035,68 +3540,16 @@
                    aod865_dustsco_terra(i)= -999.
                ENDIF
-!              IF (masque_terra(i).GT. 0) THEN
-!                   aod550_terra(i) = aod550_terra(i)/masque_terra(i)
-!                   aod670_terra(i)=aod670_terra(i)/masque_terra(i)
-!                   aod865_terra(i)=aod865_terra(i)/masque_terra(i)
-!
-!               ELSE
-!                   aod550_terra(i) = -999.
-!                   aod670_terra(i) = -999.
-!                   aod865_terra(i) = -999.
-!               ENDIF
           ENDDO          
-!      !write  dbg
-!       CALL writefield_phy("aod550_aqua",aod550_aqua,1) 
-!       CALL writefield_phy("aod550_terra",aod550_terra,1) 
-!       CALL writefield_phy("masque_aqua",float(masque_aqua),1)
-!       CALL writefield_phy("masque_terra",float(masque_terra),1)
-
-
-      IF (ok_histrac) THEN
-!      write in output file
-      call gather(aod550_aqua,aod550_aqua_glo)
-      call gather(aod550_terra,aod550_terra_glo)
-      call gather(aod670_aqua,aod670_aqua_glo)
-      call gather(aod670_terra,aod670_terra_glo)
-      call gather(aod865_aqua,aod865_aqua_glo)
-      call gather(aod865_terra,aod865_terra_glo)
-
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-
-      CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod550_aqua_glo ,zx_tmp_2d)
-      CALL histwrite(nid_tra3,"taue550_aqua",itra,zx_tmp_2d, &
-                                      nbp_lon*(nbp_lat),ndex2d)
-
-      CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod550_terra_glo ,zx_tmp_2d)
-      CALL histwrite(nid_tra3,"taue550_terra",itra,zx_tmp_2d, &
-                                      nbp_lon*(nbp_lat),ndex2d)
-      CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod670_aqua_glo ,zx_tmp_2d)
-      CALL histwrite(nid_tra3,"taue670_aqua",itra,zx_tmp_2d, &
-                                      nbp_lon*(nbp_lat),ndex2d)
-      CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod670_terra_glo ,zx_tmp_2d)
-      CALL histwrite(nid_tra3,"taue670_terra",itra,zx_tmp_2d, &
-                                      nbp_lon*(nbp_lat),ndex2d)
-
-      CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod865_aqua_glo ,zx_tmp_2d)
-      CALL histwrite(nid_tra3,"taue865_aqua",itra,zx_tmp_2d, &
-                                      nbp_lon*(nbp_lat),ndex2d)
-      CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod865_terra_glo ,zx_tmp_2d)
-      CALL histwrite(nid_tra3,"taue865_terra",itra,zx_tmp_2d, &
-                                      nbp_lon*(nbp_lat),ndex2d)
-      ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-      ENDIF
-!       !put in 0 everything
-!       aod550_aqua(:) =0.
-!       aod550_terra(:) =0.
-!       aod670_aqua(:) =0.
-!       aod670_terra(:) =0.
-!       aod865_aqua(:) =0.
-!       aod865_terra(:) =0.
-!       masque_aqua(:) =0 
-!       masque_terra(:) =0 
-      ENDIF 
+
+!!AS deleting lines
+!!      IF (ok_histrac) THEN
+!!!!      write in output file
+!!----many deleted lines
+!!      ENDIF  !mpi_root
+!!!$OMP END MASTER
+!!!$OMP BARRIER
+!!      ENDIF  !--ok_histrac
+
+      ENDIF ! jH_cur...
 
 
@@ -4138,6 +3591,4 @@
 !  SAVING AEROSOL RELATED VARIABLES INTO FILE
 !======================================================================
-!
-!JE20141224      IF (ok_histrac) THEN
 !
       ndex2d = 0
@@ -4275,4 +3726,5 @@
          fluxss(i)=fluxssfine(i)+fluxsscoa(i)
       ENDDO
+
 !      prepare outputs cvltr
 
@@ -4471,954 +3923,10 @@
       ENDDO
 
-      IF (ok_histrac) THEN
-!
-! SAVING VARIABLES IN TRACEUR
-!
-     call gather(diff_aod550_tot  ,auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)
-     CALL histwrite(nid_tra3,"taue550",itra,zx_tmp_2d_glo,                 &
-                                      nbp_lon*(nbp_lat),ndex2d)              
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod670_tot  , auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"taue670",itra,zx_tmp_2d_glo,                 &   
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod865_tot  , auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"taue865",itra,zx_tmp_2d_glo,                 &  
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather(  diff_aod550_tr2 , auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"taue550_tr2",itra,zx_tmp_2d_glo,             &  
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather(  diag_aod670_tr2 , auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"taue670_tr2",itra,zx_tmp_2d_glo,             &  
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod865_tr2  , auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"taue865_tr2",itra,zx_tmp_2d_glo,             &  
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather(  diag_aod550_ss, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)      
-     CALL histwrite(nid_tra3,"taue550_ss",itra,zx_tmp_2d_glo,              &  
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod670_ss , auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)      
-     CALL histwrite(nid_tra3,"taue670_ss",itra,zx_tmp_2d_glo,              &  
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod865_ss, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)      
-     CALL histwrite(nid_tra3,"taue865_ss",itra,zx_tmp_2d_glo,              &  
-                                      nbp_lon*(nbp_lat),ndex2d)              
-!                                                                       
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod550_dust, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)    
-     CALL histwrite(nid_tra3,"taue550_dust",itra,zx_tmp_2d_glo,             & 
-                                      nbp_lon*(nbp_lat),ndex2d)               
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod670_dust, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"taue670_dust",itra,zx_tmp_2d_glo,             &  
-                                      nbp_lon*(nbp_lat),ndex2d)               
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod865_dust, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"taue865_dust",itra,zx_tmp_2d_glo,             &  
-                                      nbp_lon*(nbp_lat),ndex2d)               
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod550_dustsco, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)  
-     CALL histwrite(nid_tra3,"taue550_dustsco",itra,zx_tmp_2d_glo,          &  
-                                      nbp_lon*(nbp_lat),ndex2d)               
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod670_dustsco, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)  
-     CALL histwrite(nid_tra3,"taue670_dustsco",itra,zx_tmp_2d_glo,          &  
-                                      nbp_lon*(nbp_lat),ndex2d)               
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( diag_aod865_dustsco, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo)  
-     CALL histwrite(nid_tra3,"taue865_dustsco",itra,zx_tmp_2d_glo,          &  
-                                      nbp_lon*(nbp_lat),ndex2d)               
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-                                                                         
-!$OMP MASTER
-     DO it=1,nbtr                                                        
-!                                                                        
-     WRITE(str2,'(i2.2)') it
-! 
-     call gather( trm, auxklonnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) , zx_tmp_2d_glo)
-     CALL histwrite(nid_tra3,"trm"//str2,itra,zx_tmp_2d_glo,              & 
-                                         nbp_lon*(nbp_lat),ndex2d)          
-!                                                                      
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( sconc_seri, auxklonnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo)     
-     CALL histwrite(nid_tra3,"sconc"//str2,itra,zx_tmp_2d_glo,            &  
-                                         nbp_lon*(nbp_lat),ndex2d)          
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-!                                                                      
-! SAVING VARIABLES IN LESSIVAGE                                         
-!                                                                       
-     call gather( flux_tr, auxklonnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo)
-     CALL histwrite(nid_tra2,"flux"//str2,itra,zx_tmp_2d_glo,               & 
-                    nbp_lon*(nbp_lat),ndex2d)                                 
-!                                                                        
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( his_ds, auxklonnbtr_glo )
-!! $OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo)           
-     CALL histwrite(nid_tra2,"ds"//str2,itra,zx_tmp_2d_glo,                 &  
-                    nbp_lon*(nbp_lat),ndex2d)                                 
-!                                                                        
-      ENDIF
-! !$OMP END MASTER
-! !$OMP BARRIER
-      ENDDO
-
-     DO it=1,nbtr
-     WRITE(str2,'(i2.2)') it
-      DO i=1, klon                                                        
-       zx_tmp_fi2d(i) = his_dhlsc(i,it)+his_dhcon(i,it)+               &  
-                        his_dhbclsc(i,it)+his_dhbccon(i,it)
-       his_dh(i,it)= his_dhlsc(i,it)+his_dhcon(i,it)+               &  
-                   his_dhbclsc(i,it)+his_dhbccon(i,it)
-
-      ENDDO
-!
-     call gather( zx_tmp_fi2d, auxklon_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)
-     CALL histwrite(nid_tra2,"dh"//str2,itra,zx_tmp_2d_glo,                  &
-                    nbp_lon*(nbp_lat),ndex2d)                                  
-!                                                                         
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( his_dhkecv, auxklonnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo)        
-     CALL histwrite(nid_tra2,"dhkecv"//str2,itra,zx_tmp_2d_glo,              &  
-                    nbp_lon*(nbp_lat),ndex2d)       
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!                           
-!                                                                         
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( his_dhkelsc, auxklonnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo)       
-     CALL histwrite(nid_tra2,"dhkelsc"//str2,itra,zx_tmp_2d_glo,             &  
-                    nbp_lon*(nbp_lat),ndex2d)                                  
-!                                                                         
-                                                                          
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-!    call gather( d_tr_cv_o,  auxklonklevnbtr_glo )
-     call gather( d_tr_cv,  auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,             &  
-                      zx_tmp_3d_glo)                                         
-     CALL histwrite(nid_tra2,"d_tr_cv"//str2,itra,zx_tmp_3d_glo,             &  
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( d_tr_trsp_o, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,           &    
-                      zx_tmp_3d_glo)                                            
-     CALL histwrite(nid_tra2,"d_tr_trsp"//str2,itra,zx_tmp_3d_glo,           &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( d_tr_sscav_o, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                      zx_tmp_3d_glo)                                            
-     CALL histwrite(nid_tra2,"d_tr_sscav"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( d_tr_sat_o, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,            &    
-                      zx_tmp_3d_glo)                                            
-     CALL histwrite(nid_tra2,"d_tr_sat"//str2,itra,zx_tmp_3d_glo,            &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( d_tr_uscav_o, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_uscav"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!                                                                            
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     call gather( d_tr_insc_o, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_insc"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!                                                                            
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-      
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     call gather( d_tr_bcscav_o, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_bcscav"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!                                                                            
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     call gather( d_tr_evapls_o, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_evapls"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-!                                                                            
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!    call gather( d_tr_ls_o, auxklonklevnbtr_glo )
-     call gather( d_tr_ls, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_ls"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-                                                                            
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!    call gather( d_tr_dyn_o, auxklonklevnbtr_glo )
-     call gather( d_tr_dyn, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_dyn"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-                                                                            
-      print*,'ECRTIURES TENDANCES MODIFIEES NON MAIS'
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!    call gather( d_tr_cl_o, auxklonklevnbtr_glo )
-     call gather( d_tr_cl, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_cl"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-                                                                            
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!    call gather( d_tr_th_o, auxklonklevnbtr_glo )
-     call gather( d_tr_th, auxklonklevnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) ,          &    
-                       zx_tmp_3d_glo)                                           
-     CALL histwrite(nid_tra2,"d_tr_th"//str2,itra,zx_tmp_3d_glo,          &    
-                                  nbp_lon*(nbp_lat)*nbp_lev,ndex3d)                  
-                                                                            
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     call gather( dtrconv,auxklonnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo)           
-     CALL histwrite(nid_tra2,"dtrconv"//str2,itra,zx_tmp_2d_glo,            & 
-                    nbp_lon*(nbp_lat),ndex2d)                                 
-!                                                                        
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-     call gather( his_th, auxklonnbtr_glo )
-! !$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo)           
-     CALL histwrite(nid_tra2,"dtherm"//str2,itra,zx_tmp_2d_glo,             &  
-                    nbp_lon*(nbp_lat),ndex2d)                                 
-      ENDIF ! mpi root
-! !$OMP END MASTER
-! !$OMP BARRIER
-!                                                                        
-                                                                         
-     ENDDO                                                               
-!
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( sed_ss, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)
-     CALL histwrite(nid_tra2,"sed_ss",itra,zx_tmp_2d_glo,                & 
-                    nbp_lon*(nbp_lat),ndex2d)                              
-!                                                                     
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( sed_dust, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)            
-     CALL histwrite(nid_tra2,"sed_dust",itra,zx_tmp_2d_glo,               & 
-                    nbp_lon*(nbp_lat),ndex2d)                               
-!                                                                      
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( sed_dustsco, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)          
-     CALL histwrite(nid_tra2,"sed_dustsco",itra,zx_tmp_2d_glo,              &
-                    nbp_lon*(nbp_lat),ndex2d)                                 
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( his_g2pgas, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)             
-     CALL histwrite(nid_tra2,"g2p_gas",itra,zx_tmp_2d_glo,                   & 
-                    nbp_lon*(nbp_lat),ndex2d)                                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( his_g2paer, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)              
-     CALL histwrite(nid_tra2,"g2p_aer",itra,zx_tmp_2d_glo,                   &  
-                    nbp_lon*(nbp_lat),ndex2d)                                  
-! SAVING VARIABLES IN HISTRAC                                              
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxbb, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-      CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                  
-      CALL histwrite(nid_tra1,"fluxbb",itra,zx_tmp_2d_glo,                   & 
-                                    nbp_lon*(nbp_lat),ndex2d)                 
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                 
-     CALL histwrite(nid_tra1,"fluxff",itra,zx_tmp_2d_glo,                   &  
-                                    nbp_lon*(nbp_lat),ndex2d)                 
-!                                                                        
-! ======================== BC =============================              
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxbcbb, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxbcbb",itra,zx_tmp_2d_glo,                 & 
-                                    nbp_lon*(nbp_lat),ndex2d)                 
-!                                                                        
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxbcff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxbcff",itra,zx_tmp_2d_glo,                  & 
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxbcnff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxbcnff",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxbcba, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxbcba",itra,zx_tmp_2d_glo,                  &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxbc, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                  
-     CALL histwrite(nid_tra1,"fluxbc",itra,zx_tmp_2d_glo,                    &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-! ======================== OM =============================               
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxombb, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxombb",itra,zx_tmp_2d_glo,                  &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxomff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxomff",itra,zx_tmp_2d_glo,                  &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxomnff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxomnff",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxomba, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxomba",itra,zx_tmp_2d_glo,                  &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxomnat, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxomnat",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxom, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                  
-     CALL histwrite(nid_tra1,"fluxom",itra,zx_tmp_2d_glo,                    &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-! ======================== SO4 =============================              
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso4ff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxso4ff",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso4nff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)              
-     CALL histwrite(nid_tra1,"fluxso4nff",itra,zx_tmp_2d_glo,                &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso4bb, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxso4bb",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso4ba, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxso4ba",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso4, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo)                 
-     CALL histwrite(nid_tra1,"fluxso4",itra,zx_tmp_2d_glo,                   &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-! ======================== H2S =============================              
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxh2sff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxh2sff",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                  
-!                                                                         
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxh2snff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)              
-     CALL histwrite(nid_tra1,"fluxh2snff",itra,zx_tmp_2d_glo,                 & 
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxh2sbio, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxh2sbio",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-! ======================== SO2 =============================               
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso2ff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxso2ff",itra,zx_tmp_2d_glo,                  &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso2nff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxso2nff",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso2bb, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxso2bb",itra,zx_tmp_2d_glo,                  &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso2vol, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxso2vol",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso2ba, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxso2ba",itra,zx_tmp_2d_glo,                  &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxso2, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                  
-     CALL histwrite(nid_tra1,"fluxso2",itra,zx_tmp_2d_glo,                    &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxdms, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                  
-     CALL histwrite(nid_tra1,"fluxdms",itra,zx_tmp_2d_glo,                    &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-! ======================== DD =============================                
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxdustec, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxdustec",itra,zx_tmp_2d_glo,                 &  
-                                    nbp_lon*(nbp_lat),ndex2d)                   
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxddfine, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxddfine",itra,zx_tmp_2d_glo,                 &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxddcoa, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxddcoa",itra,zx_tmp_2d_glo,                  &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxddsco, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxddsco",itra,zx_tmp_2d_glo,                  &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxdd, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                   
-     CALL histwrite(nid_tra1,"fluxdd",itra,zx_tmp_2d_glo,                     &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-! ======================== SS =============================                
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxssfine, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)               
-     CALL histwrite(nid_tra1,"fluxssfine",itra,zx_tmp_2d_glo,                 &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxsscoa, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                
-     CALL histwrite(nid_tra1,"fluxsscoa",itra,zx_tmp_2d_glo,                  &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( fluxss, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                   
-     CALL histwrite(nid_tra1,"fluxss",itra,zx_tmp_2d_glo,                     &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-
-!     call gather( , auxklon_glo )
-!!!!      IF (is_mpi_root .AND. is_omp_root) THEN
-!nhl     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,fluxso4chem,zx_tmp_3d_glo)       
-!nhl     CALL histwrite(nid_tra1,"fluxso4chem",itra,zx_tmp_3d_glo,            &  
-!nhl    .                             nbp_lon*(nbp_lat)*nbp_lev,ndex3d)            
-!                                                                          
-     call gather( flux_sparam_ind, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)          
-     CALL histwrite(nid_tra1,"flux_sparam_ind",itra,zx_tmp_2d_glo,            &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( flux_sparam_bb, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)           
-     CALL histwrite(nid_tra1,"flux_sparam_bb",itra,zx_tmp_2d_glo,             &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( flux_sparam_ff, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)           
-     CALL histwrite(nid_tra1,"flux_sparam_ff",itra,zx_tmp_2d_glo,             &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( flux_sparam_ddfine, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)       
-     CALL histwrite(nid_tra1,"flux_sparam_ddfine",itra,zx_tmp_2d_glo,         &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( flux_sparam_ddcoa, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)        
-     CALL histwrite(nid_tra1,"flux_sparam_ddcoa",itra,zx_tmp_2d_glo,          &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( flux_sparam_ddsco, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)        
-     CALL histwrite(nid_tra1,"flux_sparam_ddsco",itra,zx_tmp_2d_glo,          &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( flux_sparam_ssfine, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)       
-     CALL histwrite(nid_tra1,"flux_sparam_ssfine",itra,zx_tmp_2d_glo,         &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( flux_sparam_sscoa, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)        
-     CALL histwrite(nid_tra1,"flux_sparam_sscoa",itra,zx_tmp_2d_glo,          &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( u10m_ec, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                  
-     CALL histwrite(nid_tra1,"u10m",itra,zx_tmp_2d_glo,                       &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-     call gather( v10m_ec, auxklon_glo )
-!$OMP MASTER
-      IF (is_mpi_root .AND. is_omp_root) THEN
-     CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo)                  
-     CALL histwrite(nid_tra1,"v10m",itra,zx_tmp_2d_glo,                       &  
-                                  nbp_lon*(nbp_lat),ndex2d)                     
-!                                                                          
-!     call gather( , auxklon_glo )
-!!!   !$OMP MASTER
-!      IF (is_mpi_root .AND. is_omp_root) THEN
-!nhl     CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,flux_sparam_sulf,zx_tmp_3d_glo)  
-!nhl     CALL histwrite(nid_tra1,"flux_sparam_sulf",itra,zx_tmp_3d_glo,       &  
-!nhl    .                             nbp_lon*(nbp_lat)*nbp_lev,ndex3d)            
-!                                                                          
-      ENDIF ! mpi root
-!$OMP END MASTER
-!$OMP BARRIER
-
-      ENDIF ! ok_histrac                                                    
+!AS: commenting out and deleting lines 
+!!      IF (ok_histrac) THEN
+!!
+!! SAVING VARIABLES IN TRACEUR
+!!----- many lines deleted----
+!!      ENDIF ! ok_histrac                                                    
                                                                             
 
@@ -5479,6 +3987,4 @@
        dhkelsc04(i)=0. 
        dhkelsc05(i)=0.
-!       u10m_ss(i)=u10m_ec(i)
-!       v10m_ss(i)=v10m_ec(i)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -5599,4 +4105,12 @@
       d_tr_th04(i,k)=0.
       d_tr_th05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        ENDDO
+      ENDDO
+
+      IF(1==0) THEN 
+      ! calcul in original trunk version; problem: budget not closed. Corrected in "ELSE"
+      DO i=1, klon
+        DO k=1,klev
+
       if(id_prec>0)        d_tr_cv01(i,k)   =d_tr_cv_o(i,k,id_prec)
       if(id_fine>0)        d_tr_cv02(i,k)   =d_tr_cv_o(i,k,id_fine)
@@ -5641,5 +4155,52 @@
         ENDDO
       ENDDO
-      IF(1==0) THEN
+      ELSE ! correction pour fermeture de bilan, par FH dans les simus de Binta pour Habib
+      DO i=1, klon
+        DO k=1,klev
+      if(id_prec>0)        d_tr_cv01(i,k)   =d_tr_cv(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_cv02(i,k)   =d_tr_cv(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_cv03(i,k)   =d_tr_cv(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_cv04(i,k)   =d_tr_cv(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_cv05(i,k)   =d_tr_cv(i,k,id_scdu)/pdtphys
+      if(id_prec>0)        d_tr_trsp01(i,k) =d_tr_trsp(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_trsp02(i,k) =d_tr_trsp(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_trsp03(i,k) =d_tr_trsp(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_trsp04(i,k) =d_tr_trsp(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_trsp05(i,k) =d_tr_trsp(i,k,id_scdu)/pdtphys
+      if(id_prec>0)        d_tr_sscav01(i,k)=d_tr_sscav(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_sscav02(i,k)=d_tr_sscav(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_sscav03(i,k)=d_tr_sscav(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_sscav04(i,k)=d_tr_sscav(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_sscav05(i,k)=d_tr_sscav(i,k,id_scdu)/pdtphys
+      if(id_prec>0)        d_tr_sat01(i,k)  =d_tr_sat(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_sat02(i,k)  =d_tr_sat(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_sat03(i,k)  =d_tr_sat(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_sat04(i,k)  =d_tr_sat(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_sat05(i,k)  =d_tr_sat(i,k,id_scdu)/pdtphys
+      if(id_prec>0)        d_tr_uscav01(i,k)=d_tr_uscav(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_uscav02(i,k)=d_tr_uscav(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_uscav03(i,k)=d_tr_uscav(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_uscav04(i,k)=d_tr_uscav(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_uscav05(i,k)=d_tr_uscav(i,k,id_scdu)/pdtphys
+      if(id_prec>0)        d_tr_insc01(i,k)=d_tr_insc(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_insc02(i,k)=d_tr_insc(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_insc03(i,k)=d_tr_insc(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_insc04(i,k)=d_tr_insc(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_insc05(i,k)=d_tr_insc(i,k,id_scdu)/pdtphys
+      if(id_prec>0)        d_tr_bcscav01(i,k)=d_tr_bcscav(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_bcscav02(i,k)=d_tr_bcscav(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_bcscav03(i,k)=d_tr_bcscav(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_bcscav04(i,k)=d_tr_bcscav(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_bcscav05(i,k)=d_tr_bcscav(i,k,id_scdu)/pdtphys
+      if(id_prec>0)        d_tr_evapls01(i,k)=d_tr_evapls(i,k,id_prec)/pdtphys
+      if(id_fine>0)        d_tr_evapls02(i,k)=d_tr_evapls(i,k,id_fine)/pdtphys
+      if(id_coss>0)        d_tr_evapls03(i,k)=d_tr_evapls(i,k,id_coss)/pdtphys
+      if(id_codu>0)        d_tr_evapls04(i,k)=d_tr_evapls(i,k,id_codu)/pdtphys
+      if(id_scdu>0)        d_tr_evapls05(i,k)=d_tr_evapls(i,k,id_scdu)/pdtphys
+        ENDDO
+      ENDDO
+      ENDIF 
+
+      IF(1==0) THEN  ! This "if" is as in original trunk
       DO i=1, klon
         DO k=1,klev
@@ -5865,4 +4426,5 @@
       END SUBROUTINE readregions_spl
 
+!! AS: SUBROUTINE readscaleparams_spl pas appellee
       SUBROUTINE readscaleparams_spl(scale_param, nbreg, &
                                              filescaleparams)
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_dust.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_dust.F	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_dust.F	(revision 3851)
@@ -14,5 +14,5 @@
       real dust_ec_glo(klon_glo)
 c
-      real dust_nc(iip1,jjp1)
+c as      real dust_nc(iip1,jjp1)
       real dust_nc_glo(nbp_lon+1,nbp_lat)
       real rcode
@@ -59,7 +59,8 @@
 c--upside down + physical grid
 c
-c--OB=change jjp1 to 1 here
+c--OB=change jjp1 to 1 here ; 
+c----AS: OB's change is needed if lats N to S (90 to -90) in dust.nc
 !      dust_ec(1)=MAX(dust_nc(1,jjp1),0.0)
-      dust_ec(1)=MAX(dust_nc(1,nbp_lat),0.0)
+      dust_ec_glo(1)=MAX(dust_nc_glo(1,nbp_lat),0.0)
       ig=2
 !      DO j=2,jjm
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_newemissions.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_newemissions.F	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_newemissions.F	(revision 3851)
@@ -59,5 +59,5 @@
 !$OMP THREADPRIVATE(u10m_ec1, v10m_ec1, dust_ec1)
 !$OMP THREADPRIVATE(u10m_ec2, v10m_ec2, dust_ec2)
-      REAL u10m_nc(iip1,jjp1), v10m_nc(iip1,jjp1)
+c as      REAL u10m_nc(iip1,jjp1), v10m_nc(iip1,jjp1)
       REAL u10m_ec(klon), v10m_ec(klon), dust_ec(klon)
 c      REAL cly(klon), wth(klon), zprecipinsoil(klon)
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_vent.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_vent.F	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/read_vent.F	(revision 3851)
@@ -33,7 +33,7 @@
 c
          ncidu1=NCOPN('u10m.nc',NCNOWRIT,rcode)
-         varidu1=NCVID(ncidu1,'UWND',rcode)
+         varidu1=NCVID(ncidu1,'U10M',rcode)
          ncidv1=NCOPN('v10m.nc',NCNOWRIT,rcode)
-         varidv1=NCVID(ncidv1,'VWND',rcode)
+         varidv1=NCVID(ncidv1,'V10M',rcode)
 c
       endif
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/spla_output_write.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/spla_output_write.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/spla_output_write.h	(revision 3851)
@@ -9,16 +9,16 @@
       CALL histwrite_phy( o_taue670          , diag_aod670_tot  )
       CALL histwrite_phy( o_taue865          , diag_aod865_tot  ) 
-      IF(id_fine>0) CALL histwrite_phy( o_taue550_tr2      , diff_aod550_tr2  )
-      IF(id_fine>0) CALL histwrite_phy( o_taue670_tr2      , diag_aod670_tr2  )
-      IF(id_fine>0) CALL histwrite_phy( o_taue865_tr2      , diag_aod865_tr2  )
-      IF(id_coss>0) CALL histwrite_phy( o_taue550_ss       , diag_aod550_ss   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue670_ss       , diag_aod670_ss   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue865_ss       , diag_aod865_ss   )
-      IF(id_codu>0) CALL histwrite_phy( o_taue550_dust     , diag_aod550_dust )
-      IF(id_codu>0) CALL histwrite_phy( o_taue670_dust     , diag_aod670_dust )
-      IF(id_codu>0) CALL histwrite_phy( o_taue865_dust     , diag_aod865_dust )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue550_dustsco  , diag_aod550_dustsco )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue670_dustsco  , diag_aod670_dustsco )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue865_dustsco  , diag_aod865_dustsco )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_tr2      , diff_aod550_tr2  )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_tr2      , diag_aod670_tr2  )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_tr2      , diag_aod865_tr2  )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_ss       , diag_aod550_ss   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_ss       , diag_aod670_ss   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_ss       , diag_aod865_ss   )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_dust     , diag_aod550_dust )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_dust     , diag_aod670_dust )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_dust     , diag_aod865_dust )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_dustsco  , diag_aod550_dustsco )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_dustsco  , diag_aod670_dustsco )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_dustsco  , diag_aod865_dustsco )
       CALL histwrite_phy( o_taue550_aqua     , aod550_aqua  )
       CALL histwrite_phy( o_taue550_terra    , aod550_terra )
@@ -28,157 +28,157 @@
       CALL histwrite_phy( o_taue865_terra    , aod865_terra )
 
-      IF(id_fine>0) CALL histwrite_phy( o_taue550_fine_aqua     ,aod550_tr2_aqua   )
-      IF(id_fine>0) CALL histwrite_phy( o_taue670_fine_aqua     ,aod670_tr2_aqua   )
-      IF(id_fine>0) CALL histwrite_phy( o_taue865_fine_aqua     ,aod865_tr2_aqua   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue550_coss_aqua      ,aod550_ss_aqua   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue670_coss_aqua      ,aod670_ss_aqua   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue865_coss_aqua      ,aod865_ss_aqua   )
-      IF(id_codu>0) CALL histwrite_phy( o_taue550_codu_aqua    ,aod550_dust_aqua   )
-      IF(id_codu>0) CALL histwrite_phy( o_taue670_codu_aqua    ,aod670_dust_aqua   )
-      IF(id_codu>0) CALL histwrite_phy( o_taue865_codu_aqua    ,aod865_dust_aqua   )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue670_scdu_aqua ,aod670_dustsco_aqua   )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue550_scdu_aqua ,aod550_dustsco_aqua   )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue865_scdu_aqua ,aod865_dustsco_aqua   )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_fine_aqua     ,aod550_tr2_aqua   )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_fine_aqua     ,aod670_tr2_aqua   )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_fine_aqua     ,aod865_tr2_aqua   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_coss_aqua      ,aod550_ss_aqua   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_coss_aqua      ,aod670_ss_aqua   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_coss_aqua      ,aod865_ss_aqua   )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_codu_aqua    ,aod550_dust_aqua   )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_codu_aqua    ,aod670_dust_aqua   )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_codu_aqua    ,aod865_dust_aqua   )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_scdu_aqua ,aod670_dustsco_aqua   )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_scdu_aqua ,aod550_dustsco_aqua   )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_scdu_aqua ,aod865_dustsco_aqua   )
       
-      IF(id_fine>0) CALL histwrite_phy( o_taue550_fine_terra     ,aod550_tr2_terra   )
-      IF(id_fine>0) CALL histwrite_phy( o_taue670_fine_terra     ,aod670_tr2_terra   )
-      IF(id_fine>0) CALL histwrite_phy( o_taue865_fine_terra     ,aod865_tr2_terra   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue550_coss_terra      ,aod550_ss_terra   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue670_coss_terra      ,aod670_ss_terra   )
-      IF(id_coss>0) CALL histwrite_phy( o_taue865_coss_terra      ,aod865_ss_terra   )
-      IF(id_codu>0) CALL histwrite_phy( o_taue550_codu_terra    ,aod550_dust_terra   )
-      IF(id_codu>0) CALL histwrite_phy( o_taue670_codu_terra    ,aod670_dust_terra   )
-      IF(id_codu>0) CALL histwrite_phy( o_taue865_codu_terra    ,aod865_dust_terra   )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue670_scdu_terra ,aod670_dustsco_terra   )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue550_scdu_terra ,aod550_dustsco_terra   )
-      IF(id_scdu>0) CALL histwrite_phy( o_taue865_scdu_terra ,aod865_dustsco_terra   )
-
-
-      IF(id_prec>0) CALL histwrite_phy( o_trm01 , trm01 )
-      IF(id_fine>0) CALL histwrite_phy( o_trm02 , trm02 )
-      IF(id_coss>0) CALL histwrite_phy( o_trm03 , trm03 )
-      IF(id_codu>0) CALL histwrite_phy( o_trm04 , trm04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_trm05 , trm05 )
-      IF(id_prec>0) CALL histwrite_phy( o_sconc01 , sconc01 )
-      IF(id_fine>0) CALL histwrite_phy( o_sconc02 , sconc02 )
-      IF(id_coss>0) CALL histwrite_phy( o_sconc03 , sconc03 )
-      IF(id_codu>0) CALL histwrite_phy( o_sconc04 , sconc04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_sconc05 , sconc05 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_fine_terra     ,aod550_tr2_terra   )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_fine_terra     ,aod670_tr2_terra   )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_fine_terra     ,aod865_tr2_terra   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_coss_terra      ,aod550_ss_terra   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_coss_terra      ,aod670_ss_terra   )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_coss_terra      ,aod865_ss_terra   )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_codu_terra    ,aod550_dust_terra   )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_codu_terra    ,aod670_dust_terra   )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_codu_terra    ,aod865_dust_terra   )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue670_scdu_terra ,aod670_dustsco_terra   )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue550_scdu_terra ,aod550_dustsco_terra   )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_taue865_scdu_terra ,aod865_dustsco_terra   )
+
+
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_trm01 , trm01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_trm02 , trm02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_trm03 , trm03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_trm04 , trm04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_trm05 , trm05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sconc01 , sconc01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sconc02 , sconc02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sconc03 , sconc03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sconc04 , sconc04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sconc05 , sconc05 )
 
 ! Lessivage
 
-      IF(id_prec>0) CALL histwrite_phy( o_flux01       , flux01 )
-      IF(id_fine>0) CALL histwrite_phy( o_flux02       , flux02 )
-      IF(id_coss>0) CALL histwrite_phy( o_flux03       , flux03 )
-      IF(id_codu>0) CALL histwrite_phy( o_flux04       , flux04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_flux05       , flux05 )
-      IF(id_prec>0) CALL histwrite_phy( o_ds01         , ds01 )
-      IF(id_fine>0) CALL histwrite_phy( o_ds02         , ds02 )
-      IF(id_coss>0) CALL histwrite_phy( o_ds03         , ds03 )
-      IF(id_codu>0) CALL histwrite_phy( o_ds04         , ds04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_ds05         , ds05 )
-      IF(id_prec>0) CALL histwrite_phy( o_dh01         , dh01 )
-      IF(id_fine>0) CALL histwrite_phy( o_dh02         , dh02 )
-      IF(id_coss>0) CALL histwrite_phy( o_dh03         , dh03 )
-      IF(id_codu>0) CALL histwrite_phy( o_dh04         , dh04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_dh05         , dh05 )
-      IF(id_prec>0) CALL histwrite_phy( o_dtrconv01    , dtrconv01 )
-      IF(id_fine>0) CALL histwrite_phy( o_dtrconv02    , dtrconv02 )
-      IF(id_coss>0) CALL histwrite_phy( o_dtrconv03    , dtrconv03 )
-      IF(id_codu>0) CALL histwrite_phy( o_dtrconv04    , dtrconv04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_dtrconv05    , dtrconv05 )
-      IF(id_prec>0) CALL histwrite_phy( o_dtherm01     , dtherm01 )
-      IF(id_fine>0) CALL histwrite_phy( o_dtherm02     , dtherm02 )
-      IF(id_coss>0) CALL histwrite_phy( o_dtherm03     , dtherm03 )
-      IF(id_codu>0) CALL histwrite_phy( o_dtherm04     , dtherm04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_dtherm05     , dtherm05 )
-      IF(id_prec>0) CALL histwrite_phy( o_dhkecv01     , dhkecv01 )
-      IF(id_fine>0) CALL histwrite_phy( o_dhkecv02     , dhkecv02 )
-      IF(id_coss>0) CALL histwrite_phy( o_dhkecv03     , dhkecv03 )
-      IF(id_codu>0) CALL histwrite_phy( o_dhkecv04     , dhkecv04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_dhkecv05     , dhkecv05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_ds01     , d_tr_ds01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_ds02     , d_tr_ds02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_ds03     , d_tr_ds03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_ds04     , d_tr_ds04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_ds05     , d_tr_ds05 )
-      IF(id_prec>0) CALL histwrite_phy( o_dhkelsc01    , dhkelsc01 )
-      IF(id_fine>0) CALL histwrite_phy( o_dhkelsc02    , dhkelsc02 )
-      IF(id_coss>0) CALL histwrite_phy( o_dhkelsc03    , dhkelsc03 )
-      IF(id_codu>0) CALL histwrite_phy( o_dhkelsc04    , dhkelsc04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_dhkelsc05    , dhkelsc05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_cv01    , d_tr_cv01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_cv02    , d_tr_cv02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_cv03    , d_tr_cv03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_cv04    , d_tr_cv04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_cv05    , d_tr_cv05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_trsp01  , d_tr_trsp01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_trsp02  , d_tr_trsp02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_trsp03  , d_tr_trsp03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_trsp04  , d_tr_trsp04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_trsp05  , d_tr_trsp05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_sscav01 , d_tr_sscav01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_sscav02 , d_tr_sscav02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_sscav03 , d_tr_sscav03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_sscav04 , d_tr_sscav04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_sscav05 , d_tr_sscav05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_sat01   , d_tr_sat01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_sat02   , d_tr_sat02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_sat03   , d_tr_sat03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_sat04   , d_tr_sat04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_sat05   , d_tr_sat05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_uscav01 , d_tr_uscav01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_uscav02 , d_tr_uscav02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_uscav03 , d_tr_uscav03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_uscav04 , d_tr_uscav04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_uscav05 , d_tr_uscav05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_insc01 , d_tr_insc01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_insc02 , d_tr_insc02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_insc03 , d_tr_insc03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_insc04 , d_tr_insc04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_insc05 , d_tr_insc05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_bcscav01 , d_tr_bcscav01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_bcscav02 , d_tr_bcscav02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_bcscav03 , d_tr_bcscav03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_bcscav04 , d_tr_bcscav04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_bcscav05 , d_tr_bcscav05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_evapls01 , d_tr_evapls01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_evapls02 , d_tr_evapls02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_evapls03 , d_tr_evapls03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_evapls04 , d_tr_evapls04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_evapls05 , d_tr_evapls05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_ls01 , d_tr_ls01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_ls02 , d_tr_ls02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_ls03 , d_tr_ls03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_ls04 , d_tr_ls04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_ls05 , d_tr_ls05 )
-
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_dyn01 , d_tr_dyn01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_dyn02 , d_tr_dyn02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_dyn03 , d_tr_dyn03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_dyn04 , d_tr_dyn04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_dyn05 , d_tr_dyn05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_flux01       , flux01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_flux02       , flux02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_flux03       , flux03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_flux04       , flux04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_flux05       , flux05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_ds01         , ds01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_ds02         , ds02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_ds03         , ds03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_ds04         , ds04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_ds05         , ds05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dh01         , dh01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dh02         , dh02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dh03         , dh03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dh04         , dh04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dh05         , dh05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtrconv01    , dtrconv01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtrconv02    , dtrconv02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtrconv03    , dtrconv03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtrconv04    , dtrconv04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtrconv05    , dtrconv05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtherm01     , dtherm01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtherm02     , dtherm02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtherm03     , dtherm03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtherm04     , dtherm04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dtherm05     , dtherm05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkecv01     , dhkecv01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkecv02     , dhkecv02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkecv03     , dhkecv03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkecv04     , dhkecv04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkecv05     , dhkecv05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ds01     , d_tr_ds01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ds02     , d_tr_ds02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ds03     , d_tr_ds03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ds04     , d_tr_ds04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ds05     , d_tr_ds05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkelsc01    , dhkelsc01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkelsc02    , dhkelsc02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkelsc03    , dhkelsc03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkelsc04    , dhkelsc04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_dhkelsc05    , dhkelsc05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cv01    , d_tr_cv01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cv02    , d_tr_cv02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cv03    , d_tr_cv03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cv04    , d_tr_cv04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cv05    , d_tr_cv05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_trsp01  , d_tr_trsp01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_trsp02  , d_tr_trsp02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_trsp03  , d_tr_trsp03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_trsp04  , d_tr_trsp04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_trsp05  , d_tr_trsp05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sscav01 , d_tr_sscav01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sscav02 , d_tr_sscav02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sscav03 , d_tr_sscav03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sscav04 , d_tr_sscav04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sscav05 , d_tr_sscav05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sat01   , d_tr_sat01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sat02   , d_tr_sat02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sat03   , d_tr_sat03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sat04   , d_tr_sat04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_sat05   , d_tr_sat05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_uscav01 , d_tr_uscav01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_uscav02 , d_tr_uscav02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_uscav03 , d_tr_uscav03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_uscav04 , d_tr_uscav04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_uscav05 , d_tr_uscav05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_insc01 , d_tr_insc01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_insc02 , d_tr_insc02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_insc03 , d_tr_insc03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_insc04 , d_tr_insc04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_insc05 , d_tr_insc05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_bcscav01 , d_tr_bcscav01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_bcscav02 , d_tr_bcscav02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_bcscav03 , d_tr_bcscav03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_bcscav04 , d_tr_bcscav04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_bcscav05 , d_tr_bcscav05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_evapls01 , d_tr_evapls01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_evapls02 , d_tr_evapls02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_evapls03 , d_tr_evapls03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_evapls04 , d_tr_evapls04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_evapls05 , d_tr_evapls05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ls01 , d_tr_ls01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ls02 , d_tr_ls02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ls03 , d_tr_ls03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ls04 , d_tr_ls04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_ls05 , d_tr_ls05 )
+
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_dyn01 , d_tr_dyn01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_dyn02 , d_tr_dyn02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_dyn03 , d_tr_dyn03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_dyn04 , d_tr_dyn04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_dyn05 , d_tr_dyn05 )
       
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_cl01 , d_tr_cl01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_cl02 , d_tr_cl02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_cl03 , d_tr_cl03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_cl04 , d_tr_cl04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_cl05 , d_tr_cl05 )
-      IF(id_prec>0) CALL histwrite_phy( o_d_tr_th01 , d_tr_th01 )
-      IF(id_fine>0) CALL histwrite_phy( o_d_tr_th02 , d_tr_th02 )
-      IF(id_coss>0) CALL histwrite_phy( o_d_tr_th03 , d_tr_th03 )
-      IF(id_codu>0) CALL histwrite_phy( o_d_tr_th04 , d_tr_th04 )
-      IF(id_scdu>0) CALL histwrite_phy( o_d_tr_th05 , d_tr_th05 )
-
-      IF(id_coss>0) CALL histwrite_phy( o_sed_ss , sed_ss)
-      IF(id_codu>0) CALL histwrite_phy( o_sed_dust , sed_dust)
-      IF(id_scdu>0) CALL histwrite_phy( o_sed_dustsco , sed_dustsco)
-      IF(id_prec>0) CALL histwrite_phy( o_g2p_gas , his_g2pgas )
-      IF(id_fine>0) CALL histwrite_phy( o_g2p_aer , his_g2paer)
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cl01 , d_tr_cl01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cl02 , d_tr_cl02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cl03 , d_tr_cl03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cl04 , d_tr_cl04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_cl05 , d_tr_cl05 )
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_th01 , d_tr_th01 )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_th02 , d_tr_th02 )
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_th03 , d_tr_th03 )
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_th04 , d_tr_th04 )
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_d_tr_th05 , d_tr_th05 )
+
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sed_ss , sed_ss)
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sed_dust , sed_dust)
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sed_dustsco , sed_dustsco)
+      IF(id_prec>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_g2p_gas , his_g2pgas )
+      IF(id_fine>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_g2p_aer , his_g2paer)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      IF(id_coss>0) CALL histwrite_phy( o_sed_ss3D , sed_ss3D)
-      IF(id_codu>0) CALL histwrite_phy( o_sed_dust3D , sed_dust3D)
-      IF(id_scdu>0) CALL histwrite_phy( o_sed_dustsco3D , sed_dustsco3D)
+      IF(id_coss>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sed_ss3D , sed_ss3D)
+      IF(id_codu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sed_dust3D , sed_dust3D)
+      IF(id_scdu>0 .OR. .NOT. vars_defined) CALL histwrite_phy( o_sed_dustsco3D , sed_dustsco3D)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! histrac_spl
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/splaeropt_6bands_rrtm.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/splaeropt_6bands_rrtm.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Dust/splaeropt_6bands_rrtm.F90	(revision 3851)
@@ -9,5 +9,5 @@
   USE aero_mod
   USE infotrac_phy
-  USE phys_local_var_mod, ONLY: absvisaer
+  USE phys_local_var_mod, ONLY: abs550aer
 
   ! Olivier Boucher Jan 2017
@@ -260,5 +260,5 @@
 !--waveband 2 and all aerosol (third index = 2)
   inu=2
-  absvisaer(:)=SUM((1-piz_allaer(:,:,2,inu))*tau_allaer(:,:,2,inu),dim=2)
+  abs550aer(:)=SUM((1-piz_allaer(:,:,2,inu))*tau_allaer(:,:,2,inu),dim=2)
 
 END SUBROUTINE SPLAEROPT_6BANDS_RRTM
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/bulk_flux_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/bulk_flux_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/bulk_flux_m.F90	(revision 3851)
@@ -0,0 +1,155 @@
+module bulk_flux_m
+
+  implicit none
+
+contains
+
+  subroutine bulk_flux(tkt, tks, taur, dter, dser, t_int, s_int, ds_ns, dt_ns, &
+       u, t_ocean_1, s1, rain, hf, hlb, rnl, tau, rhoa, xlv, rf, dtime, rns)
+
+    use config_ocean_skin_m, only: jwarm, jcool, rain_effect
+    use Microlayer_m, only: Microlayer
+    use mom_flux_rain_m, only: mom_flux_rain
+    use Near_Surface_m, only: Near_Surface, depth
+    use therm_expans_m, only: therm_expans
+
+    real, intent(out):: tkt(:)
+    ! thickness of cool skin (microlayer), in m
+
+    real, intent(out):: tks(:)
+    ! thickness of mass diffusion layer (microlayer), in m
+
+    real, intent(out):: taur(:) ! momentum flux due to rain, in Pa
+
+    real, intent(out):: dter(:)
+    ! Temperature variation in the diffusive microlayer, that is
+    ! ocean-air interface temperature minus subskin temperature. In K.
+
+    real, intent(out):: dser(:)
+    ! Salinity variation in the diffusive microlayer, that is ocean-air
+    ! interface salinity minus subskin salinity. In ppt.
+
+    real, intent(out):: t_int(:) ! interface temperature, in K
+    real, intent(out):: s_int(:) ! interface salinity, in ppt
+
+    real, intent(inout):: ds_ns(:)
+    ! "delta salinity near surface". Salinity variation in the
+    ! near-surface turbulent layer. That is subskin salinity minus
+    ! foundation salinity. In ppt.
+
+    real, intent(inout):: dt_ns(:)
+    ! "delta temperature near surface". Temperature variation in the
+    ! near-surface turbulent layer. That is subskin temperature minus
+    ! foundation temperature. (Can be negative.) In K.
+
+    real, intent(in):: u(:)
+    ! Wind speed relative to the sea surface, i. e. taking current
+    ! vector into account. In m s-1.
+
+    real, intent(in):: t_ocean_1(:) ! input sea temperature, at depth_1, in K
+    real, intent(in):: S1(:) ! salinity at depth_1, in ppt
+
+    real, intent(in):: rain(:)
+    ! rain mass flux, averaged on a timestep, in kg m-2 s-1
+
+    real, intent(in):: hf(:)
+    !  turbulent part of sensible heat flux, positive upward, in W m-2
+
+    real, intent(in):: hlb(:)
+    ! latent heat flux at the surface, positive upward (W m-2)
+
+    real, intent(in):: rnl(:)
+    ! net longwave radiation, positive upward, in W m-2
+
+    real, intent(in):: tau(:)
+    ! wind stress at the surface, turbulent part only, in Pa
+    
+    real, intent(in):: rhoa(:) ! density of moist air  (kg / m3)
+    real, intent(in):: xlv(:) ! latent heat of evaporation (J / kg)
+
+    real, intent(in):: rf(:)
+    ! sensible heat flux at the surface due to rainfall, in W m-2,
+    ! positive upward
+
+    real, intent(in):: dtime ! time step, in s
+    real, intent(in):: rns(:) ! net downward shortwave radiation, in W m-2
+
+    ! Local:
+    
+    real al(size(t_ocean_1)) ! water thermal expansion coefficient (in K-1)
+    real dels(size(t_ocean_1)), null_array(size(t_ocean_1))
+    integer iter
+    real t_subskin(size(t_ocean_1)) ! subskin temperature, in K
+    real s_subskin(size(t_ocean_1)) ! subskin salinity, in ppt
+
+    real, parameter:: fxp = 1. - (0.28 * 0.014 &
+         + 0.27 * 0.357 * (1. - exp(- depth / 0.357)) &
+         + .45 * 12.82 * (1.- exp(- depth / 12.82))) / depth
+    ! underflow ! fxp = 1. - (0.28 * 0.014 * (1. - exp(- depth / 0.014)) &
+    ! Soloviev solar absorption profile
+    ! H. Bellenger 2016
+
+    real tau_with_min(size(t_ocean_1))
+    ! modified wind stress, avoiding very low values
+    
+    real, parameter:: tau_0 = 1e-3 ! in N m-2
+
+    !-------------------------------------------------------------------
+
+    if (rain_effect) then
+       taur = mom_flux_rain(u, rain)
+    else
+       if (jwarm .or. jcool) null_array = 0.
+       taur = 0.
+    end if
+
+    if (jwarm .or. jcool) tau_with_min = tau + tau_0 * (1. - exp(- tau_0 / tau))
+
+    if (Jwarm) then
+       if (rain_effect) then
+          call Near_Surface(al, t_subskin, s_subskin, ds_ns, dt_ns, &
+               tau_with_min, taur, hlb, rhoa, xlv, dtime, t_ocean_1, s1, rain, &
+               q_pwp = fxp * rns - (hf + hlb + rnl + rf))
+       else
+          call Near_Surface(al, t_subskin, s_subskin, ds_ns, dt_ns, &
+               tau_with_min, taur, hlb, rhoa, xlv, dtime, t_ocean_1, s1, &
+               rain = null_array, q_pwp = fxp * rns - (hf + hlb + rnl))
+       end if
+    else
+       if (Jcool) al = therm_expans(t_ocean_1)
+       t_subskin = t_ocean_1
+       s_subskin = s1
+    end if
+
+    if (Jcool) then
+       ! First guess:
+       tkt = 0.001
+       tks = 5e-4
+
+       do iter = 1, 3
+          ! Cool skin
+          dels = rns * (0.065 + 11. * tkt - 6.6e-5 / tkt &
+               * (1. - exp(- tkt / 8e-4))) ! equation 16 Ohlmann
+          if (rain_effect) then
+             call Microlayer(dter, dser, tkt, tks, hlb, tau_with_min, &
+                  s_subskin, al, xlv, taur, rf, rain, &
+                  qcol = rnl + hf + hlb - dels)
+          else
+             call Microlayer(dter, dser, tkt, tks, hlb, tau_with_min, &
+                  s_subskin, al, xlv, taur, rf = null_array, &
+                  rain = null_array, qcol = rnl + hf + hlb - dels)
+          end if
+       end do
+    else
+       tkt = 0.
+       tks = 0.
+       dter = 0.
+       dser = 0.
+    end if
+
+    t_int = t_subskin + dter
+    s_int = s_subskin + dser
+
+  end subroutine bulk_flux
+
+end module bulk_flux_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/config_ocean_skin_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/config_ocean_skin_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/config_ocean_skin_m.F90	(revision 3851)
@@ -0,0 +1,81 @@
+module config_ocean_skin_m
+
+  implicit none
+
+  logical, protected:: jcool ! cool skin calculation
+  logical, protected:: jwarm ! warm layer calculation
+  logical, protected:: rain_effect
+
+  real, protected:: depth_1 = 20.
+  ! Depth at which the temperature and salinity are input. Could be
+  ! the depth of a sensor, or the depth at the middle of the first
+  ! layer of an ocean model (half the depth of the first layer). In
+  ! m. Setting depth_1 to any value >= depth has the same effect as
+  ! setting depth_1 to depth.
+
+  !$omp threadprivate(jcool, jwarm, rain_effect, depth_1)
+
+#ifdef IN_LMDZ
+  integer, protected:: activate_ocean_skin = 0
+  ! Allowed values: 0 do not activate; 1 activate without retroaction
+  ! on LMDZ; 2 activate with retroaction on LMDZ
+  
+  !$omp threadprivate(activate_ocean_skin)
+#endif
+
+contains
+
+  subroutine config_ocean_skin
+
+#ifdef IN_LMDZ
+    use ioipsl_getin_p_mod, only: getin_p
+    use assert_m, only: assert
+#endif
+
+    integer:: flag_ocean_skin = 3
+    !$omp threadprivate(flag_ocean_skin)
+    
+    namelist /config_ocean_skin_nml/ flag_ocean_skin, depth_1
+
+    !-----------------------------------------------------------------------
+
+#ifdef IN_LMDZ
+    call getin_p("activate_ocean_skin", activate_ocean_skin)
+    call assert(activate_ocean_skin >= 0 .and. activate_ocean_skin <= 2, &
+         "config_ocean_skin bad value of activate_ocean_skin")
+    if (activate_ocean_skin >= 1) then
+       call getin_p("flag_ocean_skin", flag_ocean_skin)
+       call getin_p("depth_1", depth_1)
+    end if
+#else
+    write(unit = *, nml = config_ocean_skin_nml)
+    print *, "Enter namelist config_ocean_skin_nml."
+    read(unit = *, nml = config_ocean_skin_nml)
+    write(unit = *, nml = config_ocean_skin_nml)
+#endif
+
+    select case (flag_ocean_skin)
+    case (0)
+       jwarm = .false.
+       jcool = .false.
+       rain_effect = .false.
+    case (1)
+       jwarm = .false.
+       jcool = .true.
+       rain_effect = .false.
+    case (2)
+       jwarm = .true.
+       jcool = .true.
+       rain_effect = .false.
+    case (3)
+       jwarm = .true.
+       jcool = .true.
+       rain_effect = .true.
+    case default
+       print *, "config_ocean_skin: bad value for flag_ocean_skin."
+       stop 1
+    end select
+
+  end subroutine config_ocean_skin
+
+end module config_ocean_skin_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/const.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/const.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/const.F90	(revision 3851)
@@ -0,0 +1,27 @@
+module const
+
+  implicit none
+
+  real, parameter:: beta = 0.756 / 1023.343
+  ! Salinity expansion coefficient. Derivative with respect to
+  ! practical salinity, not mass fraction of salt. Value at 25 Celsius
+  ! degrees, zero pressure, practical salinity 35, from Gill (1982
+  ! k0829, table A.3.1).
+
+  real, parameter:: cpa = 1004.67
+  ! specific heat of dry air, in J / kg / K (Businger 1982)
+
+  real, parameter:: cpw = 4000. ! specific heat of liquid water, in J / kg / K
+  real, parameter:: grav  = 9.780326772 ! constante de gravitation, m s-2
+  real, parameter::  rhow = 1022. ! density of liquid water, in kg / m3
+
+  real, parameter:: rgas = 287.1
+  ! specific ideal gas constant for dry air, in J / kg / K
+
+  real, parameter:: von = 0.4 ! von Karman's "constant"
+
+  real, parameter:: eps_w = 0.62197
+  ! molecular mass of water over molecular mass of dry air (Gill 1982
+  ! k0829, equation 3.1.13)
+
+end module const
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/esat_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/esat_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/esat_m.F90	(revision 3851)
@@ -0,0 +1,22 @@
+module esat_m
+
+  implicit none
+
+contains
+
+  elemental real function esat(T, P)
+
+    ! Saturation vapor pressure of water in Pa. Buck, 1981,
+    ! J. Appl. Meteor. 20, 1527-1532, equation (8).
+
+    real, intent(in):: T ! temperature, in K
+    real, intent(in):: P ! air pressure, in Pa
+
+    !--------------------------------------------------------------------
+
+    esat = (1.0007 + 3.46e-8 * P) * 6.1121e2 &
+         * exp(17.502 * (T - 273.15) / (T - 32.18))
+
+  end function esat
+
+end module esat_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/fv_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/fv_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/fv_m.F90	(revision 3851)
@@ -0,0 +1,46 @@
+module fv_m
+
+  implicit none
+
+contains
+
+  elemental real function fV(z, rain)
+
+    ! H. Bellenger 2016
+
+    real, intent(in):: z ! profondeur en m (z < 0)
+    real, intent(in):: rain ! rain mass flux, in kg m-2 s-1
+
+    ! Local:
+
+    real dfV
+    ! fraction of rain volume entering the ocean and deposited within depth "z"
+
+    real rc, lbd, f0
+    real z_mm
+
+    ! Schlussel et al. 1997, Table 1:
+    real, parameter:: zeta(14) = [0.0026091, 0.0022743, 0.0015406, 0.0012281, &
+         0.0008795, 0.00077123, 0.00057451, 0.000438, 6.7228e-5, 6.4955e-5, &
+         4.4234e-5, 3.3906e-5, 2.7433e-6, 4.0283e-7]
+    real, parameter:: psi(14) = [0.60107, 0.29968, 0.5563, 1.80858, 0.2175, &
+         0.33961, 0.96368, 0.65081, 0.5967, 2.7661, 2.2812, 2.7674, 2.6095, &
+         6.5308]
+
+    !---------------------------------------------------------------------
+
+    if (rain > 0.) then
+       rc = 0.4 ! mm
+       z_mm = z * 1000. ! mm and <0
+       lbd = 4.1 * (rain * 3600.)**(- 0.21) ! mm-1
+       f0 = (1. + 2. * lbd * rc + 0.5 * (2. * lbd * rc)**2 &
+            + 1. / 6. * (2. * lbd * rc)**3) * exp(- 1. * 2. * lbd * rc)
+       dfv = sum(zeta * exp(- psi * lbd * abs(z_mm) / 100.))
+       fV = - dfV * abs(z_mm) + f0
+    else
+       fV = 0.
+    endif
+
+  end function fV
+
+end module fv_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/microlayer_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/microlayer_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/microlayer_m.F90	(revision 3851)
@@ -0,0 +1,106 @@
+module Microlayer_m
+
+  Implicit none
+
+contains
+
+  subroutine Microlayer(dter, dser, tkt, tks, hlb, tau, s_subskin, al, &
+       xlv, taur, rf, rain, qcol)
+
+    ! H. Bellenger 2016
+
+    use const, only: beta, cpw, grav, rhow
+    use fv_m, only: fv
+
+    real, intent(out):: dter(:)
+    ! Temperature variation in the diffusive microlayer, that is
+    ! ocean-air interface temperature minus subskin temperature. In K.
+
+    real, intent(out):: dser(:)
+    ! Salinity variation in the diffusive microlayer, that is ocean-air
+    ! interface salinity minus subskin salinity. In ppt.
+
+    real, intent(inout):: tkt(:)
+    ! thickness of cool skin (microlayer), in m
+
+    real, intent(inout):: tks(:)
+    ! thickness of mass diffusion layer (microlayer), in m
+
+    real, intent(in):: hlb(:)
+    ! latent heat flux at the surface, positive upward (W m-2)
+
+    real, intent(in):: tau(:) ! wind stress, turbulent part only, in Pa
+    real, intent(in):: s_subskin(:) ! subskin salinity, in ppt
+    real, intent(in):: al(:) ! water thermal expansion coefficient (in K-1)
+    real, intent(in):: xlv(:) ! latent heat of evaporation (J/kg)
+    real, intent(in):: taur(:) ! momentum flux due to rainfall, in Pa
+
+    real, intent(in):: rf(:)
+    ! sensible heat flux at the surface due to rainfall, in W m-2
+
+    real, intent(in):: rain(:) ! rain mass flux, in kg m-2 s-1
+
+    real, intent(in):: qcol(:)
+    ! net flux at the surface, without sensible heat flux due to rain, in W m-2
+
+    ! Local:
+
+    real, dimension(size(qcol)):: usrk, usrct, usrcs, alq
+    real xlamx(size(qcol)) ! Saunders coefficient
+    real, parameter:: visw = 1e-6
+    real, parameter:: tcw = 0.6 ! thermal conductivity of water
+
+    real, parameter:: mu = 0.0129e-7 ! in m2 / s
+    ! molecular salinity diffusivity, Kraus and Businger, page 47
+
+    real, parameter:: kappa = 1.49e-7 ! thermal diffusivity, in m2 / s
+
+    real, parameter:: afk = 4e-4
+    real, parameter:: bfk = 1.3
+    ! a and b coefficient for the power function fitting the TKE flux 
+    ! carried by rain:  Fk = a * R**b, derived form the exact solution
+    ! of Soloviev and Lukas 2006 (Schlussel et al 1997, Craeye and
+    ! Schlussel 1998)
+
+    !--------------------------------------------------------------------------
+
+    alq = al * (qcol + rf * (1 - fV(tkt, rain))) - beta * s_subskin * cpw &
+         * (hlb / xlv - rain * (1 - fV(tks, rain)))
+
+    usrk = (afk / rhow)**(1. / 3.) * (rain * 3600.)**(bfk / 3.)
+    ! Equivalent friction velocity due to the TKE input by the penetrating
+    ! raindrops Fk
+
+    ! Friction velocities in the air:
+    usrct = sqrt((tau + (1. - fV(tkt, rain)) * taur) / rhow &
+         + (fV(0., rain) - fV(tkt, rain)) * usrk**2)
+    usrcs = sqrt((tau + (1. - fV(tks, rain)) * taur) / rhow &
+         + (fV(0., rain) - fV(tks, rain)) * usrk**2)
+
+    where (alq > 0.)
+       ! Fairall 1996 982, equation (14):
+       xlamx = 6. * (1. + (16. * grav * cpw * rhow * visw**3 * alq &
+            / (tcw**2 * usrct**4 ))**0.75)**(- 1. / 3.)
+
+       ! Fairall 1996 982, equation (12):
+       tkt = xlamx * visw / usrct
+
+       tks = xlamx * mu * (kappa / mu)**(2. / 3.) &
+            * visw * cpw * rhow / ( tcw * usrcs)
+       ! From Saunders 1967 (4)
+    elsewhere
+       xlamx = 6. ! prevent excessive warm skins
+       tkt = min(.01, xlamx * visw / usrct) ! Limit tkt
+       tks = min(.001, xlamx * mu * (kappa / mu)**(2. / 3.) * visw * cpw &
+            * rhow / (tcw * usrcs))
+    end where
+
+    ! Fairall 1996 982, equation (13):
+    dter = - (qcol + rf * (1 - fV(tkt, rain))) * tkt / tcw
+
+    dser = s_subskin * (hlb / xlv - rain * (1 - fV(tks, rain))) * tks &
+         / (rhow * mu) ! eq. fresh skin
+
+  end subroutine Microlayer
+
+end module Microlayer_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/mom_flux_rain_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/mom_flux_rain_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/mom_flux_rain_m.F90	(revision 3851)
@@ -0,0 +1,24 @@
+module mom_flux_rain_m
+
+  implicit none
+
+contains
+
+  elemental real function mom_flux_rain(u, rain)
+
+    ! Computes momentum flux due to rainfall, in Pa.
+
+    real, intent(in):: U
+    ! difference of velocity between air and sea, including gustiness, in m / s
+
+    real, intent(in):: rain ! rain mass flux, in kg m-2 s-1
+
+    !------------------------------------------------------------------------
+
+    mom_flux_rain = 0.85 * U * rain
+    ! (Caldwell 1971 k1001, equation (1) and 15 % reduction in speed
+    ! as in paragraph 3.a, maybe adequate if u is the wind at 10 m)
+
+  end function mom_flux_rain
+  
+end module mom_flux_rain_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/near_surface_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/near_surface_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/near_surface_m.F90	(revision 3851)
@@ -0,0 +1,156 @@
+module Near_Surface_m
+
+  Implicit none
+
+  real, parameter:: depth = 3.
+  ! diurnal warm layer and fresh water lens depth, in m (Zeng and Beljaars 2005)
+
+contains
+
+  subroutine near_surface(al, t_subskin, s_subskin, ds_ns, dt_ns, tau, taur, &
+       hlb, rhoa, xlv, dtime, t_ocean_1, s1, rain, q_pwp)
+
+    ! Hugo Bellenger, 2016
+
+    use config_ocean_skin_m, only: depth_1
+    use const, only: beta, cpw, grav, rhow, von
+    use Phiw_m, only: Phiw
+    use therm_expans_m, only: therm_expans
+
+    real, intent(out):: al(:) ! water thermal expansion coefficient (in K-1)
+    real, intent(out):: t_subskin(:) ! subskin temperature, in K
+    real, intent(out):: s_subskin(:) ! subskin salinity, in ppt
+
+    real, intent(inout):: ds_ns(:)
+    ! "delta salinity near surface". Salinity variation in the
+    ! near-surface turbulent layer. That is subskin salinity minus
+    ! foundation salinity. In ppt.
+
+    real, intent(inout):: dt_ns(:)
+    ! "delta temperature near surface". Temperature variation in the
+    ! near-surface turbulent layer. That is subskin temperature minus
+    ! foundation temperature. (Can be negative.) In K.
+
+    real, intent(in):: tau(:)
+    ! wind stress at the surface, turbulent part only, in Pa
+
+    real, intent(in):: taur(:) ! momentum flux due to rainfall, in Pa
+    real, intent(in):: hlb(:) ! latent heat flux, turbulent part only, in W / m2
+    real, intent(in):: rhoa(:) ! density of moist air  (kg / m3)
+    real, intent(in):: xlv(:) ! latent heat of evaporation (J/kg)
+    real, intent(in):: dtime ! time step (s)
+    real, intent(in):: t_ocean_1(:) ! input sea temperature, at depth_1, in K
+    real, intent(in):: S1(:) ! salinity at depth_1, in ppt
+    real, intent(in):: rain(:) ! rain mass flux, in kg m-2 s-1
+
+    real, intent(in):: q_pwp(:)
+    ! net flux absorbed by the warm layer (part of the solar flux
+    ! absorbed at "depth"), minus surface fluxes, in W m-2
+
+    ! Local:
+
+    real, parameter:: khor = 1. / 1.5e4
+    ! Parameter for the lens spread, in m-1. Inverse of the size of
+    ! the lens.
+
+    real, parameter:: umax = 15.
+    real, parameter:: fact = 1.
+    real buoyf(size(t_ocean_1)) ! buoyancy flux
+    real usrc(size(t_ocean_1))
+    real drho(size(t_ocean_1)) ! rho(- delta) - rho(- d)
+    real Lmo(size(t_ocean_1)) ! Monin-Obukhov length
+
+    real u(size(t_ocean_1))
+    ! Wind speed at 15 m relative to the sea surface, i. e. taking
+    ! current vector into account. In m s-1.
+
+    real, dimension(size(t_ocean_1)):: At, Bt, As, Bs, correction
+
+    real eta(size(t_ocean_1))
+    ! exponent in the function giving T(z) and S(z), equation (11) in
+    ! Bellenger et al. 2017 JGR
+
+    real t_fnd(size(t_ocean_1)) ! foundation temperature, in K
+    real s_fnd(size(t_ocean_1)) ! foundation salinity, in ppt
+
+    !----------------------------------------------------------------------
+
+    ! Temperature and salinity profiles change with wind:
+
+    u = 28. * sqrt(tau / rhoa)
+
+    where (dt_ns < 0.)
+       where (u >= umax)
+          eta = 1. / fact
+       elsewhere (u <= 2.)
+          eta = 2. / (fact * umax)
+       elsewhere
+          ! {u > 2. .and. u < umax}
+          eta = u / (fact * umax)
+       end where
+    elsewhere
+       eta = 0.3
+    end where
+
+    if (depth_1 < depth) then
+       correction = 1. - (depth_1 / depth)**eta
+       ! (neglecting microlayer thickness compared to depth_1 and depth)
+
+       t_fnd = t_ocean_1 - dt_ns * correction
+       s_fnd = s1 - ds_ns * correction
+    else
+       t_fnd = t_ocean_1
+       s_fnd = s1
+    end if
+
+    al = therm_expans(t_fnd)
+
+    ! Bellenger 2017 k0976, equation (13):
+    buoyf = Al * grav / (rhow * cpw) * q_pwp &
+         - beta * S_FND * grav * (hlb / xlv - rain) / rhow
+
+    usrc = sqrt((tau + taur) / rhow)
+    drho = rhow * (- al * dt_ns + beta * ds_ns)
+
+    ! Case of stable stratification and negative flux, Bellenger 2017
+    ! k0976, equation (15):
+    where (buoyf < 0. .and. drho < 0.)
+       buoyf = sqrt(- eta * grav / (5. * depth * rhow) * drho) * usrc**2
+    elsewhere (buoyf == 0.)
+       buoyf = tiny(0.)
+    end where
+       
+
+    Lmo = usrc**3 / (von * buoyf)
+
+    ! Equation (14) for temperature. Implicit scheme for time integration:
+    ! \Delta T_{i + 1} - \Delta T_i = \delta t (Bt + At \Delta T_{i + 1})
+    At = - (eta + 1.) * von * usrc / (depth * Phiw(depth / Lmo))
+
+    ! Lens horizontal spreading:
+    where (drho < 0. .and. ds_ns < 0.) At = At &
+         - (eta + 1.) * khor * sqrt(depth * grav * abs(drho) / rhow)
+
+    Bt = q_pwp / (depth * rhow * cpw * eta / (eta + 1.))
+    dt_ns = (dtime * Bt + dt_ns) / (1 - dtime * At)
+
+    ! Equation (14) for salinity:
+    ! \frac{\partial \Delta S}{\partial t}
+    ! = (\Delta S + S_\mathrm{fnd}) B_S + A_S \Delta S
+    As = - (eta + 1.) * von * usrc / (depth * Phiw(depth / Lmo))
+
+    ! Lens horizontal spreading:
+    where (drho < 0. .and. ds_ns < 0.) As = As &
+         - (eta + 1.) * khor * sqrt(depth * grav * abs(drho) / rhow)
+
+    Bs = (hlb / xlv - rain) * (eta + 1.) / (depth * rhow * eta)
+
+    ! Implicit scheme for time integration:
+    ds_ns = (dtime * Bs * S_fnd + ds_ns) / (1 - dtime * (As + bs))
+
+    t_subskin = t_fnd + dt_ns
+    s_subskin = s_fnd + ds_ns
+
+  end subroutine Near_Surface
+
+end module Near_Surface_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/phiw_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/phiw_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/phiw_m.F90	(revision 3851)
@@ -0,0 +1,24 @@
+module Phiw_m
+
+  implicit none
+
+contains
+
+  elemental real function Phiw(zL)
+
+    ! Fonction de stabilit\'e (Monin Obukhov)
+
+    real, intent(in):: zL ! profondeur  / longueur de Monin-Obukhov
+
+    !----------------------------------------------
+
+    if (zL < 0.) then
+       Phiw = (1. - 16. * zL)**(- 0.5)
+    else
+       Phiw = 1. + (5. * zL + 4. * zL**2)/(1. + 3. * zL + 0.25 * zL**2)
+       ! (Takaya et al. 2010)
+    end if
+
+  end function Phiw
+
+end module Phiw_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/sens_heat_rain_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/sens_heat_rain_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/sens_heat_rain_m.F90	(revision 3851)
@@ -0,0 +1,66 @@
+module sens_heat_rain_m
+
+  implicit none
+
+contains
+
+  real function sens_heat_rain(rain, t, q, rhoa, xlv, t_int, p)
+
+    ! Computes heat flux due to rainfall, in W m-2, positive
+    ! upward.
+
+    ! Do not declare this function as elemental because it may include
+    ! YOMCST.h, which contains an OpenMP directive, and that only
+    ! works in OpenMP 5.0.
+
+    use const, only: cpa, cpw, rgas
+#ifndef IN_LMDZ
+    use const, only: eps_w
+#endif
+    use esat_m, only: esat
+
+#ifdef IN_LMDZ
+    include "YOMCST.h"
+    ! for eps_w
+#endif
+
+    real, intent(in):: rain ! rain mass flux, in kg m-2 s-1
+    real, intent(in):: t ! air temperature at 10 m, in K
+    real, intent(in):: q ! specific humidity at 10 m
+    real, intent(in):: rhoa ! density of moist air  (kg / m3)
+    real, intent(in):: xlv ! latent heat of evaporation (J / kg)
+    real, intent(in):: t_int ! interface temperature, in K
+    real, intent(in):: p ! surface pressure, in Pa
+
+    ! Local:
+    
+    real es ! saturation pressure of wator vapor, in Pa
+    real alfac ! wet bulb factor
+    real dwat ! water vapour diffusivity
+    real dtmp ! heat diffusivity
+    real q_int ! specific (saturation) humidity at ocean interface
+    real t_celsius ! air temperature at 10 m, in Celsius degrees
+
+    real wetc
+    ! derivative of saturated mass fraction of water vapor with
+    ! respect to temperature, at constant total pressure
+
+    !---------------------------------------------------------------------
+
+    es = esat(t_int, p) * 0.98 ! reduced for salinity, Kraus 1972 page 46
+    q_int = eps_w * (es / (p - (1. - eps_w) * es))
+    wetc = eps_w * xlv * q_int / (rgas * t_int**2)
+    dwat = 2.11e-5 * (t / 273.15)**1.94
+    t_celsius = t - 273.15
+    dtmp = (1. + 3.309e-3 * t_celsius - 1.44e-6 * t_celsius**2) * 0.02411 &
+         / (rhoa * cpa)
+
+    ! Gosnell 1995 k0991, equation (11):
+    alfac =  1. / (1. + (wetc * xlv * dwat) / (cpa * dtmp))
+
+    ! Gosnell 1995 k0991, equation (12):
+    sens_heat_rain =  rain * alfac * cpw * (t_int - t + (q_int - q) * xlv / cpa)
+
+  end function sens_heat_rain
+  
+end module sens_heat_rain_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/therm_expans_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/therm_expans_m.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/Ocean_skin/therm_expans_m.F90	(revision 3851)
@@ -0,0 +1,19 @@
+module therm_expans_m
+
+  implicit none
+
+contains
+
+  elemental real function therm_expans(t)
+
+    ! Compute the thermal expansion coefficient of sea water.
+
+    real, intent(in):: t ! temperature, in K
+
+    !--------------------------------------------------------------
+
+    therm_expans = 2.1e-5 * (t - 269.95)**0.79
+
+  end function therm_expans
+
+end module therm_expans_m
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/YOMCST.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/YOMCST.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/YOMCST.h	(revision 3851)
@@ -22,5 +22,5 @@
       REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12
       REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
-      REAL RKAPPA,RETV
+      REAL RKAPPA,RETV, eps_w
 ! A1.5,6 Thermodynamic liquid,solid phases
       REAL RCW,RCS
@@ -38,5 +38,5 @@
      &      ,R     ,RMD   ,RMV   ,RD    ,RV    ,RCPD                    &
      &      ,RMO3  ,RMCO2 ,RMC   ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12        &
-     &      ,RCPV  ,RCVD  ,RCVV  ,RKAPPA,RETV                           &
+     &      ,RCPV  ,RCVD  ,RCVV  ,RKAPPA,RETV, eps_w                    &
      &      ,RCW   ,RCS                                                 &
      &      ,RLVTT ,RLSTT ,RLMLT ,RTT   ,RATM                           &
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/calbeta.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/calbeta.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/calbeta.F90	(revision 3851)
@@ -7,5 +7,9 @@
   USE dimphy
   USE indice_sol_mod
+
   IMPLICIT none
+
+#include "flux_arp.h"
+
 !======================================================================
 ! Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM au LMD)
@@ -82,4 +86,11 @@
      ENDDO
   ENDIF
+
+  ! EV: when beta is prescribed for 1D cases:
+  IF (knon.EQ.1 .AND. ok_prescr_beta) THEN
+     DO i = 1, knon
+          vbeta(i)=betaevap
+      ENDDO
+  ENDIF
   
 END SUBROUTINE calbeta
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/calcul_fluxs_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/calcul_fluxs_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/calcul_fluxs_mod.F90	(revision 3851)
@@ -13,9 +13,10 @@
        fqsat, petAcoef, peqAcoef, petBcoef, peqBcoef, &
        tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
+       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
  
     
     USE dimphy, ONLY : klon
     USE indice_sol_mod
+    use sens_heat_rain_m, only: sens_heat_rain
 
     INCLUDE "clesphys.h"
@@ -71,9 +72,12 @@
     REAL, DIMENSION(klon), INTENT(IN)    :: ps, q1lay
     REAL, DIMENSION(klon), INTENT(IN)    :: tsurf, p1lay, cal, beta, cdragh,cdragq
-    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow ! pas utiles
+    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
     REAL, DIMENSION(klon), INTENT(IN)    :: radsol, dif_grnd
     REAL, DIMENSION(klon), INTENT(IN)    :: t1lay, u1lay, v1lay,gustiness
     REAL,                  INTENT(IN)    :: fqsat ! correction factor on qsat (generally 0.98 over salty water, 1 everywhere else)
 
+    real, intent(in), optional:: rhoa(:) ! (knon)
+    ! density of moist air  (kg / m3)
+
 ! Parametres entree-sorties
 !****************************************************************************************
@@ -85,5 +89,5 @@
     REAL, DIMENSION(klon), INTENT(OUT)   :: tsurf_new, evap, fluxsens, fluxlat
     REAL, DIMENSION(klon), INTENT(OUT)   :: dflux_s, dflux_l
-    REAL, DIMENSION(klon), OPTIONAL      :: sens_prec_liq, sens_prec_sol
+    REAL, intent(out), OPTIONAL:: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
     REAL, DIMENSION(klon), OPTIONAL      :: lat_prec_liq, lat_prec_sol
 
@@ -140,6 +144,4 @@
     dflux_s = 0.
     dflux_l = 0.
-    if (PRESENT(sens_prec_liq)) sens_prec_liq = 0.
-    if (PRESENT(sens_prec_sol)) sens_prec_sol = 0.
     if (PRESENT(lat_prec_liq)) lat_prec_liq = 0.
     if (PRESENT(lat_prec_sol)) lat_prec_sol = 0.
@@ -259,18 +261,12 @@
 !
 ! calcul de l'enthalpie des precipitations liquides et solides
-!
-!       if (PRESENT(enth_prec_liq))                   &
-!       enth_prec_liq(i) = rcw * (t1lay(i) - tsurf(i)) * &
-!                          precip_rain(i)
-!       if (PRESENT(enth_prec_sol))                  &
-!       enth_prec_sol(i) = rcs * (t1lay(i) - tsurf(i)) * &
-!                          precip_snow(i)
-! On calcule par rapport a T=0
-       if (PRESENT(sens_prec_liq))                   &
-         sens_prec_liq(i) = rcw * (t1lay(i) - RTT) * &
-                          precip_rain(i)
-       if (PRESENT(sens_prec_sol))                   &
-         sens_prec_sol(i) = rcs * (t1lay(i) - RTT) * &
-                          precip_snow(i)
+       if (PRESENT(sens_prec_liq)) sens_prec_liq(i) &
+            = - sens_heat_rain(precip_rain(i) + precip_snow(i), t1lay(i), &
+            q1lay(i), rhoa(i), rlvtt, tsurf_new(i), ps(i))
+       if (PRESENT(sens_prec_sol)) sens_prec_sol(i) = 0.
+       ! On calcule par rapport a T=0
+       !! sens_prec_liq(i) = rcw * (t1lay(i) - RTT) * precip_rain(i)
+       !! sens_prec_sol(i) = rcs * (t1lay(i) - RTT) * precip_snow(i)
+
        if (PRESENT(lat_prec_liq))                    &
          lat_prec_liq(i) =  precip_rain(i) * (RLVTT - RLVTT) 
@@ -280,13 +276,5 @@
 
     
-!       if (PRESENT(sens_prec_liq))                  &
-!          WRITE(*,*)' calculs_fluxs sens_prec_liq (min, max)', &
-!          MINVAL(sens_prec_liq(1:knon)), MAXVAL(sens_prec_liq(1:knon))
-!       if (PRESENT(sens_prec_sol))                  &
-!          WRITE(*,*)' calculs_fluxs sens_prec_sol (min, max)', &
-!          MINVAL(sens_prec_sol(1:knon)), MAXVAL(sens_prec_sol(1:knon))
- 
-!
-!****************************************************************************************
+!**************************************************************************
 !
   END SUBROUTINE calcul_fluxs
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/cdrag.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/cdrag.F90	(revision 3725)
+++ 	(revision )
@@ -1,411 +1,0 @@
-!
-!$Id$
-!
- SUBROUTINE cdrag(knon,  nsrf,   &
-     speed, t1,    q1,    zgeop1, &
-     psol,  tsurf, qsurf, z0m, z0h,  &
-     cdm,  cdh,  zri,   pref)
-
-  USE dimphy
-  USE indice_sol_mod
-  USE print_control_mod, ONLY: lunout, prt_level
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-
-  IMPLICIT NONE
-! ================================================================= c
-!
-! Objet : calcul des cdrags pour le moment (pcfm) et 
-!         les flux de chaleur sensible et latente (pcfh) d'apr??s
-!         Louis 1982, Louis 1979, King et al 2001
-!         ou Zilitinkevich et al 2002  pour les cas stables, Louis 1979
-!         et 1982 pour les cas instables 
-!
-! Modified history: 
-!  writting on the 20/05/2016
-!  modified on the 13/12/2016 to be adapted to LMDZ6
-!
-! References:
-!   Louis, J. F., 1979: A parametric model of vertical eddy fluxes in the
-!     atmosphere. Boundary-Layer Meteorology. 01/1979; 17(2):187-202. 
-!   Louis, J. F., Tiedtke, M. and Geleyn, J. F., 1982: `A short history of the
-!     operational PBL parametrization at ECMWF'. Workshop on boundary layer
-!     parametrization, November 1981, ECMWF, Reading, England. 
-!     Page: 19. Equations in Table 1.
-!   Mascart P, Noilhan J, Giordani H 1995.A MODIFIED PARAMETERIZATION OF FLUX-PROFILE RELATIONSHIPS 
-!    IN THE SURFACE LAYER USING DIFFERENT ROUGHNESS LENGTH VALUES FOR HEAT AND MOMENTUM
-!    Boundary-Layer Meteorology 72: 331-344
-!   Anton Beljaars. May 1992. The parametrization of the planetary boundary layer.  
-!     European Centre for Medium-Range Weather Forecasts.
-!     Equations: 110-113. Page 40.
-!   Miller,M.J., A.C.M.Beljaars, T.N.Palmer. 1992. The sensitivity of the ECMWF
-!     model to the parameterization of evaporation from the tropical oceans. J.
-!     Climate, 5:418-434.
-!   King J.C, Connolley, W.M ad Derbyshire S.H. 2001, Sensitivity of Modelled Antarctic climate
-!   to surface and boundary-layer flux parametrizations
-!   QJRMS, 127, pp 779-794
-!
-! ================================================================= c
-! ================================================================= c
-! On choisit le couple de fonctions de correction avec deux flags:
-! Un pour les cas instables, un autre pour les cas stables
-!
-! iflag_corr_insta:
-!                   1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h)
-!                   2: Louis 1982 
-!                   3: Laurent Li
-!
-! iflag_corr_sta:
-!                   1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h)
-!                   2: Louis 1982 
-!                   3: Laurent Li
-!                   4: King  2001 (SHARP)
-!                   5: MO 1st order theory (allow collapse of turbulence)
-!            
-!
-!*****************************************************************
-! Parametres d'entree
-!***************************************************************** 
-  
-  INTEGER, INTENT(IN)                      :: knon, nsrf ! nombre de points de grille sur l'horizontal + type de surface
-  REAL, DIMENSION(klon), INTENT(IN)        :: speed ! module du vent au 1er niveau du modele
-  REAL, DIMENSION(klon), INTENT(IN)        :: zgeop1! geopotentiel au 1er niveau du modele
-  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf ! Surface temperature (K)
-  REAL, DIMENSION(klon), INTENT(IN)        :: qsurf ! Surface humidity (Kg/Kg)
-  REAL, DIMENSION(klon), INTENT(IN)        :: z0m, z0h ! Rugosity at surface (m) 
-  REAL, DIMENSION(klon), INTENT(IN)        :: t1  ! Temperature au premier niveau (K) 
-  REAL, DIMENSION(klon), INTENT(IN)        :: q1  ! humidite specifique au premier niveau (kg/kg)
-  REAL, DIMENSION(klon), INTENT(IN)        :: psol ! pression au sol
-
-
-
-! Parametres de sortie
-!******************************************************************
-  REAL, DIMENSION(klon), INTENT(OUT)       :: cdm  ! Drag coefficient for heat flux
-  REAL, DIMENSION(klon), INTENT(OUT)       :: cdh  ! Drag coefficient for momentum
-  REAL, DIMENSION(klon), INTENT(OUT)       :: zri   ! Richardson number
-  REAL, DIMENSION(klon), INTENT(OUT)       :: pref  ! Pression au niveau zgeop/RG
-
-! Variables Locales
-!******************************************************************
- 
-
-  INCLUDE "YOMCST.h"
-  INCLUDE "YOETHF.h"
-  INCLUDE "clesphys.h"
-
-
-  REAL, PARAMETER       :: CKAP=0.40, CKAPT=0.42
-  REAL                   CEPDU2
-  REAL                   ALPHA
-  REAL                   CB,CC,CD,C2,C3
-  REAL                   MU, CM, CH, B, CMstar, CHstar
-  REAL                   PM, PH, BPRIME
-  REAL                   C
-  INTEGER                ng_q1                      ! Number of grids that q1 < 0.0
-  INTEGER                ng_qsurf                   ! Number of grids that qsurf < 0.0
-  INTEGER                i
-  REAL                   zdu2, ztsolv
-  REAL                   ztvd, zscf
-  REAL                   zucf, zcr
-  REAL                   friv, frih
-  REAL, DIMENSION(klon) :: FM, FH                   ! stability functions
-  REAL, DIMENSION(klon) :: cdmn, cdhn               ! Drag coefficient in neutral conditions
-  REAL zzzcd
-
-  LOGICAL, SAVE :: firstcall = .TRUE.
-  !$OMP THREADPRIVATE(firstcall)
-  INTEGER, SAVE :: iflag_corr_sta
-  !$OMP THREADPRIVATE(iflag_corr_sta)
-  INTEGER, SAVE :: iflag_corr_insta
-  !$OMP THREADPRIVATE(iflag_corr_insta)
-
-!===================================================================c
-! Valeurs numeriques des constantes
-!===================================================================c
-
-
-! Minimum du carre du vent
-
- CEPDU2 = (0.1)**2
-
-! Louis 1982
-
-  CB=5.0
-  CC=5.0
-  CD=5.0
-
-
-! King 2001
-
-  C2=0.25
-  C3=0.0625
-
-  
-! Louis 1979
-
-  BPRIME=4.7
-  B=9.4
-  
-
-!MO
-
-  ALPHA=5.0
-  
-
-! ================================================================= c
-! Tests avant de commencer
-! Fuxing WANG, 04/03/2015
-! To check if there are negative q1, qsurf values.
-!====================================================================c
-  ng_q1 = 0     ! Initialization
-  ng_qsurf = 0  ! Initialization
-  DO i = 1, knon
-     IF (q1(i).LT.0.0)     ng_q1 = ng_q1 + 1
-     IF (qsurf(i).LT.0.0)  ng_qsurf = ng_qsurf + 1
-  ENDDO
-  IF (ng_q1.GT.0 .and. prt_level > 5) THEN
-      WRITE(lunout,*)" *** Warning: Negative q1(humidity at 1st level) values in cdrag.F90 !"
-      WRITE(lunout,*)" The total number of the grids is: ", ng_q1
-      WRITE(lunout,*)" The negative q1 is set to zero "
-!      abort_message="voir ci-dessus"
-!      CALL abort_physic(modname,abort_message,1)
-  ENDIF
-  IF (ng_qsurf.GT.0 .and. prt_level > 5) THEN
-      WRITE(lunout,*)" *** Warning: Negative qsurf(humidity at surface) values in cdrag.F90 !"
-      WRITE(lunout,*)" The total number of the grids is: ", ng_qsurf
-      WRITE(lunout,*)" The negative qsurf is set to zero "
-!      abort_message="voir ci-dessus"
-!      CALL abort_physic(modname,abort_message,1)
-  ENDIF
-
-
-
-!=============================================================================c
-! Calcul du cdrag
-!=============================================================================c
-
-! On choisit les fonctions de stabilite utilisees au premier appel
-!**************************************************************************
-  IF (firstcall) THEN
-   iflag_corr_sta=2
-   iflag_corr_insta=2
- 
-   CALL getin_p('iflag_corr_sta',iflag_corr_sta)
-   CALL getin_p('iflag_corr_insta',iflag_corr_insta)
-
-   firstcall = .FALSE.
- ENDIF
-
-!xxxxxxxxxxxxxxxxxxxxxxx
-  DO i = 1, knon        ! Boucle sur l'horizontal
-!xxxxxxxxxxxxxxxxxxxxxxx
-
-
-! calculs preliminaires:
-!***********************
-     
-
-     zdu2 = MAX(CEPDU2, speed(i)**2)
-     pref(i) = EXP(LOG(psol(i)) - zgeop1(i)/(RD*t1(i)* &
-                 (1.+ RETV * max(q1(i),0.0))))           ! negative q1 set to zero 
-     ztsolv = tsurf(i) * (1.0+RETV*max(qsurf(i),0.0))    ! negative qsurf set to zero
-     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) &
-          *(1.+RETV*max(q1(i),0.0))                      ! negative q1 set to zero
-     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
-
-
-! Coefficients CD neutres : k^2/ln(z/z0) et k^2/(ln(z/z0)*ln(z/z0h)):
-!********************************************************************
-
-     zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i)))
-     cdmn(i) = zzzcd*zzzcd
-     cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i))))
-
-
-! Calcul des fonctions de stabilit?? FMs, FHs, FMi, FHi :
-!*******************************************************
-
-!''''''''''''''
-! Cas instables
-!''''''''''''''
-
- IF (zri(i) .LT. 0.) THEN    
-
-
-        SELECT CASE (iflag_corr_insta)
-    
-        CASE (1) ! Louis 1979 + Mascart 1995
-
-           MU=LOG(MAX(z0m(i)/z0h(i),0.01))
-           CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3)
-           PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3)
-           CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3)
-           PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3)
-           CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
-            & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i)))       &
-            & * ((zgeop1(i)/(RG*z0h(i)))**PH)
-           CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
-            & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i)))         &
-            & * ((zgeop1(i)/(RG*z0m(i)))**PM)
-         
-
-
-
-           FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i))))
-           FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i))))
-
-        CASE (2) ! Louis 1982
-
-           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
-                *(1.0+zgeop1(i)/(RG*z0m(i)))))
-           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
-           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
-
-
-        CASE (3) ! Laurent Li
-
-           
-           FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
-           FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
-
-
-
-         CASE default ! Louis 1982
-
-           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
-                *(1.0+zgeop1(i)/(RG*z0m(i)))))
-           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
-           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
-
-
-         END SELECT
-
-
-
-! Calcul des drags
-
-
-       cdm(i)=cdmn(i)*FM(i)
-       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
-
-
-! Traitement particulier des cas oceaniques
-! on applique Miller et al 1992 en l'absence de gustiness 
-
-  IF (nsrf == is_oce) THEN
-!        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
-
-        IF(iflag_gusts==0) THEN
-           zcr = (0.0016/(cdmn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
-           cdh(i) =f_cdrag_oce* cdhn(i)*(1.0+zcr**1.25)**(1./1.25)
-        ENDIF
-
-
-        cdm(i)=MIN(cdm(i),cdmmax)
-        cdh(i)=MIN(cdh(i),cdhmax)
-
-  END IF
-
-
-
- ELSE                          
-
-!'''''''''''''''
-! Cas stables :
-!'''''''''''''''
-        zri(i) = MIN(20.,zri(i))
-
-       SELECT CASE (iflag_corr_sta)
-    
-        CASE (1) ! Louis 1979 + Mascart 1995
-   
-           FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min)
-           FH(i)=FM(i)
-
-
-        CASE (2) ! Louis 1982
-           
-           zscf = SQRT(1.+CD*ABS(zri(i)))
-           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
-           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
-
-
-        CASE (3) ! Laurent Li
-   
-           FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min)
-           FH(i)=FM(i)
-
-
-        CASE (4)  ! King 2001
-          
-           if (zri(i) .LT. C2/2.) then
-           FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min)
-           FH(i)=  FM(i)
-
-
-           else
-           FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min)
-           FH(i)= FM(i)
-           endif
-
-
-        CASE (5) ! MO
-   
-          if (zri(i) .LT. 1./alpha) then
-
-           FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
-           FH(i)=FM(i)
-
-           else 
-
-
-           FM(i)=MAX(1E-7,f_ri_cd_min)
-           FH(i)=FM(i)
-
-          endif
-
-
-
-
-
-        CASE default ! Louis 1982
-
-           zscf = SQRT(1.+CD*ABS(zri(i)))
-           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
-           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
-
-
-
-   END SELECT
-
-! Calcul des drags
-
-
-       cdm(i)=cdmn(i)*FM(i)
-       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
-
-       IF(nsrf.EQ.is_oce) THEN
-
-        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
-        cdm(i)=MIN(cdm(i),cdmmax)
-        cdh(i)=MIN(cdh(i),cdhmax)
-
-      ENDIF
-
-
- ENDIF
-
-
-
-
-!xxxxxxxxxxx
-  END DO   !  Fin de la boucle sur l'horizontal
-!xxxxxxxxxxx
-! ================================================================= c
-     
- 
-
-END SUBROUTINE cdrag
-
-
-!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/cdrag_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/cdrag_mod.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/cdrag_mod.F90	(revision 3851)
@@ -0,0 +1,822 @@
+!
+MODULE cdrag_mod
+!
+! This module contains some procedures for calculation of the cdrag
+! coefficients for turbulent diffusion at surface
+!
+  IMPLICIT NONE
+
+CONTAINS
+!
+!****************************************************************************************
+!
+!r original routine svn3623
+!
+ SUBROUTINE cdrag(knon,  nsrf,   &
+     speed, t1,    q1,    zgeop1, &
+     psol,  tsurf, qsurf, z0m, z0h,  &
+     cdm,  cdh,  zri,   pref)
+
+  USE dimphy
+  USE indice_sol_mod
+  USE print_control_mod, ONLY: lunout, prt_level
+  USE ioipsl_getin_p_mod, ONLY : getin_p
+
+  IMPLICIT NONE
+! ================================================================= c
+!
+! Objet : calcul des cdrags pour le moment (pcfm) et 
+!         les flux de chaleur sensible et latente (pcfh) d'apr??s
+!         Louis 1982, Louis 1979, King et al 2001
+!         ou Zilitinkevich et al 2002  pour les cas stables, Louis 1979
+!         et 1982 pour les cas instables 
+!
+! Modified history: 
+!  writting on the 20/05/2016
+!  modified on the 13/12/2016 to be adapted to LMDZ6
+!
+! References:
+!   Louis, J. F., 1979: A parametric model of vertical eddy fluxes in the
+!     atmosphere. Boundary-Layer Meteorology. 01/1979; 17(2):187-202. 
+!   Louis, J. F., Tiedtke, M. and Geleyn, J. F., 1982: `A short history of the
+!     operational PBL parametrization at ECMWF'. Workshop on boundary layer
+!     parametrization, November 1981, ECMWF, Reading, England. 
+!     Page: 19. Equations in Table 1.
+!   Mascart P, Noilhan J, Giordani H 1995.A MODIFIED PARAMETERIZATION OF FLUX-PROFILE RELATIONSHIPS 
+!    IN THE SURFACE LAYER USING DIFFERENT ROUGHNESS LENGTH VALUES FOR HEAT AND MOMENTUM
+!    Boundary-Layer Meteorology 72: 331-344
+!   Anton Beljaars. May 1992. The parametrization of the planetary boundary layer.  
+!     European Centre for Medium-Range Weather Forecasts.
+!     Equations: 110-113. Page 40.
+!   Miller,M.J., A.C.M.Beljaars, T.N.Palmer. 1992. The sensitivity of the ECMWF
+!     model to the parameterization of evaporation from the tropical oceans. J.
+!     Climate, 5:418-434.
+!   King J.C, Connolley, W.M ad Derbyshire S.H. 2001, Sensitivity of Modelled Antarctic climate
+!   to surface and boundary-layer flux parametrizations
+!   QJRMS, 127, pp 779-794
+!
+! ================================================================= c
+! ================================================================= c
+! On choisit le couple de fonctions de correction avec deux flags:
+! Un pour les cas instables, un autre pour les cas stables
+!
+! iflag_corr_insta:
+!                   1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h)
+!                   2: Louis 1982 
+!                   3: Laurent Li
+!
+! iflag_corr_sta:
+!                   1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h)
+!                   2: Louis 1982 
+!                   3: Laurent Li
+!                   4: King  2001 (SHARP)
+!                   5: MO 1st order theory (allow collapse of turbulence)
+!            
+!
+!*****************************************************************
+! Parametres d'entree
+!***************************************************************** 
+  
+  INTEGER, INTENT(IN)                      :: knon, nsrf ! nombre de points de grille sur l'horizontal + type de surface
+  REAL, DIMENSION(klon), INTENT(IN)        :: speed ! module du vent au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: zgeop1! geopotentiel au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf ! Surface temperature (K)
+  REAL, DIMENSION(klon), INTENT(IN)        :: qsurf ! Surface humidity (Kg/Kg)
+  REAL, DIMENSION(klon), INTENT(IN)        :: z0m, z0h ! Rugosity at surface (m) 
+  REAL, DIMENSION(klon), INTENT(IN)        :: t1  ! Temperature au premier niveau (K) 
+  REAL, DIMENSION(klon), INTENT(IN)        :: q1  ! humidite specifique au premier niveau (kg/kg)
+  REAL, DIMENSION(klon), INTENT(IN)        :: psol ! pression au sol
+
+
+
+! Parametres de sortie
+!******************************************************************
+  REAL, DIMENSION(klon), INTENT(OUT)       :: cdm   ! Drag coefficient for momentum
+  REAL, DIMENSION(klon), INTENT(OUT)       :: cdh   ! Drag coefficient for heat flux
+  REAL, DIMENSION(klon), INTENT(OUT)       :: zri   ! Richardson number
+  REAL, DIMENSION(klon), INTENT(OUT)       :: pref  ! Pression au niveau zgeop/RG
+
+! Variables Locales
+!******************************************************************
+ 
+
+  INCLUDE "YOMCST.h"
+  INCLUDE "YOETHF.h"
+  INCLUDE "clesphys.h"
+
+
+  REAL, PARAMETER       :: CKAP=0.40, CKAPT=0.42
+  REAL                   CEPDU2
+  REAL                   ALPHA
+  REAL                   CB,CC,CD,C2,C3
+  REAL                   MU, CM, CH, B, CMstar, CHstar
+  REAL                   PM, PH, BPRIME
+  REAL                   C
+  INTEGER                ng_q1                      ! Number of grids that q1 < 0.0
+  INTEGER                ng_qsurf                   ! Number of grids that qsurf < 0.0
+  INTEGER                i
+  REAL                   zdu2, ztsolv
+  REAL                   ztvd, zscf
+  REAL                   zucf, zcr
+  REAL                   friv, frih
+  REAL, DIMENSION(klon) :: FM, FH                   ! stability functions
+  REAL, DIMENSION(klon) :: cdmn, cdhn               ! Drag coefficient in neutral conditions
+  REAL zzzcd
+
+  LOGICAL, SAVE :: firstcall = .TRUE.
+  !$OMP THREADPRIVATE(firstcall)
+  INTEGER, SAVE :: iflag_corr_sta
+  !$OMP THREADPRIVATE(iflag_corr_sta)
+  INTEGER, SAVE :: iflag_corr_insta
+  !$OMP THREADPRIVATE(iflag_corr_insta)
+
+!===================================================================c
+! Valeurs numeriques des constantes
+!===================================================================c
+
+
+! Minimum du carre du vent
+
+ CEPDU2 = (0.1)**2
+
+! Louis 1982
+
+  CB=5.0
+  CC=5.0
+  CD=5.0
+
+
+! King 2001
+
+  C2=0.25
+  C3=0.0625
+
+  
+! Louis 1979
+
+  BPRIME=4.7
+  B=9.4
+  
+
+!MO
+
+  ALPHA=5.0
+  
+
+! ================================================================= c
+! Tests avant de commencer
+! Fuxing WANG, 04/03/2015
+! To check if there are negative q1, qsurf values.
+!====================================================================c
+  ng_q1 = 0     ! Initialization
+  ng_qsurf = 0  ! Initialization
+  DO i = 1, knon
+     IF (q1(i).LT.0.0)     ng_q1 = ng_q1 + 1
+     IF (qsurf(i).LT.0.0)  ng_qsurf = ng_qsurf + 1
+  ENDDO
+  IF (ng_q1.GT.0 .and. prt_level > 5) THEN
+      WRITE(lunout,*)" *** Warning: Negative q1(humidity at 1st level) values in cdrag.F90 !"
+      WRITE(lunout,*)" The total number of the grids is: ", ng_q1
+      WRITE(lunout,*)" The negative q1 is set to zero "
+!      abort_message="voir ci-dessus"
+!      CALL abort_physic(modname,abort_message,1)
+  ENDIF
+  IF (ng_qsurf.GT.0 .and. prt_level > 5) THEN
+      WRITE(lunout,*)" *** Warning: Negative qsurf(humidity at surface) values in cdrag.F90 !"
+      WRITE(lunout,*)" The total number of the grids is: ", ng_qsurf
+      WRITE(lunout,*)" The negative qsurf is set to zero "
+!      abort_message="voir ci-dessus"
+!      CALL abort_physic(modname,abort_message,1)
+  ENDIF
+
+
+
+!=============================================================================c
+! Calcul du cdrag
+!=============================================================================c
+
+! On choisit les fonctions de stabilite utilisees au premier appel
+!**************************************************************************
+  IF (firstcall) THEN
+   iflag_corr_sta=2
+   iflag_corr_insta=2
+ 
+   CALL getin_p('iflag_corr_sta',iflag_corr_sta)
+   CALL getin_p('iflag_corr_insta',iflag_corr_insta)
+
+   firstcall = .FALSE.
+ ENDIF
+
+!xxxxxxxxxxxxxxxxxxxxxxx
+  DO i = 1, knon        ! Boucle sur l'horizontal
+!xxxxxxxxxxxxxxxxxxxxxxx
+
+
+! calculs preliminaires:
+!***********************
+     
+
+     zdu2 = MAX(CEPDU2, speed(i)**2)
+     pref(i) = EXP(LOG(psol(i)) - zgeop1(i)/(RD*t1(i)* &
+                 (1.+ RETV * max(q1(i),0.0))))           ! negative q1 set to zero 
+     ztsolv = tsurf(i) * (1.0+RETV*max(qsurf(i),0.0))    ! negative qsurf set to zero
+     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*max(q1(i),0.0))) &
+          *(1.+RETV*max(q1(i),0.0))                      ! negative q1 set to zero
+     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
+
+
+! Coefficients CD neutres : k^2/ln(z/z0) et k^2/(ln(z/z0)*ln(z/z0h)):
+!********************************************************************
+
+     zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i)))
+     cdmn(i) = zzzcd*zzzcd
+     cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i))))
+
+
+! Calcul des fonctions de stabilit?? FMs, FHs, FMi, FHi :
+!*******************************************************
+
+!''''''''''''''
+! Cas instables
+!''''''''''''''
+
+ IF (zri(i) .LT. 0.) THEN    
+
+
+        SELECT CASE (iflag_corr_insta)
+    
+        CASE (1) ! Louis 1979 + Mascart 1995
+
+           MU=LOG(MAX(z0m(i)/z0h(i),0.01))
+           CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3)
+           PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3)
+           CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3)
+           PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3)
+           CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+            & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i)))       &
+            & * ((zgeop1(i)/(RG*z0h(i)))**PH)
+           CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+            & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i)))         &
+            & * ((zgeop1(i)/(RG*z0m(i)))**PM)
+         
+
+
+
+           FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i))))
+           FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i))))
+
+        CASE (2) ! Louis 1982
+
+           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                *(1.0+zgeop1(i)/(RG*z0m(i)))))
+           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+
+
+        CASE (3) ! Laurent Li
+
+           
+           FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+           FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+
+
+
+         CASE default ! Louis 1982
+
+           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                *(1.0+zgeop1(i)/(RG*z0m(i)))))
+           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+
+
+         END SELECT
+
+
+
+! Calcul des drags
+
+
+       cdm(i)=cdmn(i)*FM(i)
+       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+
+
+! Traitement particulier des cas oceaniques
+! on applique Miller et al 1992 en l'absence de gustiness 
+
+  IF (nsrf == is_oce) THEN
+!        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
+
+        IF(iflag_gusts==0) THEN
+           zcr = (0.0016/(cdmn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
+           cdh(i) =f_cdrag_oce* cdhn(i)*(1.0+zcr**1.25)**(1./1.25)
+        ENDIF
+
+
+        cdm(i)=MIN(cdm(i),cdmmax)
+        cdh(i)=MIN(cdh(i),cdhmax)
+
+  END IF
+
+
+
+ ELSE                          
+
+!'''''''''''''''
+! Cas stables :
+!'''''''''''''''
+        zri(i) = MIN(20.,zri(i))
+
+       SELECT CASE (iflag_corr_sta)
+    
+        CASE (1) ! Louis 1979 + Mascart 1995
+   
+           FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min)
+           FH(i)=FM(i)
+
+
+        CASE (2) ! Louis 1982
+           
+           zscf = SQRT(1.+CD*ABS(zri(i)))
+           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+
+
+        CASE (3) ! Laurent Li
+   
+           FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min)
+           FH(i)=FM(i)
+
+
+        CASE (4)  ! King 2001
+          
+           if (zri(i) .LT. C2/2.) then
+           FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min)
+           FH(i)=  FM(i)
+
+
+           else
+           FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min)
+           FH(i)= FM(i)
+           endif
+
+
+        CASE (5) ! MO
+   
+          if (zri(i) .LT. 1./alpha) then
+
+           FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
+           FH(i)=FM(i)
+
+           else 
+
+
+           FM(i)=MAX(1E-7,f_ri_cd_min)
+           FH(i)=FM(i)
+
+          endif
+
+
+
+
+
+        CASE default ! Louis 1982
+
+           zscf = SQRT(1.+CD*ABS(zri(i)))
+           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+
+
+
+   END SELECT
+
+! Calcul des drags
+
+
+       cdm(i)=cdmn(i)*FM(i)
+       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+
+       IF(nsrf.EQ.is_oce) THEN
+
+        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
+        cdm(i)=MIN(cdm(i),cdmmax)
+        cdh(i)=MIN(cdh(i),cdhmax)
+
+      ENDIF
+
+
+ ENDIF
+
+!xxxxxxxxxxx
+  END DO   !  Fin de la boucle sur l'horizontal
+!xxxxxxxxxxx
+! ================================================================= c
+     
+END SUBROUTINE cdrag
+
+!
+ SUBROUTINE cdragn_ri1(knon,  nsrf,   &
+     speed, t1,    q1,    zgeop1, &
+     psol,  tsurf, qsurf, z0m, z0h,  &
+     ri1, iri1, &
+     cdm,  cdh,  zri,   pref)
+
+  USE dimphy
+  USE indice_sol_mod
+  USE print_control_mod, ONLY: lunout, prt_level
+  USE ioipsl_getin_p_mod, ONLY : getin_p
+
+  IMPLICIT NONE
+! ================================================================= c
+!
+! Objet : calcul des cdrags pour le moment (pcfm) et 
+!         les flux de chaleur sensible et latente (pcfh) d'apr??s
+!         Louis 1982, Louis 1979, King et al 2001
+!         ou Zilitinkevich et al 2002  pour les cas stables, Louis 1979
+!         et 1982 pour les cas instables 
+!
+! Modified history: 
+!  writting on the 20/05/2016
+!  modified on the 13/12/2016 to be adapted to LMDZ6
+!
+! References:
+!   Louis, J. F., 1979: A parametric model of vertical eddy fluxes in the
+!     atmosphere. Boundary-Layer Meteorology. 01/1979; 17(2):187-202. 
+!   Louis, J. F., Tiedtke, M. and Geleyn, J. F., 1982: `A short history of the
+!     operational PBL parametrization at ECMWF'. Workshop on boundary layer
+!     parametrization, November 1981, ECMWF, Reading, England. 
+!     Page: 19. Equations in Table 1.
+!   Mascart P, Noilhan J, Giordani H 1995.A MODIFIED PARAMETERIZATION OF FLUX-PROFILE RELATIONSHIPS 
+!    IN THE SURFACE LAYER USING DIFFERENT ROUGHNESS LENGTH VALUES FOR HEAT AND MOMENTUM
+!    Boundary-Layer Meteorology 72: 331-344
+!   Anton Beljaars. May 1992. The parametrization of the planetary boundary layer.  
+!     European Centre for Medium-Range Weather Forecasts.
+!     Equations: 110-113. Page 40.
+!   Miller,M.J., A.C.M.Beljaars, T.N.Palmer. 1992. The sensitivity of the ECMWF
+!     model to the parameterization of evaporation from the tropical oceans. J.
+!     Climate, 5:418-434.
+!   King J.C, Connolley, W.M ad Derbyshire S.H. 2001, Sensitivity of Modelled Antarctic climate
+!   to surface and boundary-layer flux parametrizations
+!   QJRMS, 127, pp 779-794
+!
+! ================================================================= c
+! ================================================================= c
+! On choisit le couple de fonctions de correction avec deux flags:
+! Un pour les cas instables, un autre pour les cas stables
+!
+! iflag_corr_insta:
+!                   1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h)
+!                   2: Louis 1982 
+!                   3: Laurent Li
+!
+! iflag_corr_sta:
+!                   1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h)
+!                   2: Louis 1982 
+!                   3: Laurent Li
+!                   4: King  2001 (SHARP)
+!                   5: MO 1st order theory (allow collapse of turbulence)
+!            
+!
+!*****************************************************************
+! Parametres d'entree
+!***************************************************************** 
+  
+  INTEGER, INTENT(IN)                      :: knon, nsrf ! nombre de points de grille sur l'horizontal + type de surface
+  REAL, DIMENSION(klon), INTENT(IN)        :: speed ! module du vent au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: zgeop1! geopotentiel au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf ! Surface temperature (K)
+  REAL, DIMENSION(klon), INTENT(IN)        :: qsurf ! Surface humidity (Kg/Kg)
+  REAL, DIMENSION(klon), INTENT(IN)        :: z0m, z0h ! Rugosity at surface (m) 
+  REAL, DIMENSION(klon), INTENT(IN)        :: ri1   ! Richardson 1ere couche 
+  INTEGER, INTENT(IN)                      :: iri1   !
+  REAL, DIMENSION(klon), INTENT(IN)        :: t1  ! Temperature au premier niveau (K) 
+  REAL, DIMENSION(klon), INTENT(IN)        :: q1  ! humidite specifique au premier niveau (kg/kg)
+  REAL, DIMENSION(klon), INTENT(IN)        :: psol ! pression au sol
+
+
+
+! Parametres de sortie
+!******************************************************************
+  REAL, DIMENSION(klon), INTENT(OUT)       :: cdm  ! Drag coefficient for heat flux
+  REAL, DIMENSION(klon), INTENT(OUT)       :: cdh  ! Drag coefficient for momentum
+  REAL, DIMENSION(klon), INTENT(OUT)       :: zri   ! Richardson number
+  REAL, DIMENSION(klon), INTENT(OUT)       :: pref  ! Pression au niveau zgeop/RG
+! Variables Locales
+!******************************************************************
+ 
+
+  INCLUDE "YOMCST.h"
+  INCLUDE "YOETHF.h"
+  INCLUDE "clesphys.h"
+
+
+  REAL, PARAMETER       :: CKAP=0.40, CKAPT=0.42
+  REAL                   CEPDU2
+  REAL                   ALPHA
+  REAL                   CB,CC,CD,C2,C3
+  REAL                   MU, CM, CH, B, CMstar, CHstar
+  REAL                   PM, PH, BPRIME
+  REAL                   C
+  INTEGER                ng_q1                      ! Number of grids that q1 < 0.0
+  INTEGER                ng_qsurf                   ! Number of grids that qsurf < 0.0
+  INTEGER                i
+  REAL                   zdu2, ztsolv
+  REAL                   ztvd, zscf
+  REAL                   zucf, zcr
+  REAL                   friv, frih
+  REAL, DIMENSION(klon) :: FM, FH                   ! stability functions
+  REAL, DIMENSION(klon) :: cdmn, cdhn               ! Drag coefficient in neutral conditions
+  REAL zzzcd
+
+  LOGICAL, SAVE :: firstcall = .TRUE.
+  !$OMP THREADPRIVATE(firstcall)
+  INTEGER, SAVE :: iflag_corr_sta
+  !$OMP THREADPRIVATE(iflag_corr_sta)
+  INTEGER, SAVE :: iflag_corr_insta
+  !$OMP THREADPRIVATE(iflag_corr_insta)
+
+!===================================================================c
+! Valeurs numeriques des constantes
+!===================================================================c
+
+
+! Minimum du carre du vent
+
+ CEPDU2 = (0.1)**2
+! Louis 1982
+
+  CB=5.0
+  CC=5.0
+  CD=5.0
+
+
+! King 2001
+
+  C2=0.25
+  C3=0.0625
+
+  
+! Louis 1979
+
+  BPRIME=4.7
+  B=9.4
+  
+
+!MO
+
+  ALPHA=5.0
+  
+
+! ================================================================= c
+! Tests avant de commencer
+! Fuxing WANG, 04/03/2015
+! To check if there are negative q1, qsurf values.
+!====================================================================c
+  ng_q1 = 0     ! Initialization
+  ng_qsurf = 0  ! Initialization
+  DO i = 1, knon
+     IF (q1(i).LT.0.0)     ng_q1 = ng_q1 + 1
+     IF (qsurf(i).LT.0.0)  ng_qsurf = ng_qsurf + 1
+  ENDDO
+  IF (ng_q1.GT.0 .and. prt_level > 5) THEN
+      WRITE(lunout,*)" *** Warning: Negative q1(humidity at 1st level) values in cdrag.F90 !"
+      WRITE(lunout,*)" The total number of the grids is: ", ng_q1
+      WRITE(lunout,*)" The negative q1 is set to zero "
+!      abort_message="voir ci-dessus"
+!      CALL abort_physic(modname,abort_message,1)
+  ENDIF
+  IF (ng_qsurf.GT.0 .and. prt_level > 5) THEN
+      WRITE(lunout,*)" *** Warning: Negative qsurf(humidity at surface) values in cdrag.F90 !"
+      WRITE(lunout,*)" The total number of the grids is: ", ng_qsurf
+      WRITE(lunout,*)" The negative qsurf is set to zero "
+!      abort_message="voir ci-dessus"
+!      CALL abort_physic(modname,abort_message,1)
+  ENDIF
+
+
+
+!=============================================================================c
+! Calcul du cdrag
+!=============================================================================c
+
+! On choisit les fonctions de stabilite utilisees au premier appel
+!**************************************************************************
+  IF (firstcall) THEN
+   iflag_corr_sta=2
+   iflag_corr_insta=2
+ 
+   CALL getin_p('iflag_corr_sta',iflag_corr_sta)
+   CALL getin_p('iflag_corr_insta',iflag_corr_insta)
+
+   firstcall = .FALSE.
+ ENDIF
+
+!xxxxxxxxxxxxxxxxxxxxxxx
+  DO i = 1, knon        ! Boucle sur l'horizontal
+!xxxxxxxxxxxxxxxxxxxxxxx
+
+
+! calculs preliminaires:
+!***********************
+     
+
+     zdu2 = MAX(CEPDU2, speed(i)**2)
+     pref(i) = EXP(LOG(psol(i)) - zgeop1(i)/(RD*t1(i)* &
+                 (1.+ RETV * max(q1(i),0.0))))           ! negative q1 set to zero 
+     ztsolv = tsurf(i) * (1.0+RETV*max(qsurf(i),0.0))    ! negative qsurf set to zero
+     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*max(q1(i),0.0))) &
+          *(1.+RETV*max(q1(i),0.0))                      ! negative q1 set to zero
+     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
+
+     IF (iri1.EQ.1) THEN
+       zri(i) = ri1(i)
+     ENDIF
+
+! Coefficients CD neutres : k^2/ln(z/z0) et k^2/(ln(z/z0)*ln(z/z0h)):
+!********************************************************************
+
+     zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i)))
+     cdmn(i) = zzzcd*zzzcd
+     cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i))))
+
+
+! Calcul des fonctions de stabilit?? FMs, FHs, FMi, FHi :
+!*******************************************************
+
+!''''''''''''''
+! Cas instables
+!''''''''''''''
+
+ IF (zri(i) .LT. 0.) THEN    
+
+
+        SELECT CASE (iflag_corr_insta)
+    
+        CASE (1) ! Louis 1979 + Mascart 1995
+
+           MU=LOG(MAX(z0m(i)/z0h(i),0.01))
+           CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3)
+           PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3)
+           CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3)
+           PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3)
+           CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+            & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i)))       &
+            & * ((zgeop1(i)/(RG*z0h(i)))**PH)
+           CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+            & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i)))         &
+            & * ((zgeop1(i)/(RG*z0m(i)))**PM)
+         
+
+
+
+           FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i))))
+           FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i))))
+
+        CASE (2) ! Louis 1982
+
+           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                *(1.0+zgeop1(i)/(RG*z0m(i)))))
+           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+
+
+        CASE (3) ! Laurent Li
+
+           
+           FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+           FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+
+
+
+         CASE default ! Louis 1982
+
+           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                *(1.0+zgeop1(i)/(RG*z0m(i)))))
+           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+
+
+         END SELECT
+
+
+
+! Calcul des drags
+
+
+       cdm(i)=cdmn(i)*FM(i)
+       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+
+
+! Traitement particulier des cas oceaniques
+! on applique Miller et al 1992 en l'absence de gustiness 
+
+  IF (nsrf == is_oce) THEN
+!        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
+
+        IF(iflag_gusts==0) THEN
+           zcr = (0.0016/(cdmn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
+           cdh(i) =f_cdrag_oce* cdhn(i)*(1.0+zcr**1.25)**(1./1.25)
+        ENDIF
+
+
+        cdm(i)=MIN(cdm(i),cdmmax)
+        cdh(i)=MIN(cdh(i),cdhmax)
+
+  END IF
+
+
+
+ ELSE                          
+
+!'''''''''''''''
+! Cas stables :
+!'''''''''''''''
+        zri(i) = MIN(20.,zri(i))
+
+       SELECT CASE (iflag_corr_sta)
+    
+        CASE (1) ! Louis 1979 + Mascart 1995
+   
+           FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min)
+           FH(i)=FM(i)
+
+
+        CASE (2) ! Louis 1982
+           
+           zscf = SQRT(1.+CD*ABS(zri(i)))
+           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+
+
+        CASE (3) ! Laurent Li
+   
+           FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min)
+           FH(i)=FM(i)
+
+
+        CASE (4)  ! King 2001
+          
+           if (zri(i) .LT. C2/2.) then
+           FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min)
+           FH(i)=  FM(i)
+
+
+           else
+           FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min)
+           FH(i)= FM(i)
+           endif
+
+
+        CASE (5) ! MO
+   
+          if (zri(i) .LT. 1./alpha) then
+
+           FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
+           FH(i)=FM(i)
+
+           else 
+
+
+           FM(i)=MAX(1E-7,f_ri_cd_min)
+           FH(i)=FM(i)
+
+          endif
+
+
+
+
+
+        CASE default ! Louis 1982
+
+           zscf = SQRT(1.+CD*ABS(zri(i)))
+           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+
+
+
+   END SELECT
+
+! Calcul des drags
+
+
+       cdm(i)=cdmn(i)*FM(i)
+       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+
+       IF(nsrf.EQ.is_oce) THEN
+
+        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
+        cdm(i)=MIN(cdm(i),cdmmax)
+        cdh(i)=MIN(cdh(i),cdhmax)
+
+      ENDIF
+
+
+ ENDIF
+
+!xxxxxxxxxxx
+  END DO   !  Fin de la boucle sur l'horizontal
+!xxxxxxxxxxx
+! ================================================================= c
+     
+END SUBROUTINE cdragn_ri1
+
+END MODULE cdrag_mod
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/change_srf_frac_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/change_srf_frac_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/change_srf_frac_mod.F90	(revision 3851)
@@ -183,5 +183,4 @@
            tsurf, alb_dir,alb_dif, ustar, u10m, v10m, pbl_tke)
 
-
     ELSE
        ! No modifcation should be done
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/conf_phys_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/conf_phys_m.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/conf_phys_m.F90	(revision 3851)
@@ -29,4 +29,5 @@
     USE mod_grid_phy_lmdz, ONLY: klon_glo
     USE print_control_mod, ONLY: lunout
+    use config_ocean_skin_m, only: config_ocean_skin
     USE phys_state_var_mod, ONLY: phys_tstep
 
@@ -86,5 +87,9 @@
     CHARACTER (len = 10),SAVE  :: type_veget_omp
     CHARACTER (len = 8), SAVE  :: aer_type_omp
-    LOGICAL, SAVE       :: ok_snow_omp
+    INTEGER, SAVE       :: landice_opt_omp
+    INTEGER, SAVE       :: n_dtis_omp
+    INTEGER, SAVE       :: iflag_tsurf_inlandsis_omp
+    INTEGER, SAVE       :: iflag_albzenith_omp    
+    LOGICAL, SAVE       :: SnoMod_omp,BloMod_omp,ok_outfor_omp
     LOGICAL, SAVE       :: ok_newmicro_omp
     LOGICAL, SAVE       :: ok_all_xml_omp
@@ -318,12 +323,60 @@
     !
 
-    ! 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
-
+    ! INLANDSIS
+    !==================================================================
+    ! Martin et Etienne
+    !Config Key  = landice_opt
+    !Config Desc = which landice snow model (BULK, SISVAT or INLANDSIS)
+    !Config Def  = 0
+    landice_opt_omp = 0
+    CALL getin('landice_opt', landice_opt_omp)
+    ! Martin et Etienne
+
+    !Etienne
+    !Config Key  = iflag_tsurf_inlandsis
+    !Config Desc = which method to calculate tsurf in INLANDSIS
+    !Config Def  = 0
+    iflag_tsurf_inlandsis_omp = 0
+    CALL getin('iflag_tsurf_inlandsis', iflag_tsurf_inlandsis_omp)
+
+    !Etienne
+    !Config Key  = iflag_albzenith
+    !Config Desc = method to account for albedo sensitivity to solar zenith angle
+    !Config Def  = 0
+    iflag_albzenith_omp = 0
+    CALL getin('iflag_albzenith', iflag_albzenith_omp)
+
+    !Etienne
+    !Config Key  = n_dtis
+    !Config Desc = number of subtimesteps for INLANDSIS
+    !Config Def  = 1
+    n_dtis_omp = 1
+    CALL getin('n_dtis', n_dtis_omp)
+
+    !Etienne
+    !Config Key  = SnoMod
+    !Config Desc = activation of snow modules in inlandsis
+    !Config Def  = 1
+    SnoMod_omp = .TRUE.
+    CALL getin('SnoMod', SnoMod_omp)
+
+    !Etienne
+    !Config Key  = BloMod
+    !Config Desc = activation of blowing snow in inlandsis
+    !Config Def  = 1
+    BloMod_omp = .FALSE.
+    CALL getin('BloMod', BloMod_omp)
+
+    !Etienne
+    !Config Key  = ok_outfor
+    !Config Desc = activation of output ascii file in inlandsis
+    !Config Def  = 1
+   ok_outfor_omp = .FALSE.
+    CALL getin('ok_outfor', ok_outfor_omp)
+
+
+
+    !==================================================================
+    
     !Config Key  = OK_journe
     !Config Desc = Pour des sorties journalieres 
@@ -2291,8 +2344,14 @@
        ok_veget=.FALSE.
     ENDIF
-    ! Martin
-    ok_snow = ok_snow_omp
-    ! Martin
-
+    ! SISVAT and INLANDSIS
+    !=================================================
+    landice_opt = landice_opt_omp
+    iflag_tsurf_inlandsis = iflag_tsurf_inlandsis_omp
+    iflag_albzenith = iflag_albzenith_omp
+    n_dtis=n_dtis_omp
+    SnoMod=SnoMod_omp
+    BloMod=BloMod_omp
+    ok_outfor=ok_outfor_omp
+    !=================================================
     ok_all_xml = ok_all_xml_omp
     ok_lwoff = ok_lwoff_omp
@@ -2486,6 +2545,5 @@
     ENDIF
 
-    ! Test sur new_aod. Ce flag permet de retrouver les resultats de l'AR4
-    ! il n'est utilisable que lors du couplage avec le SO4 seul 
+    ! Flag_aerosol cannot be set to zero if aerosol direct effect (ade) or aerosol indirect effect (aie) are activated
     IF (ok_ade .OR. ok_aie) THEN 
        IF ( flag_aerosol .EQ. 0 ) THEN
@@ -2494,10 +2552,10 @@
     ENDIF
 
-    ! Flag_aerosol cannot be to zero if we are in coupled mode for aerosol
+    ! Flag_aerosol cannot be set to zero if we are in coupled mode for aerosol
     IF (aerosol_couple .AND. flag_aerosol .EQ. 0 ) THEN
        CALL abort_physic('conf_phys', 'flag_aerosol cannot be to zero if aerosol_couple=y ', 1)
     ENDIF
 
-    ! Read_climoz need to be zero if we are in couple mode for chemistry 
+    ! Read_climoz needs to be set zero if we are in couple mode for chemistry 
     IF (chemistry_couple .AND. read_climoz .ne. 0) THEN 
        CALL abort_physic('conf_phys', 'read_climoz need to be to zero if chemistry_couple=y ', 1) 
@@ -2555,5 +2613,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,*) ' Snow model landice : landice_opt = ', landice_opt
     WRITE(lunout,*) ' Config xml pour XIOS : ok_all_xml = ', ok_all_xml
     WRITE(lunout,*) ' Sortie journaliere = ', ok_journe
@@ -2754,8 +2812,14 @@
     WRITE(lunout,*) ' carbon_cycle_rad = ', carbon_cycle_rad
     WRITE(lunout,*) ' level_coupling_esm = ', level_coupling_esm
+    WRITE(lunout,*) ' iflag_tsurf_inlandsis = ', iflag_tsurf_inlandsis
+    WRITE(lunout,*) ' iflag_albzenith = ', iflag_albzenith
+    WRITE(lunout,*) ' n_dtis = ', n_dtis
+    WRITE(lunout,*) ' SnoMod = ', SnoMod
+    WRITE(lunout,*) ' BloMod = ', BloMod
+    WRITE(lunout,*) ' ok_outfor = ', ok_outfor
+
 
     !$OMP END MASTER
-
-    RETURN
+    call config_ocean_skin
 
   END SUBROUTINE conf_phys
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 3851)
@@ -273,5 +273,5 @@
    endif
    if (cfg%LlidarBetaMol532) then 
-     where(cospOUT%calipso_tau_tot == R_UNDEF) cospOUT%calipso_tau_tot = missing_val
+     where(cospOUT%calipso_beta_mol == R_UNDEF) cospOUT%calipso_beta_mol = missing_val
      CALL histwrite3d_cosp(o_lidarBetaMol532,cospOUT%calipso_beta_mol,nvertmcosp) 
    endif
@@ -282,21 +282,35 @@
 !!!! Sorties Ground Lidar
  if (cfg%LgrLidar532) then
-
-   where(cospOUT%grLidar532_beta_tot == R_UNDEF) cospOUT%grLidar532_beta_tot = missing_val
-   where(cospOUT%grLidar532_cfad_sr == R_UNDEF) cospOUT%grLidar532_cfad_sr = missing_val
-   where(cospOUT%grLidar532_lidarcld == R_UNDEF) cospOUT%grLidar532_lidarcld = missing_val
-   where(cospOUT%grLidar532_cldlayer == R_UNDEF) cospOUT%grLidar532_cldlayer = missing_val
-   where(cospOUT%grLidar532_beta_mol == R_UNDEF) cospOUT%grLidar532_beta_mol = missing_val
-   where(cospOUT%grLidar532_srbval == R_UNDEF) cospOUT%grLidar532_srbval = missing_val
-
-   if (cfg%LcllgrLidar532) CALL histwrite2d_cosp(o_cllgrLidar532,cospOUT%grLidar532_cldlayer(:,1))
-   if (cfg%LclmgrLidar532) CALL histwrite2d_cosp(o_clmgrLidar532,cospOUT%grLidar532_cldlayer(:,2))
-   if (cfg%LclhgrLidar532) CALL histwrite2d_cosp(o_clhgrLidar532,cospOUT%grLidar532_cldlayer(:,3))
-   if (cfg%LcltgrLidar532) CALL histwrite2d_cosp(o_cltgrLidar532,cospOUT%grLidar532_cldlayer(:,4))
-
-   if (cfg%LclgrLidar532) CALL histwrite3d_cosp(o_clgrLidar532,cospOUT%grLidar532_lidarcld,nvert)
-   if (cfg%LlidarBetaMol532gr) CALL histwrite3d_cosp(o_lidarBetaMol532gr,cospOUT%grLidar532_beta_mol,nvertmcosp) 
-
-   do icl=1,SR_BINS
+! AI juin 2020 Voir a quoi correspond ce champs
+!   where(cospOUT%grLidar532_srbval == R_UNDEF) cospOUT%grLidar532_srbval = missing_val
+
+   if (cfg%LcllgrLidar532) then
+      where(cospOUT%grLidar532_cldlayer(:,1) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,1) = missing_val
+      CALL histwrite2d_cosp(o_cllgrLidar532,cospOUT%grLidar532_cldlayer(:,1))
+   endif
+   if (cfg%LclmgrLidar532) then
+      where(cospOUT%grLidar532_cldlayer(:,2) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,2) = missing_val
+      CALL histwrite2d_cosp(o_clmgrLidar532,cospOUT%grLidar532_cldlayer(:,2))
+   endif
+   if (cfg%LclhgrLidar532) then
+      where(cospOUT%grLidar532_cldlayer(:,3) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,3) = missing_val
+      CALL histwrite2d_cosp(o_clhgrLidar532,cospOUT%grLidar532_cldlayer(:,3))
+   endif
+   if (cfg%LcltgrLidar532) then
+      where(cospOUT%grLidar532_cldlayer(:,4) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,4) = missing_val
+      CALL histwrite2d_cosp(o_cltgrLidar532,cospOUT%grLidar532_cldlayer(:,4))
+   endif
+
+   if (cfg%LclgrLidar532) then
+       where(cospOUT%grLidar532_lidarcld == R_UNDEF) cospOUT%grLidar532_lidarcld = missing_val
+      CALL histwrite3d_cosp(o_clgrLidar532,cospOUT%grLidar532_lidarcld,nvert)
+   endif
+   if (cfg%LlidarBetaMol532gr) then
+      where(cospOUT%grLidar532_beta_mol == R_UNDEF) cospOUT%grLidar532_beta_mol = missing_val
+      CALL histwrite3d_cosp(o_lidarBetaMol532gr,cospOUT%grLidar532_beta_mol,nvertmcosp) 
+   endif
+   if (cfg%LcfadLidarsr532gr) then
+     where(cospOUT%grLidar532_cfad_sr == R_UNDEF) cospOUT%grLidar532_cfad_sr = missing_val
+     do icl=1,SR_BINS
       do k=1,Nlvgrid
        do ip=1,Npoints
@@ -304,9 +318,12 @@
        enddo
       enddo
-   enddo
-   if (cfg%LcfadLidarsr532gr) CALL histwrite4d_cosp(o_cfadLidarsr532gr,tmp_fi4da_cfadLgr)
-
-   if (cfg%Latb532gr) CALL histwrite4d_cosp(o_atb532gr,cospOUT%grLidar532_beta_tot)
-
+     enddo
+     CALL histwrite4d_cosp(o_cfadLidarsr532gr,tmp_fi4da_cfadLgr)
+   endif
+
+   if (cfg%Latb532gr) then
+      where(cospOUT%grLidar532_beta_tot == R_UNDEF) cospOUT%grLidar532_beta_tot = missing_val
+      CALL histwrite4d_cosp(o_atb532gr,cospOUT%grLidar532_beta_tot)
+   endif
 endif ! Ground Lidar 532 nm
 
@@ -314,21 +331,34 @@
 !!!! Sorties Atlid
  if (cfg%Latlid) then
-
-   where(cospOUT%atlid_beta_tot == R_UNDEF) cospOUT%atlid_beta_tot = missing_val
-   where(cospOUT%atlid_cfad_sr == R_UNDEF) cospOUT%atlid_cfad_sr = missing_val
-   where(cospOUT%atlid_lidarcld == R_UNDEF) cospOUT%atlid_lidarcld = missing_val
-   where(cospOUT%atlid_cldlayer == R_UNDEF) cospOUT%atlid_cldlayer = missing_val
-   where(cospOUT%atlid_beta_mol == R_UNDEF) cospOUT%atlid_beta_mol = missing_val
-   where(cospOUT%atlid_srbval == R_UNDEF) cospOUT%atlid_srbval = missing_val
-
-   if (cfg%Lcllatlid) CALL histwrite2d_cosp(o_cllatlid,cospOUT%atlid_cldlayer(:,1))
-   if (cfg%Lclmatlid) CALL histwrite2d_cosp(o_clmatlid,cospOUT%atlid_cldlayer(:,2))
-   if (cfg%Lclhatlid) CALL histwrite2d_cosp(o_clhatlid,cospOUT%atlid_cldlayer(:,3))
-   if (cfg%Lcltatlid) CALL histwrite2d_cosp(o_cltatlid,cospOUT%atlid_cldlayer(:,4))
-
-   if (cfg%Lclatlid) CALL histwrite3d_cosp(o_clatlid,cospOUT%atlid_lidarcld,nvert)
-   if (cfg%LlidarBetaMol355) CALL histwrite3d_cosp(o_lidarBetaMol355,cospOUT%atlid_beta_mol,nvertmcosp) 
-
-   do icl=1,SR_BINS
+! AI juin 2020 Voir a quoi correspond ce champs
+!   where(cospOUT%atlid_srbval == R_UNDEF) cospOUT%atlid_srbval = missing_val
+
+   if (cfg%Lcllatlid) then 
+      where(cospOUT%atlid_cldlayer(:,1) == R_UNDEF) cospOUT%atlid_cldlayer(:,1) = missing_val
+      CALL histwrite2d_cosp(o_cllatlid,cospOUT%atlid_cldlayer(:,1))
+   endif
+   if (cfg%Lclmatlid) then
+      where(cospOUT%atlid_cldlayer(:,2) == R_UNDEF) cospOUT%atlid_cldlayer(:,2) = missing_val
+      CALL histwrite2d_cosp(o_clmatlid,cospOUT%atlid_cldlayer(:,2))
+   endif
+   if (cfg%Lclhatlid) then
+      where(cospOUT%atlid_cldlayer(:,3) == R_UNDEF) cospOUT%atlid_cldlayer(:,3) = missing_val
+      CALL histwrite2d_cosp(o_clhatlid,cospOUT%atlid_cldlayer(:,3))
+   endif
+   if (cfg%Lcltatlid) then
+      where(cospOUT%atlid_cldlayer(:,4) == R_UNDEF) cospOUT%atlid_cldlayer(:,4) = missing_val
+      CALL histwrite2d_cosp(o_cltatlid,cospOUT%atlid_cldlayer(:,4))
+   endif
+   if (cfg%Lclatlid) then
+      where(cospOUT%atlid_lidarcld == R_UNDEF) cospOUT%atlid_lidarcld = missing_val
+      CALL histwrite3d_cosp(o_clatlid,cospOUT%atlid_lidarcld,nvert)
+   endif
+   if (cfg%LlidarBetaMol355) then
+      where(cospOUT%atlid_beta_mol == R_UNDEF) cospOUT%atlid_beta_mol = missing_val
+      CALL histwrite3d_cosp(o_lidarBetaMol355,cospOUT%atlid_beta_mol,nvertmcosp) 
+   endif
+   if (cfg%LcfadLidarsr355) then
+     where(cospOUT%atlid_cfad_sr == R_UNDEF) cospOUT%atlid_cfad_sr = missing_val
+     do icl=1,SR_BINS
       do k=1,Nlvgrid
        do ip=1,Npoints
@@ -336,9 +366,12 @@
        enddo
       enddo
-   enddo
-   if (cfg%LcfadLidarsr355) CALL histwrite4d_cosp(o_cfadlidarsr355,tmp_fi4da_cfadLatlid)
-
-   if (cfg%Latb355) CALL histwrite4d_cosp(o_atb355,cospOUT%atlid_beta_tot)
-
+     enddo
+     CALL histwrite4d_cosp(o_cfadlidarsr355,tmp_fi4da_cfadLatlid)
+   endif
+
+   if (cfg%Latb355) then
+      where(cospOUT%atlid_beta_tot == R_UNDEF) cospOUT%atlid_beta_tot = missing_val 
+      CALL histwrite4d_cosp(o_atb355,cospOUT%atlid_beta_tot)
+   endif
 endif ! Atlid
 
@@ -346,13 +379,10 @@
  if (cfg%Lparasol) then
    if (cfg%LparasolRefl) then
-! Ces 2 diagnostics sont controles par la clef logique "LparasolRefl"
-
-!!!   if (cfg%LparasolRefl) CALL histwrite3d_cosp(o_parasolrefl,cospOUT%parasolrefl,nvertp)
+     where(cospOUT%parasolGrid_refl == R_UNDEF) cospOUT%parasolGrid_refl = missing_val
+     where(cospOUT%parasolPix_refl == R_UNDEF) cospOUT%parasolPix_refl = missing_val
      CALL histwrite3d_cosp(o_parasolGrid_refl,cospOUT%parasolGrid_refl,nvertp)
-
      CALL histwrite4d_cosp(o_parasolPix_refl,cospOUT%parasolPix_refl)
-
-    endif ! LparasolRefl
-   endif ! Parasol
+   endif ! LparasolRefl
+ endif ! Parasol
 
 !  if (cfg%LparasolRefl) then 
@@ -376,23 +406,55 @@
 !!! Sorties CloudSat
  if (cfg%Lcloudsat) then
-
-   where(cospOUT%cloudsat_Ze_tot == R_UNDEF) cospOUT%cloudsat_Ze_tot = missing_val
-   where(cospOUT%cloudsat_cfad_ze == R_UNDEF) cospOUT%cloudsat_cfad_ze = missing_val
-   where(cospOUT%cloudsat_precip_cover == R_UNDEF) cospOUT%cloudsat_precip_cover = missing_val
-   where(cospOUT%cloudsat_pia == R_UNDEF) cospOUT%cloudsat_pia = missing_val
-
-   if (cfg%Lptradarflag0) CALL histwrite2d_cosp(o_ptradarflag0,cospOUT%cloudsat_precip_cover(:,1))
-   if (cfg%Lptradarflag1) CALL histwrite2d_cosp(o_ptradarflag1,cospOUT%cloudsat_precip_cover(:,2))
-   if (cfg%Lptradarflag2) CALL histwrite2d_cosp(o_ptradarflag2,cospOUT%cloudsat_precip_cover(:,3))
-   if (cfg%Lptradarflag3) CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,4))
-   if (cfg%Lptradarflag4) CALL histwrite2d_cosp(o_ptradarflag4,cospOUT%cloudsat_precip_cover(:,5))
-   if (cfg%Lptradarflag5) CALL histwrite2d_cosp(o_ptradarflag5,cospOUT%cloudsat_precip_cover(:,6))
-   if (cfg%Lptradarflag6) CALL histwrite2d_cosp(o_ptradarflag6,cospOUT%cloudsat_precip_cover(:,7))
-   if (cfg%Lptradarflag7) CALL histwrite2d_cosp(o_ptradarflag7,cospOUT%cloudsat_precip_cover(:,8))
-   if (cfg%Lptradarflag8) CALL histwrite2d_cosp(o_ptradarflag8,cospOUT%cloudsat_precip_cover(:,9))
-   if (cfg%Lptradarflag9) CALL histwrite2d_cosp(o_ptradarflag9,cospOUT%cloudsat_precip_cover(:,10))
-   if (cfg%Lradarpia) CALL histwrite2d_cosp(o_radarpia,cospOUT%cloudsat_pia)
-
-   do icl=1,CLOUDSAT_DBZE_BINS
+! AI juin 2020 voir a quoi correspond ce champs
+!   where(cospOUT%cloudsat_pia == R_UNDEF) cospOUT%cloudsat_pia = missing_val
+
+   if (cfg%Lptradarflag0) then
+     where(cospOUT%cloudsat_precip_cover(:,1) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,1) = missing_val
+     CALL histwrite2d_cosp(o_ptradarflag0,cospOUT%cloudsat_precip_cover(:,1))
+   endif
+   if (cfg%Lptradarflag1) then
+     where(cospOUT%cloudsat_precip_cover(:,2) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,2) = missing_val
+     CALL histwrite2d_cosp(o_ptradarflag1,cospOUT%cloudsat_precip_cover(:,2))
+   endif
+   if (cfg%Lptradarflag2) then
+      where(cospOUT%cloudsat_precip_cover(:,3) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,3) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag2,cospOUT%cloudsat_precip_cover(:,3))
+   endif
+   if (cfg%Lptradarflag3) then
+      where(cospOUT%cloudsat_precip_cover(:,4) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,4) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,4))
+   endif
+   if (cfg%Lptradarflag4) then
+      where(cospOUT%cloudsat_precip_cover(:,5) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,5) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,5))
+   endif
+   if (cfg%Lptradarflag5) then
+      where(cospOUT%cloudsat_precip_cover(:,6) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,6) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,6))
+   endif
+   if (cfg%Lptradarflag6) then
+      where(cospOUT%cloudsat_precip_cover(:,7) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,7) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,7))
+   endif
+   if (cfg%Lptradarflag7) then
+      where(cospOUT%cloudsat_precip_cover(:,8) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,8) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,8))
+   endif
+   if (cfg%Lptradarflag8) then
+      where(cospOUT%cloudsat_precip_cover(:,9) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,9) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,9))
+   endif
+   if (cfg%Lptradarflag9) then
+      where(cospOUT%cloudsat_precip_cover(:,10) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,10) = missing_val
+      CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,10))
+   endif
+
+   if (cfg%Ldbze94) then
+     where(cospOUT%cloudsat_Ze_tot == R_UNDEF) cospOUT%cloudsat_Ze_tot = missing_val 
+     CALL histwrite4d_cosp(o_dbze94,cospOUT%cloudsat_Ze_tot)
+   endif
+   if (cfg%LcfadDbze94)  then
+     where(cospOUT%cloudsat_cfad_ze == R_UNDEF) cospOUT%cloudsat_cfad_ze = missing_val  
+     do icl=1,CLOUDSAT_DBZE_BINS
       do k=1,Nlvgrid
        do ip=1,Npoints
@@ -400,8 +462,7 @@
        enddo
       enddo
-   enddo
-   if (cfg%Ldbze94) CALL histwrite4d_cosp(o_dbze94,cospOUT%cloudsat_Ze_tot)
-!   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
-   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
+     enddo
+     CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
+  endif
  endif
 ! endif pour CloudSat
@@ -410,17 +471,25 @@
 !!! Sorties combinees Cloudsat et Calipso
  if (cfg%Lcalipso .and. cfg%Lcloudsat) then
-   where(cospOUT%lidar_only_freq_cloud == R_UNDEF) &
+
+   if (cfg%Lclcalipso2) then
+     where(cospOUT%lidar_only_freq_cloud == R_UNDEF) &
                            cospOUT%lidar_only_freq_cloud = missing_val
-   where(cospOUT%cloudsat_tcc == R_UNDEF) &
+     CALL histwrite3d_cosp(o_clcalipso2,cospOUT%lidar_only_freq_cloud,nvert)
+   endif
+   if (cfg%Lcloudsat_tcc) then
+     where(cospOUT%cloudsat_tcc == R_UNDEF) &
                            cospOUT%cloudsat_tcc = missing_val
-   where(cospOUT%cloudsat_tcc2 == R_UNDEF) &
+     CALL histwrite2d_cosp(o_cloudsat_tcc,cospOUT%cloudsat_tcc)
+   endif
+   if (cfg%Lcloudsat_tcc2) then
+     where(cospOUT%cloudsat_tcc2 == R_UNDEF) &
                            cospOUT%cloudsat_tcc2 = missing_val
-   where(cospOUT%radar_lidar_tcc == R_UNDEF) &
-                           cospOUT%radar_lidar_tcc = missing_val
-
-   if (cfg%Lclcalipso2) CALL histwrite3d_cosp(o_clcalipso2,cospOUT%lidar_only_freq_cloud,nvert)
-   if (cfg%Lcloudsat_tcc) CALL histwrite2d_cosp(o_cloudsat_tcc,cospOUT%cloudsat_tcc)
-   if (cfg%Lcloudsat_tcc2) CALL histwrite2d_cosp(o_cloudsat_tcc2,cospOUT%cloudsat_tcc2)
-   if (cfg%Lcltlidarradar) CALL histwrite2d_cosp(o_cltlidarradar,cospOUT%radar_lidar_tcc)
+     CALL histwrite2d_cosp(o_cloudsat_tcc2,cospOUT%cloudsat_tcc2)
+   endif
+   if (cfg%Lcltlidarradar) then
+     where(cospOUT%radar_lidar_tcc == R_UNDEF) &
+                           cospOUT%radar_lidar_tcc = missing_val     
+     CALL histwrite2d_cosp(o_cltlidarradar,cospOUT%radar_lidar_tcc)
+   endif
  endif
 
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/cpl_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/cpl_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/cpl_mod.F90	(revision 3851)
@@ -48,4 +48,8 @@
   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_snow, cpl_evap, cpl_tsol
   !$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol)
+
+  REAL, ALLOCATABLE, SAVE:: cpl_delta_sst(:), cpl_delta_sal(:)
+  !$OMP THREADPRIVATE(cpl_delta_sst, cpl_delta_sal)
+  
   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy
   !$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy)
@@ -66,4 +70,9 @@
   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sit     ! sea ice temperature
   !$OMP THREADPRIVATE(read_sit)
+
+  REAL, ALLOCATABLE, SAVE:: read_sss(:, :)
+  ! bulk salinity of the surface layer of the ocean, in ppt
+  !$OMP THREADPRIVATE(read_sss)
+
   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sic     ! sea ice fraction
   !$OMP THREADPRIVATE(read_sic)
@@ -84,4 +93,8 @@
   REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D
   !$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D)
+
+  REAL, ALLOCATABLE, SAVE:: cpl_delta_sst_2D(:,:), cpl_delta_sal_2D(:,:)
+  !$OMP THREADPRIVATE(cpl_delta_sst_2D, cpl_delta_sal_2D)
+
   REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D
   !$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D)
@@ -122,4 +135,5 @@
     USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area
     USE ioipsl_getin_p_mod, ONLY: getin_p
+    use config_ocean_skin_m, only: activate_ocean_skin
 
 ! Input arguments
@@ -153,4 +167,5 @@
     cpl_old_calving=.FALSE.
     CALL getin_p("cpl_old_calving",cpl_old_calving)
+    WRITE(lunout,*)' cpl_old_calving = ', cpl_old_calving
 
 
@@ -217,4 +232,15 @@
     ALLOCATE(read_sit(nbp_lon, jj_nb), stat = error)
     sum_error = sum_error + error
+
+    if (activate_ocean_skin >= 1) then
+       ALLOCATE(read_sss(nbp_lon, jj_nb), stat = error)
+       sum_error = sum_error + error
+    
+       if (activate_ocean_skin == 2) then
+          ALLOCATE(cpl_delta_sst(klon), cpl_delta_sal(klon), stat = error)
+          sum_error = sum_error + error
+       end if
+    end if
+
     ALLOCATE(read_alb_sic(nbp_lon, jj_nb), stat = error)
     sum_error = sum_error + error
@@ -240,5 +266,4 @@
     ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error)    
     sum_error = sum_error + error
-
 
     CALL gather_omp(longitude_deg,rlon_mpi)
@@ -251,4 +276,10 @@
       CALL Grid1DTo2D_mpi(rlat_mpi,lat2D)
       CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D)
+      !--the next line is required for lat-lon grid and should have no impact
+      !--for an unstructured grid for which nbp_lon=1
+      !--if north pole in process mpi then divide cell area of pole cell by number of replicates
+      IF (is_north_pole_dyn) cell_area2D(:,1)=cell_area2D(:,1)/FLOAT(nbp_lon)
+      !--if south pole in process mpi then divide cell area of pole cell by number of replicates
+      IF (is_south_pole_dyn) cell_area2D(:,jj_nb)=cell_area2D(:,jj_nb)/FLOAT(nbp_lon)
       mask_calving(:,:,:) = 0 
       WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1
@@ -278,5 +309,4 @@
     ENDIF
     
-           
     IF (sum_error /= 0) THEN
        abort_message='Pb allocation variables couplees'
@@ -349,5 +379,4 @@
     ENDIF    ! is_sequential
     
-
 !*************************************************************************************
 ! compatibility test
@@ -376,4 +405,5 @@
     USE time_phylmdz_mod, ONLY: start_time, itau_phy
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     INCLUDE "YOMCST.h"
@@ -437,4 +467,5 @@
        read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw)  ! Albedo at sea ice
        read_sit(:,:)     = tab_read_flds(:,:,idr_icetem)  ! Sea ice temperature
+       if (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss)
 !$OMP END MASTER
 
@@ -494,5 +525,6 @@
 !
 
-  SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, v0_new)
+  SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, &
+       v0_new, sss)
 !
 ! This routine returns the field for the ocean that has been read from the coupler
@@ -502,4 +534,5 @@
     USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
     USE indice_sol_mod
+    use config_ocean_skin_m, only: activate_ocean_skin
 
 ! Input arguments
@@ -511,4 +544,8 @@
 !*************************************************************************************
     REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
+
+    REAL, INTENT(OUT):: sss(:) ! (klon)
+    ! bulk salinity of the surface layer of the ocean, in ppt
+
     REAL, DIMENSION(klon), INTENT(OUT)      :: u0_new
     REAL, DIMENSION(klon), INTENT(OUT)      :: v0_new
@@ -525,4 +562,5 @@
 !*************************************************************************************
     CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
+    if (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex)
     CALL cpl2gath(read_sic, sic_new, knon, knindex)
     CALL cpl2gath(read_u0, u0_new, knon, knindex)
@@ -611,14 +649,18 @@
        swdown, lwdown, fluxlat, fluxsens, &
        precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp,&
-       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-!
-! This subroutine cumulates some fields for each time-step during a coupling 
-! period. At last time-step in a coupling period the fields are transformed to the 
-! grid accepted by the coupler. No sending to the coupler will be done from here 
-! (it is done in cpl_send_seaice_fields).
-!
+       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, delta_sst, &
+       delta_sal)
+
+    ! This subroutine cumulates some fields for each time-step during
+    ! a coupling period. At last time-step in a coupling period the
+    ! fields are transformed to the grid accepted by the coupler. No
+    ! sending to the coupler will be done from here (it is done in
+    ! cpl_send_seaice_fields). Crucial hypothesis is that the surface
+    ! fractions do not change between coupling time-steps.
+
     USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
     USE indice_sol_mod
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
+    use config_ocean_skin_m, only: activate_ocean_skin
 
 ! Input arguments
@@ -632,6 +674,13 @@
     REAL, DIMENSION(klon), INTENT(IN)       :: evap, tsurf, fder, albsol
     REAL, DIMENSION(klon), INTENT(IN)       :: taux, tauy, windsp
-    REAL, DIMENSION(klon), INTENT(IN)       :: sens_prec_liq, sens_prec_sol
+    REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
     REAL, DIMENSION(klon), INTENT(IN)       :: lat_prec_liq, lat_prec_sol
+    
+    REAL, intent(in):: delta_sst(:) ! (knon)
+    ! Ocean-air interface temperature minus bulk SST, in
+    ! K. Defined only if activate_ocean_skin >= 1.
+
+    real, intent(in):: delta_sal(:) ! (knon)
+    ! Ocean-air interface salinity minus bulk salinity, in ppt.
 
 ! Local variables
@@ -669,4 +718,9 @@
        cpl_taumod(1:knon,cpl_index) = 0.0
        IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0
+
+       if (activate_ocean_skin == 2) then
+          cpl_delta_sst = 0.
+          cpl_delta_sal = 0.
+       end if
     ENDIF
        
@@ -710,4 +764,9 @@
 !!---OB: this is correct but why knindex ??
        ENDIF
+
+       if (activate_ocean_skin == 2) then
+          cpl_delta_sst(ig) = cpl_delta_sst(ig) + delta_sst(ig) / REAL(nexca)
+          cpl_delta_sal(ig) = cpl_delta_sal(ig) + delta_sal(ig) / REAL(nexca)
+       end if
      ENDDO
 
@@ -755,4 +814,10 @@
              sum_error = sum_error + error
           ENDIF
+
+          if (activate_ocean_skin == 2) then
+             ALLOCATE(cpl_delta_sst_2D(nbp_lon, jj_nb), &
+                  cpl_delta_sal_2D(nbp_lon, jj_nb), stat = error)
+             sum_error = sum_error + error
+          end if
 
           IF (sum_error /= 0) THEN
@@ -810,5 +875,9 @@
        IF (carbon_cycle_cpl) &
             CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex)
-   ENDIF
+       if (activate_ocean_skin == 2) then
+          CALL gath2cpl(cpl_delta_sst, cpl_delta_sst_2D, knon, knindex)
+          CALL gath2cpl(cpl_delta_sal, cpl_delta_sal_2D, knon, knindex)
+       end if
+    ENDIF
 
   END SUBROUTINE cpl_send_ocean_fields
@@ -846,5 +915,5 @@
     REAL, DIMENSION(klon), INTENT(IN)       :: albsol, taux, tauy
     REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)       :: sens_prec_liq, sens_prec_sol
+    REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
     REAL, DIMENSION(klon), INTENT(IN)       :: lat_prec_liq, lat_prec_sol
     LOGICAL, INTENT(IN)                     :: lafin
@@ -1145,4 +1214,5 @@
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     USE time_phylmdz_mod, ONLY: start_time, itau_phy
+    use config_ocean_skin_m, only: activate_ocean_skin
 ! Some includes
 !    
@@ -1202,4 +1272,9 @@
     tab_flds(:,:,ids_qraiic) = cpl_sens_rain2D(:,:,2)
     tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2)
+
+    if (activate_ocean_skin == 2) then
+       tab_flds(:, :, ids_delta_sst) = cpl_delta_sst_2D
+       tab_flds(:, :, ids_delta_sal) = cpl_delta_sal_2D
+    end if
     
     IF (version_ocean=='nemo') THEN
@@ -1438,4 +1513,6 @@
     ENDIF
 
+    if (activate_ocean_skin == 2) deallocate(cpl_delta_sst_2d, cpl_delta_sal_2d)
+
     IF (sum_error /= 0) THEN
        abort_message='Pb in deallocation of cpl_xxxx2D coupling variables'
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dimsoil.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dimsoil.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dimsoil.h	(revision 3851)
@@ -4,2 +4,17 @@
       INTEGER nsoilmx
       PARAMETER (nsoilmx=11)
+
+! For Inlandsis, Etienne Vignon:
+
+      INTEGER nsnowmx
+      PARAMETER (nsnowmx=35)
+      
+      INTEGER nsismx
+      PARAMETER (nsismx=46) 
+
+! nsismx should be equal to nsoilmx+nsnowmx 
+
+
+
+
+
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1DUTILS.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1DUTILS.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1DUTILS.h	(revision 3851)
@@ -233,4 +233,11 @@
        CALL getin('ok_flux_surf',ok_flux_surf)
 
+!Config  Key  = ok_forc_tsurf
+!Config  Desc = forcage ou non par la Ts
+!Config  Def  = false
+!Config  Help = forcage ou non par la Ts
+       ok_forc_tsurf=.false.
+       CALL getin('ok_forc_tsurf',ok_forc_tsurf)
+
 !Config  Key  = ok_prescr_ust
 !Config  Desc = ustar impose ou non
@@ -239,4 +246,12 @@
        ok_prescr_ust = .false.
        CALL getin('ok_prescr_ust',ok_prescr_ust)
+
+
+!Config  Key  = ok_prescr_beta
+!Config  Desc = betaevap impose ou non
+!Config  Def  = false
+!Config  Help = betaevap impose ou non
+       ok_prescr_beta = .false.
+       CALL getin('ok_prescr_beta',ok_prescr_beta)
 
 !Config  Key  = ok_old_disvert
@@ -280,5 +295,5 @@
 !Config  Desc = surface temperature
 !Config  Def  = 290.
-!Config  Help = not used if type_ts_forcing=1 in lmdz1d.F
+!Config  Help = surface temperature
        tsurf = 290.
        CALL getin('tsurf',tsurf)
@@ -297,4 +312,7 @@
        zsurf = 0.
        CALL getin('zsurf',zsurf)
+! EV pour accord avec format standard       
+       CALL getin('zorog',zsurf)
+
 
 !Config  Key  = rugos
@@ -359,4 +377,13 @@
        qsolinp = 1.
        CALL getin('qsolinp',qsolinp)
+
+
+
+!Config  Key  = betaevap
+!Config  Desc = beta for actual evaporation when prescribed
+!Config  Def  = 1.0
+!Config  Help = 
+       betaevap = 1.
+       CALL getin('betaevap',betaevap)      
 
 !Config  Key  = zpicinp
@@ -520,4 +547,5 @@
        CALL getin('forc_ustar',forc_ustar)
        IF (forc_ustar .EQ. 1) ok_prescr_ust=.true.
+
 
 !Config  Key  = nudging_u
@@ -1248,25 +1276,25 @@
       END
 
-!======================================================================
-       SUBROUTINE read_tsurf1d(knon,sst_out)
-
-! This subroutine specifies the surface temperature to be used in 1D simulations
-
-      USE dimphy, ONLY : klon
-
-      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
-      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
-
-       INTEGER :: i
-! COMMON defined in lmdz1d.F:
-       real ts_cur
-       common /sst_forcing/ts_cur
-
-       DO i = 1, knon
-        sst_out(i) = ts_cur
-       ENDDO
-
-      END SUBROUTINE read_tsurf1d
-
+!!======================================================================
+!       SUBROUTINE read_tsurf1d(knon,sst_out)
+!
+!! This subroutine specifies the surface temperature to be used in 1D simulations
+!
+!      USE dimphy, ONLY : klon
+!
+!      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+!      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
+!
+!       INTEGER :: i
+!! COMMON defined in lmdz1d.F:
+!       real ts_cur
+!       common /sst_forcing/ts_cur
+
+!       DO i = 1, knon
+!        sst_out(i) = ts_cur
+!       ENDDO
+!
+!      END SUBROUTINE read_tsurf1d
+!
 !===============================================================
       subroutine advect_vert(llm,w,dt,q,plev)
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_decl_cases.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 3851)
@@ -34,10 +34,11 @@
         real w_mod(llm), t_mod(llm),q_mod(llm)
         real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
-	real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)
+	    real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)
         real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
         real th_mod(llm)
 
-        real ts_cur
-        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
+! EV comment these lines
+!        real ts_cur
+!        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas RICO
@@ -286,5 +287,5 @@
         real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm),v_nudg_mod_cas(llm),u_nudg_mod_cas(llm)
         real u_mod_cas(llm),v_mod_cas(llm)
-        real omega_mod_cas(llm)
+        real omega_mod_cas(llm),tke_mod_cas(llm+1)
         real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
         real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_interp_cases.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 3851)
@@ -1,4 +1,4 @@
 
-         print*,'FORCING CASE forcing_case2'
+        print*,'FORCING CASE forcing_case2'
 !       print*,                                                             &
 !    & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
@@ -13,8 +13,8 @@
      &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
      &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
-     &       ,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas                                       &
+     &       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                                       &
      &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
      &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
-     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
+     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
 !
      &       ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
@@ -22,22 +22,22 @@
      &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
      &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
-     &       ,vitw_prof_cas,omega_prof_cas                                                  &
+     &       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                     &
      &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
      &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
      &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
      &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
-     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
-
-             ts_cur = ts_prof_cas 
+     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
+! EV tg instead of ts_cur
+             tg = ts_prof_cas 
 !            psurf=plev_prof_cas(1)
              psurf=ps_prof_cas
 
 ! vertical interpolation:
-      CALL interp2_case_vertical_std(play,nlev_cas,plev_prof_cas                                              &
+      CALL interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                                              &
      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                       &
      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
      &         ,ug_prof_cas,vg_prof_cas                                                                   &
      &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                       &
-     &         ,vitw_prof_cas,omega_prof_cas                                      &
+     &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
@@ -47,5 +47,5 @@
      &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
      &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
-     &         ,w_mod_cas,omega_mod_cas                                                                   &
+     &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
@@ -109,4 +109,6 @@
       do l = 1, llm
 ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
+	print*, l, llm
+	print*, play(l), temp(l)
        omega(l) = -w_mod_cas(l)*play(l)*rg/(rd*temp(l))
       enddo
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 3851)
@@ -27,8 +27,8 @@
      &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
      &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
-     &       ,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas                                       &
+     &       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                                       &
      &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
      &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
-     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
+     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
 !
      &       ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
@@ -36,10 +36,10 @@
      &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
      &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
-     &       ,vitw_prof_cas,omega_prof_cas                                                  &
+     &       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                    &
      &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
      &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
      &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
      &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
-     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
+     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
 
       do l = 1, nlev_cas
@@ -49,5 +49,5 @@
 ! vertical interpolation using interpolation routine:
 !      write(*,*)'avant interp vert', t_prof
-      CALL interp2_case_vertical_std(play,nlev_cas,plev_prof_cas                                              &
+      CALL interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                                              &
      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
@@ -55,5 +55,5 @@
      &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                         &
 
-     &         ,vitw_prof_cas,omega_prof_cas                                                              &
+     &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
@@ -63,5 +63,5 @@
      &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
      &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
-     &         ,w_mod_cas,omega_mod_cas                                                                   &
+     &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
@@ -70,7 +70,10 @@
 
 ! initial and boundary conditions :
-!      tsurf = ts_prof_cas
+!     tsurf = ts_prof_cas
       psurf = ps_prof_cas
-      ts_cur = ts_prof_cas 
+      !EV tg instead of ts_cur
+      tg = ts_prof_cas 
+      print*, 'tg=', tg
+
       do l = 1, llm
        temp(l) = t_mod_cas(l)
@@ -95,8 +98,11 @@
        d_u_adv(l) = du_mod_cas(l)+hu_mod_cas(l)+vu_mod_cas(l)
        d_v_adv(l) = dv_mod_cas(l)+hv_mod_cas(l)+vv_mod_cas(l)
+      enddo
 
-!print*,'d_t_adv ',d_t_adv(1:20)*86400
+! Etienne pour initialisation de TKE
 
-      enddo     
+       do l=1,llm+1
+       pbl_tke(:,l,:)=tke_mod_cas(l)
+       enddo     
 
 ! Faut-il multiplier par -1 ? (MPL 20160713)
@@ -108,6 +114,6 @@
        IF (ok_prescr_ust) THEN
        ust=ustar_prof_cas
-       print *,'ust=',ust
        ENDIF
 
+
       endif !forcing_SCM
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 3851)
@@ -18,5 +18,5 @@
         real, allocatable::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
         real, allocatable::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
-        real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
+        real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:),tke_cas(:,:)
 
 !forcing
@@ -30,5 +30,5 @@
         real, allocatable::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
         real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
-        real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
+        real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
 
 !champs interpoles
@@ -48,4 +48,5 @@
         real, allocatable::  vitw_prof_cas(:)
         real, allocatable::  omega_prof_cas(:)
+        real, allocatable::  tke_prof_cas(:)
         real, allocatable::  ug_prof_cas(:)
         real, allocatable::  vg_prof_cas(:)
@@ -73,5 +74,5 @@
 
 
-        real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
+        real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
         real o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
       
@@ -92,5 +93,5 @@
       REAL, ALLOCATABLE :: time_val(:)
 
-      print*,'ON EST VRAIMENT LA'
+      print*,'ON EST VRAIMENT DASN MOD_1D_CASES_READ_STD'
       fich_cas='cas.nc'
       print*,'fich_cas ',fich_cas
@@ -168,5 +169,5 @@
         allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
         allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
-
+        allocate(tke_cas(nlev_cas,nt_cas))
 !forcing
         allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
@@ -179,5 +180,5 @@
         allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas))
         allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas))
-        allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas))
+        allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tkes_cas(nt_cas))
         allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
 
@@ -200,4 +201,5 @@
         allocate(vitw_prof_cas(nlev_cas))
         allocate(omega_prof_cas(nlev_cas))
+        allocate(tke_prof_cas(nlev_cas))
         allocate(ug_prof_cas(nlev_cas))
         allocate(vg_prof_cas(nlev_cas))
@@ -228,9 +230,9 @@
         CALL read_SCM (nid,nlev_cas,nt_cas,                                                                     &
      &     ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                   &
-     &     ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,                            &
+     &     ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,tke_cas,ug_cas,vg_cas,                            &
      &     temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas,                                                     &
      &     du_cas,hu_cas,vu_cas,                                                                                &
      &     dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
-     &     dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
+     &     dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,                      &
      &     uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
      &     o3_cas,rugos_cas,clay_cas,sand_cas)
@@ -254,5 +256,5 @@
         deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
         deallocate(th_cas,thl_cas,thv_cas,rv_cas)
-        deallocate(u_cas,v_cas,vitw_cas,omega_cas)
+        deallocate(u_cas,v_cas,vitw_cas,omega_cas,tke_cas)
         
 !forcing
@@ -265,5 +267,5 @@
         deallocate(ug_cas)
         deallocate(vg_cas)
-        deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
+        deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,uw_cas,vw_cas,q1_cas,q2_cas)
 
 !champs interpoles
@@ -283,4 +285,5 @@
         deallocate(vitw_prof_cas)
         deallocate(omega_prof_cas)
+        deallocate(tke_prof_cas)
         deallocate(ug_prof_cas)
         deallocate(vg_prof_cas)
@@ -312,8 +315,8 @@
 !=====================================================================
       SUBROUTINE read_SCM(nid,nlevel,ntime,                                       &
-     &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
+     &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,tke,ug,vg,&
      &     temp_nudg,qv_nudg,u_nudg,v_nudg,                                        &
      &     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
-     &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tket,uw,vw,q1,q2,       &
+     &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tkes,uw,vw,q1,q2,       &
      &     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
      &     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
@@ -334,8 +337,8 @@
       real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
       real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
-      real u(nlevel,ntime),v(nlevel,ntime),tket(ntime)
+      real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
       real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
       real ug(nlevel,ntime),vg(nlevel,ntime)
-      real vitw(nlevel,ntime),omega(nlevel,ntime)
+      real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
@@ -371,5 +374,5 @@
      &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt',   & ! #46-58
      ! coordonnees temps #12
-     &'tket','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
+     &'tkes','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
      &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',&
      ! scalaires #4
@@ -546,5 +549,5 @@
            case(56) ; u=resul
            case(57) ; v=resul
-           case(58) ; tket=resul2   ! donnees indexees en time
+           case(58) ; tkes=resul2   ! donnees indexees en time
            case(59) ; sens=resul2
            case(60) ; flat=resul2
@@ -581,5 +584,5 @@
              u(k,t)=u0(k)
              v(k,t)=v0(k)
-             !tke(k,t)=tke0(k)
+             tke(k,t)=tke0(k)
           enddo
        enddo
@@ -593,4 +596,6 @@
 
 !======================================================================
+
+!**********************************************************************************************
 
 !**********************************************************************************************
@@ -601,9 +606,9 @@
      &         ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
      &         ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas     &
-     &         ,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
+     &         ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas             &
      &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
      &         ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
      &         ,lat_cas,sens_cas,ustar_cas                                        &
-     &         ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
+     &         ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                               &
 !
      &         ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
@@ -611,13 +616,17 @@
      &         ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
      &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas     &
-     &         ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
+     &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
      &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
      &         ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
      &         ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
      &         ,lat_prof_cas,sens_prof_cas                                        &
-     &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
-          
-
-        implicit none
+     &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
+
+
+
+
+
+
+       implicit none
 
 !---------------------------------------------------------------------------------------
@@ -639,5 +648,6 @@
         real ts_cas(nt_cas),ps_cas(nt_cas)
         real plev_cas(nlev_cas,nt_cas)
-        real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
+        real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
+        real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
         real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
         real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
@@ -646,5 +656,5 @@
         real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
 
-        real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
+        real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
         real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
         real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
@@ -653,5 +663,5 @@
         real dtrad_cas(nlev_cas,nt_cas)
         real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-        real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
+        real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
         real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
         real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
@@ -666,5 +676,5 @@
         real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
 
-        real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
+        real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
         real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
         real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
@@ -673,5 +683,5 @@
         real dtrad_prof_cas(nlev_cas)
         real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-        real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas
+        real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas
         real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
 ! local:
@@ -757,6 +767,6 @@
        sens_prof_cas = sens_cas(it_cas2)                                 &
      &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
-       tke_prof_cas = tke_cas(it_cas2)                                   &
-     &          -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
+       tkes_prof_cas = tkes_cas(it_cas2)                                   &
+     &          -frac*(tkes_cas(it_cas2)-tkes_cas(it_cas1))
        ts_prof_cas = ts_cas(it_cas2)                                     &
      &          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
@@ -804,4 +814,6 @@
         omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
      &          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
+        tke_prof_cas(k) = tke_cas(k,it_cas2)                         &
+     &          -frac*(tke_cas(k,it_cas2)-tke_cas(k,it_cas1))
         du_prof_cas(k) = du_cas(k,it_cas2)                               &
      &          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
@@ -851,10 +863,10 @@
 !**********************************************************************************************
 !=====================================================================
-       SUBROUTINE interp2_case_vertical_std(play,nlev_cas,plev_prof_cas                                &
+       SUBROUTINE interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                           &
      &         ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas                                       &
      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                              &
      &         ,ug_prof_cas,vg_prof_cas                                                                &
      &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                    &
-     &         ,vitw_prof_cas,omega_prof_cas                                                           &
+     &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                              &
      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                &
      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
@@ -865,5 +877,5 @@
      &         ,ug_mod_cas,vg_mod_cas                                                                  &
      &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                        &
-     &         ,w_mod_cas,omega_mod_cas                                                                &
+     &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                    &
      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                      &
      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas        &
@@ -888,9 +900,9 @@
 !       real hq_prof(nlevmax),vq_prof(nlevmax)
  
-       real play(llm), plev_prof_cas(nlev_cas) 
+       real play(llm), plev(llm+1), plev_prof_cas(nlev_cas) 
        real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
        real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
        real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
+       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
        real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
        real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
@@ -905,5 +917,5 @@
        real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
        real u_mod_cas(llm),v_mod_cas(llm)
-       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm)
+       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
        real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
        real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
@@ -917,10 +929,7 @@
        real frac,frac1,frac2,fact
  
-!       do l = 1, llm
-!       print *,'debut interp2, play=',l,play(l)
-!       enddo
-!      do l = 1, nlev_cas
-!      print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l)
-!      enddo
+
+
+! for variables defined at the middle of layers
 
        do l = 1, llm
@@ -950,5 +959,8 @@
          endif
 
+
+
          frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
+         
          t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
          theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
@@ -1075,4 +1087,51 @@
        enddo ! l
 
+! for variables defined at layer interfaces (EV):
+
+
+       do l = 1, llm+1
+
+        if (plev(l).ge.plev_prof_cas(nlev_cas)) then
+
+         mxcalc=l
+         k1=0
+         k2=0
+
+         if (plev(l).le.plev_prof_cas(1)) then
+
+         do k = 1, nlev_cas-1
+          if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,plev(l) = ',l,plev(l)/100
+         do k = 1, nlev_cas-1
+          write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
+         tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1))
+         else !play>plev_prof_cas(1)
+         k1=1
+         k2=2
+         tke_mod_cas(l)= frac1*tke_prof_cas(k1) - frac2*tke_prof_cas(k2)
+
+         endif ! plev.le.plev_prof_cas(1)
+
+        else ! above max altitude of forcing file
+
+         tke_mod_cas(l)=0.0
+
+        endif ! plev
+
+       enddo ! l
+
+
+
           return
           end SUBROUTINE interp2_case_vertical_std
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_decl_cases.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 3851)
@@ -37,6 +37,6 @@
         real th_mod(llm)
 
-        real ts_cur
-        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
+        !real ts_cur
+        !common /sst_forcing/ts_cur ! also in read_tsurf1d.F
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas RICO
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_interp_cases.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 3851)
@@ -62,6 +62,6 @@
      &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
      &             ,ht_prof,vt_prof,hq_prof,vq_prof)
-
-        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+! EV: tg instead of ts_cur
+        if (type_ts_forcing.eq.1) tg = ts_prof ! 
 
 ! vertical interpolation:
@@ -113,6 +113,6 @@
 !     print *,'llm l omega_profd',llm,l,omega_profd(l)
 !     enddo
-
-        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
+! EV tg instead of ts_cur
+        if (type_ts_forcing.eq.1) tg = tg_prof ! SST used 
 
 ! vertical interpolation:
@@ -206,6 +206,6 @@
      &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                            &
      &             ,ug_profg,vg_profg,ht_profg,hq_profg,tg_profg)
-
-        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
+!EV tg instead of ts_cur
+        if (type_ts_forcing.eq.1) tg = tg_prof ! SST used
 
 ! vertical interpolation:
@@ -499,6 +499,6 @@
      &             ,nlev_sandu                                              &
      &             ,ts_sandu,ts_prof)
-
-        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+! EV tg instead of ts_cur
+        if (type_ts_forcing.eq.1) tg = ts_prof ! SST used in read_tsurf1d
 
 ! vertical interpolation:
@@ -582,7 +582,6 @@
      &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
      &             ,ufa_prof,vfa_prof)
-
-        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
-
+! EV tg instead of ts_cur
+        if (type_ts_forcing.eq.1) tg = ts_prof ! SST used 
 ! vertical interpolation:
       CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
@@ -675,6 +674,7 @@
      &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas,lat_prof_cas               &
      &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
-
-             ts_cur = ts_prof_cas 
+! EV tg instead of ts_cur
+
+             tg = ts_prof_cas 
              psurf=plev_prof_cas(1)
 
@@ -850,6 +850,7 @@
      &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
      &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
-
-             ts_cur = ts_prof_cas 
+! EV tg instead of ts_cur
+
+             tg = ts_prof_cas 
 !            psurf=plev_prof_cas(1)
              psurf=ps_prof_cas
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 3851)
@@ -875,6 +875,7 @@
 
 ! initial and boundary conditions :
-!      tsurf = ts_prof_cas
-      ts_cur = ts_prof_cas 
+!     tsurf = ts_prof_cas
+! EV tg instead of ts_cur
+      tg= ts_prof_cas 
       psurf=plev_prof_cas(1)
       write(*,*) 'SST initiale: ',tsurf
@@ -965,5 +966,6 @@
 ! initial and boundary conditions :
 !      tsurf = ts_prof_cas
-      ts_cur = ts_prof_cas 
+! EV tg instead of ts_cur
+      tg = ts_prof_cas 
       psurf=plev_prof_cas(1)
       write(*,*) 'SST initiale: ',tsurf
@@ -1063,5 +1065,7 @@
 ! initial and boundary conditions :
 !      tsurf = ts_prof_cas
-      ts_cur = ts_prof_cas 
+! EV tg instead of ts_cur
+
+      tg = ts_prof_cas 
       psurf=plev_prof_cas(1)
       write(*,*) 'SST initiale: ',tsurf
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_lmdz1d.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_lmdz1d.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/old_lmdz1d.F90	(revision 3851)
@@ -632,5 +632,7 @@
 !          (phys_state_var_init is called again in physiq)
       read_climoz = 0
-!
+      nsw=6          ! EV et LF: sinon, falb_dir et falb_dif ne peuvent etre alloues
+
+
       call phys_state_var_init(read_climoz)
 
@@ -728,5 +730,7 @@
 
 !Al1 pour SST forced, appell?? depuis ocean_forced_noice
-      ts_cur = tsurf ! SST used in read_tsurf1d
+! EV tg instead of ts_cur
+
+      tg = tsurf ! SST used in read_tsurf1d
 !=====================================================================
 ! Initialisation de la physique : 
@@ -791,4 +795,5 @@
 
         fder=0.
+        print *, 'snsrf', snsrf
         snsrf(1,:)=snowmass ! masse de neige des sous surface
         qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
@@ -841,5 +846,4 @@
      end if
 
-
         print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
      &        ,pctsrf(1,is_oce),pctsrf(1,is_ter)
@@ -848,7 +852,4 @@
         zpic = zpicinp
         ftsol=tsurf
-        nsw=6 ! on met le nb de bandes SW=6, pour initialiser
-              ! 6 albedo, mais on peut quand meme tourner avec
-              ! moins. Seules les 2 ou 4 premiers seront lus
         falb_dir=albedo
         falb_dif=albedo
@@ -913,8 +914,8 @@
         v_ancien(1,:)=v(:)
 
-u10m=0.
-v10m=0.
-ale_wake=0.
-ale_bl_stat=0.
+        u10m=0.
+        v10m=0.
+        ale_wake=0.
+        ale_bl_stat=0.
  
 !------------------------------------------------------------------------
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/scm.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/scm.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/dyn1d/scm.F90	(revision 3851)
@@ -75,28 +75,4 @@
       real :: zcufi    = 1.
       real :: zcvfi    = 1.
-
-!-      real :: nat_surf
-!-      logical :: ok_flux_surf
-!-      real :: fsens
-!-      real :: flat
-!-      real :: tsurf
-!-      real :: rugos
-!-      real :: qsol(1:2)
-!-      real :: qsurf
-!-      real :: psurf
-!-      real :: zsurf
-!-      real :: albedo
-!-
-!-      real :: time     = 0.
-!-      real :: time_ini
-!-      real :: xlat 
-!-      real :: xlon 
-!-      real :: wtsurf 
-!-      real :: wqsurf 
-!-      real :: restart_runoff 
-!-      real :: xagesno 
-!-      real :: qsolinp 
-!-      real :: zpicinp 
-!-
       real :: fnday 
       real :: day, daytime 
@@ -141,6 +117,4 @@
         logical :: forcing_case2   = .false.
         logical :: forcing_SCM   = .false.
-        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
-!                                                            (cf read_tsurf1d.F)
 
 !flag forcings
@@ -148,4 +122,6 @@
         logical :: nudge_thermo=.false.
         logical :: cptadvw=.true.
+
+
 !=====================================================================
 ! DECLARATIONS FOR EACH CASE
@@ -248,5 +224,5 @@
 !
       integer :: it_end ! iteration number of the last call
-!Al1
+!Al1,plev,play,phi,phis,presnivs,
       integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
       data ecrit_slab_oc/-1/
@@ -278,4 +254,5 @@
       d_v_age(:)=0.
       
+      
 ! Initialization of Common turb_forcing
        dtime_frcg = 0.
@@ -290,5 +267,4 @@
 ! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
 !---------------------------------------------------------------------
-!Al1
         call conf_unicol
 !Al1 moves this gcssold var from common fcg_gcssold to 
@@ -296,5 +272,4 @@
 ! --------------------------------------------------------------------
         close(1)
-!Al1
         write(*,*) 'lmdz1d.def lu => unicol.def'
 
@@ -302,6 +277,7 @@
        year_ini_cas=1997
        ! It is possible that those parameters are run twice.
-
        ! A REVOIR : LIRE PEUT ETRE AN MOIS JOUR DIRECETEMENT
+
+
        call getin('anneeref',year_ini_cas)
        call getin('dayref',day_deb)
@@ -309,9 +285,8 @@
        call getin('time_ini',heure_ini_cas)
 
-        type_ts_forcing = 0
-        IF (nat_surf==0) type_ts_forcing=1 ! SST forcee sur OCEAN
-        print*,'NATURE DE LA SURFACE ',nat_surf
+      print*,'NATURE DE LA SURFACE ',nat_surf
 !
 ! Initialization of the logical switch for nudging
+
      jcode = iflag_nudge
      do i = 1,nudge_max
@@ -319,7 +294,7 @@
        jcode = jcode/10
      enddo
-!---------------------------------------------------------------------
+!-----------------------------------------------------------------------
 !  Definition of the run
-!---------------------------------------------------------------------
+!-----------------------------------------------------------------------
 
       call conf_gcm( 99, .TRUE. )
@@ -343,4 +318,6 @@
       allocate( phy_flic(year_len)) ! Fraction de glace
       phy_flic(:)=0.0
+
+
 !-----------------------------------------------------------------------
 !   Choix du calendrier
@@ -373,4 +350,6 @@
 !      Le numero du jour est dans "day". L heure est traitee separement.
 !      La date complete est dans "daytime" (l'unite est le jour).
+
+
       if (nday>0) then
          fnday=nday
@@ -409,5 +388,5 @@
 ! Initialization of dimensions, geometry and initial state
 !---------------------------------------------------------------------
-!      call init_phys_lmdz(1,1,llm,1,(/1/)) ! job now done via iniphysiq
+!     call init_phys_lmdz(1,1,llm,1,(/1/)) ! job now done via iniphysiq
 !     but we still need to initialize dimphy module (klon,klev,etc.)  here.
       call init_dimphy1D(1,llm)
@@ -433,5 +412,6 @@
 !          (phys_state_var_init is called again in physiq)
       read_climoz = 0
-!
+      nsw=6
+
       call phys_state_var_init(read_climoz)
 
@@ -446,10 +426,4 @@
 !!! Feedback forcing values for Gateaux differentiation (al1)
 !!!=====================================================================
-!!! Surface Planck forcing bracketing call radiation
-!!      surf_Planck = 0.
-!!      surf_Conv   = 0.
-!!      write(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
-!!! a mettre dans le lmdz1d.def ou autre
-!!
 !!
       qsol = qsolinp
@@ -469,8 +443,4 @@
       ENDIF
       print*,'Flux sol ',fsens,flat
-!!      ok_flux_surf=.false.
-!!      fsens=-wtsurf*rcpd*rho(1)
-!!      flat=-wqsurf*rlvtt*rho(1)
-!!!!
 
 ! Vertical discretization and pressure levels at half and mid levels:
@@ -496,5 +466,5 @@
       plev =ap+bp*psurf
       play = 0.5*(plev(1:llm)+plev(2:llm+1))
-      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
+      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles. 
 
       IF (forcing_type .eq. 59) THEN
@@ -527,8 +497,10 @@
       print*,'mxcalc=',mxcalc
 !     print*,'zlay=',zlay(mxcalc)
-      print*,'play=',play(mxcalc)
-
-!Al1 pour SST forced, appell?? depuis ocean_forced_noice
-      ts_cur = tsurf ! SST used in read_tsurf1d
+!      print*,'play=',play(mxcalc)
+
+!! When surface temperature is forced
+      tg= tsurf ! surface T used in read_tsurf1d
+
+
 !=====================================================================
 ! Initialisation de la physique : 
@@ -546,4 +518,6 @@
 ! airefi,zcufi,zcvfi initialises au debut de ce programme
 ! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
+
+
       day_step = float(nsplit_phys)*day_step/float(iphysiq)
       write (*,*) 'Time step divided by nsplit_phys (=',nsplit_phys,')'
@@ -563,4 +537,5 @@
      ! e.g. for cell boundaries, which are meaningless in 1D; so pad these 
      ! with '0.' when necessary
+
       call iniphysiq(iim,jjm,llm, &
            1,comm_lmdz, &
@@ -650,7 +625,4 @@
         zpic = zpicinp
         ftsol=tsurf
-        nsw=6 ! on met le nb de bandes SW=6, pour initialiser
-              ! 6 albedo, mais on peut quand meme tourner avec
-              ! moins. Seules les 2 ou 4 premiers seront lus
         falb_dir=albedo
         falb_dif=albedo
@@ -664,16 +636,9 @@
         prw_ancien = 0.
 !jyg<
-!!        pbl_tke(:,:,:)=1.e-8
-        pbl_tke(:,:,:)=0.
-        pbl_tke(:,2,:)=1.e-2
-        PRINT *, ' pbl_tke dans lmdz1d '
-        if (prt_level .ge. 5) then 
-         DO nsrf = 1,4
-           PRINT *,'pbl_tke(1,:,',nsrf,') ',pbl_tke(1,:,nsrf)
-         ENDDO
-        end if
-
+! Etienne: comment those lines since now the TKE is inialized in 1D_read_forc_cases
+!!      pbl_tke(:,:,:)=1.e-8
+!        pbl_tke(:,:,:)=0.
+!        pbl_tke(:,2,:)=1.e-2
 !>jyg
-
         rain_fall=0.
         snow_fall=0.
@@ -715,8 +680,8 @@
         v_ancien(1,:)=v(:)
  
-u10m=0.
-v10m=0.
-ale_wake=0.
-ale_bl_stat=0.
+        u10m=0.
+        v10m=0.
+        ale_wake=0.
+        ale_bl_stat=0.
 
 !------------------------------------------------------------------------
@@ -738,5 +703,5 @@
 ! to be set at some arbitratry convenient values.
 !------------------------------------------------------------------------
-!Al1 =============== restart option ==========================
+!Al1 =============== restart option ======================================
         if (.not.restart) then
           iflag_pbl = 5
@@ -803,5 +768,5 @@
        print*,'plev,play,phi,phis,presnivs,u,v,temp,q,omega2'
        print*,'temp(1),q(1,1),u(1),v(1),plev(1),phis :'
-       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis
+       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis(1)
 ! raz for safety
        do l=1,llm
@@ -809,5 +774,5 @@
        enddo
       endif
-!Al1 ================  end restart =================================
+!======================  end restart =================================
       IF (ecrit_slab_oc.eq.1) then
          open(97,file='div_slab.dat',STATUS='UNKNOWN')
@@ -820,9 +785,10 @@
        CALL iophys_ini
 #endif
+
+!=====================================================================
 ! START OF THE TEMPORAL LOOP :
 !=====================================================================
            
       it_end = nint(fnday*day_step)
-!test JLD     it_end = 10
       do while(it.le.it_end)
 
@@ -832,5 +798,4 @@
          print*,'PAS DE TEMPS ',timestep
        endif
-!Al1 demande de restartphy.nc
        if (it.eq.it_end) lastcall=.True.
 
@@ -844,10 +809,13 @@
 !  Geopotential :
 !---------------------------------------------------------------------
-
+!        phis(1)=zsurf*RG
+!        phi(1)=phis(1)+RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
         phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
+
         do l = 1, llm-1
           phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*                           &
      &    (play(l)-play(l+1))/(play(l)+play(l+1))
         enddo
+
 
 !---------------------------------------------------------------------
@@ -950,6 +918,5 @@
        sfdt = sin(0.5*fcoriolis*timestep)
        cfdt = cos(0.5*fcoriolis*timestep)
-!       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
-!
+
         d_u_age(1:mxcalc)= -2.*sfdt/timestep*                                &
      &          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -                          &
@@ -1030,17 +997,15 @@
         temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
      &              dt_phys(1:mxcalc)                                       &
-     &             +d_t_adv(1:mxcalc)                                      &
-     &             +d_t_nudge(1:mxcalc)                                      &
+     &             +d_t_adv(1:mxcalc)                                       &
+     &             +d_t_nudge(1:mxcalc)                                     &
      &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
 
 
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!=======================================================================
 !! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!     endif  ! forcing_sandu or forcing_astex
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!=======================================================================
 
         teta=temp*(pzero/play)**rkappa
-!
+
 !---------------------------------------------------------------------
 !   Nudge soil temperature if requested
@@ -1080,7 +1045,5 @@
 
 !  incremente day time
-!        print*,'daytime bef',daytime,1./day_step
         daytime = daytime+1./day_step
-!Al1dbg
         day = int(daytime+0.1/day_step)
 !        time = max(daytime-day,0.0)
@@ -1088,14 +1051,12 @@
 !cc        time = real(mod(it,day_step))/day_step
         time = time_ini/24.+real(mod(it,day_step))/day_step
-!        print*,'daytime nxt time',daytime,time
         it=it+1
 
       enddo
 
-!Al1
       if (ecrit_slab_oc.ne.-1) close(97)
 
 !Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
-! -------------------------------------
+! ---------------------------------------------------------------------------
        call dyn1dredem("restart1dyn.nc",                                    &
      &              plev,play,phi,phis,presnivs,                            &
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/fisrtilp.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/fisrtilp.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/fisrtilp.F90	(revision 3851)
@@ -817,5 +817,5 @@
                  ! Variables calculees: 
                  ! rneb : nebulosite
-                 ! zqn : eau condensee, dans le nuage (in cloud water content)
+                 ! zqn : eau totale dans le nuage (in cloud total water content)
                  ! zcond: eau condensee en moyenne dans la maille
                  ! rhcl: humidite relative ciel-clair
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/flux_arp.h
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/flux_arp.h	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/flux_arp.h	(revision 3851)
@@ -1,17 +1,23 @@
 !
 ! $Id: flux_arp.h 2010-08-04 17:02:56Z lahellec $
+! Modif EV, 10/2020
 !
       logical :: ok_flux_surf
       logical :: ok_prescr_ust !for prescribed ustar
+      logical :: ok_prescr_beta
+      logical :: ok_forc_tsurf
+
+
       real :: fsens
       real :: flat
+      real :: betaevap
       real :: ust
       real :: tg
 
-      common /flux_arp/fsens,flat,ust,tg,ok_flux_surf,ok_prescr_ust
+      common /flux_arp/fsens,flat,ust,tg,ok_flux_surf,ok_prescr_ust,ok_prescr_beta,betaevap,ok_forc_tsurf
 
 !$OMP THREADPRIVATE(/flux_arp/)
 
 
+      
 
-
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/hbtm.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/hbtm.F90	(revision 3725)
+++ 	(revision )
@@ -1,758 +1,0 @@
-
-! $Header$
-
-
-SUBROUTINE hbtm(knon, paprs, pplay, t2m, t10m, q2m, q10m, ustar, wstar, &
-    flux_t, flux_q, u, v, t, q, pblh, cape, eauliq, ctei, pblt, therm, trmb1, &
-    trmb2, trmb3, plcl)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! ***************************************************************
-  ! *                                                             *
-  ! * HBTM2   D'apres Holstag&Boville et Troen&Mahrt              *
-  ! *                 JAS 47              BLM                     *
-  ! * Algorithme These Anne Mathieu                               *
-  ! * Critere d'Entrainement Peter Duynkerke (JAS 50)             *
-  ! * written by  : Anne MATHIEU & Alain LAHELLEC, 22/11/99       *
-  ! * features : implem. exces Mathieu                            *
-  ! ***************************************************************
-  ! * mods : decembre 99 passage th a niveau plus bas. voir fixer *
-  ! * la prise du th a z/Lambda = -.2 (max Ray)                   *
-  ! * Autre algo : entrainement ~ Theta+v =cste mais comment=>The?*
-  ! * on peut fixer q a .7qsat(cf non adiab)=>T2 et The2          *
-  ! * voir aussi //KE pblh = niveau The_e ou l = env.             *
-  ! ***************************************************************
-  ! * fin therm a la HBTM passage a forme Mathieu 12/09/2001      *
-  ! ***************************************************************
-  ! *
-
-
-  ! AM Fev 2003
-  ! Adaptation a LMDZ version couplee
-
-  ! Pour le moment on fait passer en argument les grdeurs de surface :
-  ! flux, t,q2m, t,q10m, on va utiliser systematiquement les grdeurs a 2m ms
-  ! on garde la possibilite de changer si besoin est (jusqu'a present la
-  ! forme de HB avec le 1er niveau modele etait conservee)
-
-
-
-
-
-  include "YOMCST.h"
-  REAL rlvcp, reps
-  ! Arguments:
-
-  INTEGER knon ! nombre de points a calculer
-  ! AM
-  REAL t2m(klon), t10m(klon) ! temperature a 2 et 10m
-  REAL q2m(klon), q10m(klon) ! q a 2 et 10m
-  REAL ustar(klon)
-  REAL wstar(klon) ! w*, convective velocity scale
-  REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
-  REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
-  REAL flux_t(klon, klev), flux_q(klon, klev) ! Flux
-  REAL u(klon, klev) ! vitesse U (m/s)
-  REAL v(klon, klev) ! vitesse V (m/s)
-  REAL t(klon, klev) ! temperature (K)
-  REAL q(klon, klev) ! vapeur d'eau (kg/kg)
-  ! AM      REAL cd_h(klon) ! coefficient de friction au sol pour chaleur
-  ! AM      REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
-
-  INTEGER isommet
-  ! um      PARAMETER (isommet=klev) ! limite max sommet pbl
-  REAL, PARAMETER :: vk = 0.35 ! Von Karman => passer a .41 ! cf U.Olgstrom
-  REAL, PARAMETER :: ricr = 0.4
-  REAL, PARAMETER :: fak = 8.5 ! b calcul du Prandtl et de dTetas
-  REAL, PARAMETER :: fakn = 7.2 ! a
-  REAL, PARAMETER :: onet = 1.0/3.0
-  REAL, PARAMETER :: t_coup = 273.15
-  REAL, PARAMETER :: zkmin = 0.01
-  REAL, PARAMETER :: betam = 15.0 ! pour Phim / h dans la S.L stable
-  REAL, PARAMETER :: betah = 15.0
-  REAL, PARAMETER :: betas = 5.0 ! Phit dans la S.L. stable (mais 2 formes / z/OBL<>1
-  REAL, PARAMETER :: sffrac = 0.1 ! S.L. = z/h < .1
-  REAL, PARAMETER :: usmin = 1.E-12
-  REAL, PARAMETER :: binm = betam*sffrac
-  REAL, PARAMETER :: binh = betah*sffrac
-  REAL, PARAMETER :: ccon = fak*sffrac*vk
-  REAL, PARAMETER :: b1 = 70., b2 = 20.
-  REAL, PARAMETER :: zref = 2. ! Niveau de ref a 2m peut eventuellement
-  ! etre choisi a 10m
-  REAL q_star, t_star
-  REAL b212, b2sr ! Lambert correlations T' q' avec T* q*
-
-  REAL z(klon, klev)
-  ! AM      REAL pcfm(klon,klev), pcfh(klon,klev)
-  INTEGER i, k, j
-  REAL zxt
-  ! AM      REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
-  ! AM      REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
-  REAL khfs(klon) ! surface kinematic heat flux [mK/s]
-  REAL kqfs(klon) ! sfc kinematic constituent flux [m/s]
-  REAL heatv(klon) ! surface virtual heat flux
-  REAL rhino(klon, klev) ! bulk Richardon no. mais en Theta_v
-  LOGICAL unstbl(klon) ! pts w/unstbl pbl (positive virtual ht flx)
-  LOGICAL stblev(klon) ! stable pbl with levels within pbl
-  LOGICAL unslev(klon) ! unstbl pbl with levels within pbl
-  LOGICAL unssrf(klon) ! unstb pbl w/lvls within srf pbl lyr
-  LOGICAL unsout(klon) ! unstb pbl w/lvls in outer pbl lyr
-  LOGICAL check(klon) ! True=>chk if Richardson no.>critcal
-  LOGICAL omegafl(klon) ! flag de prolongerment cape pour pt Omega
-  REAL pblh(klon)
-  REAL pblt(klon)
-  REAL plcl(klon)
-  ! AM      REAL cgh(klon,2:klev) ! counter-gradient term for heat [K/m]
-  ! AM      REAL cgq(klon,2:klev) ! counter-gradient term for constituents
-  ! AM      REAL cgs(klon,2:klev) ! counter-gradient star (cg/flux)
-  REAL unsobklen(klon) ! Monin-Obukhov lengh
-  ! AM      REAL ztvd, ztvu,
-  REAL zdu2
-  REAL therm(klon) ! thermal virtual temperature excess
-  REAL trmb1(klon), trmb2(klon), trmb3(klon)
-  ! Algorithme thermique
-  REAL s(klon, klev) ! [P/Po]^Kappa milieux couches
-  REAL th_th(klon) ! potential temperature of thermal
-  REAL the_th(klon) ! equivalent potential temperature of thermal
-  REAL qt_th(klon) ! total water  of thermal
-  REAL tbef(klon) ! T thermique niveau precedent
-  REAL qsatbef(klon)
-  LOGICAL zsat(klon) ! le thermique est sature
-  REAL cape(klon) ! Cape du thermique
-  REAL kape(klon) ! Cape locale
-  REAL eauliq(klon) ! Eau liqu integr du thermique
-  REAL ctei(klon) ! Critere d'instab d'entrainmt des nuages de CL
-  REAL the1, the2, aa, bb, zthvd, zthvu, xintpos, qqsat
-  ! IM 091204 BEG
-  REAL a1, a2, a3
-  ! IM 091204 END
-  REAL xhis, rnum, denom, th1, th2, thv1, thv2, ql2
-  REAL dqsat_dt, qsat2, qt1, q2, t1, t2, xnull, delt_the
-  REAL delt_qt, delt_2, quadsat, spblh, reduc
-
-  REAL phiminv(klon) ! inverse phi function for momentum
-  REAL phihinv(klon) ! inverse phi function for heat
-  REAL wm(klon) ! turbulent velocity scale for momentum
-  REAL fak1(klon) ! k*ustar*pblh
-  REAL fak2(klon) ! k*wm*pblh
-  REAL fak3(klon) ! fakn*wstar/wm
-  REAL pblk(klon) ! level eddy diffusivity for momentum
-  REAL pr(klon) ! Prandtl number for eddy diffusivities
-  REAL zl(klon) ! zmzp / Obukhov length
-  REAL zh(klon) ! zmzp / pblh
-  REAL zzh(klon) ! (1-(zmzp/pblh))**2
-  REAL zm(klon) ! current level height
-  REAL zp(klon) ! current level height + one level up
-  REAL zcor, zdelta, zcvm5
-  ! AM      REAL zxqs
-  REAL fac, pblmin, zmzp, term
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-
-
-  ! initialisations (Anne)
-  isommet = klev
-  th_th(:) = 0.
-  q_star = 0
-  t_star = 0
-
-
-  b212 = sqrt(b1*b2)
-  b2sr = sqrt(b2)
-
-  ! ============================================================
-  ! Fonctions thermo implicites
-  ! ============================================================
-  ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! Tetens : pression partielle de vap d'eau e_sat(T)
-  ! =================================================
-  ! ++ e_sat(T) = r2*exp( r3*(T-Tf)/(T-r4) ) id a r2*FOEWE
-  ! ++ avec :
-  ! ++ Tf = 273.16 K  (Temp de fusion de la glace)
-  ! ++ r2 = 611.14 Pa
-  ! ++ r3 = 17.269 (liquide) 21.875 (solide) adim
-  ! ++ r4 = 35.86             7.66           Kelvin
-  ! ++  q_sat = eps*e_sat/(p-(1-eps)*e_sat)
-  ! ++ deriv� :
-  ! ++ =========
-  ! ++                   r3*(Tf-r4)*q_sat(T,p)
-  ! ++ d_qsat_dT = --------------------------------
-  ! ++             (T-r4)^2*( 1-(1-eps)*e_sat(T)/p )
-  ! ++ pour zcvm5=Lv, c'est FOEDE
-  ! ++ Rq :(1.-REPS)*esarg/Parg id a RETV*Qsat
-  ! ------------------------------------------------------------------
-
-  ! Initialisation
-  rlvcp = rlvtt/rcpd
-  reps = rd/rv
-
-
-  ! DO i = 1, klon
-  ! pcfh(i,1) = cd_h(i)
-  ! pcfm(i,1) = cd_m(i)
-  ! ENDDO
-  ! DO k = 2, klev
-  ! DO i = 1, klon
-  ! pcfh(i,k) = zkmin
-  ! pcfm(i,k) = zkmin
-  ! cgs(i,k) = 0.0
-  ! cgh(i,k) = 0.0
-  ! cgq(i,k) = 0.0
-  ! ENDDO
-  ! ENDDO
-
-  ! Calculer les hauteurs de chaque couche
-  ! (geopotentielle Int_dp/ro = Int_[Rd.T.dp/p] z = geop/g)
-  ! pourquoi ne pas utiliser Phi/RG ?
-  DO i = 1, knon
-    z(i, 1) = rd*t(i, 1)/(0.5*(paprs(i,1)+pplay(i,1)))*(paprs(i,1)-pplay(i,1) &
-      )/rg
-    s(i, 1) = (pplay(i,1)/paprs(i,1))**rkappa
-  END DO
-  ! s(k) = [pplay(k)/ps]^kappa
-  ! + + + + + + + + + pplay  <-> s(k)   t  dp=pplay(k-1)-pplay(k)
-
-  ! -----------------  paprs <-> sig(k)
-
-  ! + + + + + + + + + pplay  <-> s(k-1)
-
-
-  ! + + + + + + + + + pplay  <-> s(1)   t  dp=paprs-pplay   z(1)
-
-  ! -----------------  paprs <-> sig(1)
-
-  DO k = 2, klev
-    DO i = 1, knon
-      z(i, k) = z(i, k-1) + rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)*(pplay(i,k-1 &
-        )-pplay(i,k))/rg
-      s(i, k) = (pplay(i,k)/paprs(i,1))**rkappa
-    END DO
-  END DO
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! +++  Determination des grandeurs de surface  +++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  DO i = 1, knon
-    ! AM         IF (thermcep) THEN
-    ! AM           zdelta=MAX(0.,SIGN(1.,RTT-tsol(i)))
-    ! zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-    ! zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1))
-    ! AM           zxqs= r2es * FOEEW(tsol(i),zdelta)/paprs(i,1)
-    ! AM           zxqs=MIN(0.5,zxqs)
-    ! AM           zcor=1./(1.-retv*zxqs)
-    ! AM           zxqs=zxqs*zcor
-    ! AM         ELSE
-    ! AM           IF (tsol(i).LT.t_coup) THEN
-    ! AM              zxqs = qsats(tsol(i)) / paprs(i,1)
-    ! AM           ELSE
-    ! AM              zxqs = qsatl(tsol(i)) / paprs(i,1)
-    ! AM           ENDIF
-    ! AM         ENDIF
-    ! niveau de reference bulk; mais ici, c,a pourrait etre le niveau de ref
-    ! du thermique
-    ! AM        zx_alf1 = 1.0
-    ! AM        zx_alf2 = 1.0 - zx_alf1
-    ! AM        zxt = (t(i,1)+z(i,1)*RG/RCPD/(1.+RVTMP2*q(i,1)))
-    ! AM     .        *(1.+RETV*q(i,1))*zx_alf1
-    ! AM     .      + (t(i,2)+z(i,2)*RG/RCPD/(1.+RVTMP2*q(i,2)))
-    ! AM     .        *(1.+RETV*q(i,2))*zx_alf2
-    ! AM        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
-    ! AM        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
-    ! AM        zxq = q(i,1)*zx_alf1+q(i,2)*zx_alf2
-    ! AM
-    ! AMAM           zxu = u10m(i)
-    ! AMAM           zxv = v10m(i)
-    ! AMAM           zxmod = 1.0+SQRT(zxu**2+zxv**2)
-    ! AM Niveau de ref choisi a 2m
-    zxt = t2m(i)
-
-    ! ***************************************************
-    ! attention, il doit s'agir de <w'theta'>
-    ! ;Calcul de tcls virtuel et de w'theta'virtuel
-    ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    ! tcls=tcls*(1+.608*qcls)
-
-    ! ;Pour avoir w'theta',
-    ! ; il faut diviser par ro.Cp
-    ! Cp=Cpd*(1+0.84*qcls)
-    ! fcs=fcs/(ro_surf*Cp)
-    ! ;On transforme w'theta' en w'thetav'
-    ! Lv=(2.501-0.00237*(tcls-273.15))*1.E6
-    ! xle=xle/(ro_surf*Lv)
-    ! fcsv=fcs+.608*xle*tcls
-    ! ***************************************************
-    ! AM        khfs(i) = (tsol(i)*(1.+RETV*q(i,1))-zxt) *zxmod*cd_h(i)
-    ! AM        kqfs(i) = (zxqs-zxq) *zxmod*cd_h(i) * beta(i)
-    ! AM
-    ! dif khfs est deja w't'_v / heatv(i) = khfs(i) + RETV*zxt*kqfs(i)
-    ! AM calcule de Ro = paprs(i,1)/Rd zxt
-    ! AM convention >0 vers le bas ds lmdz
-    khfs(i) = -flux_t(i, 1)*zxt*rd/(rcpd*paprs(i,1))
-    kqfs(i) = -flux_q(i, 1)*zxt*rd/(paprs(i,1))
-    ! AM   verifier que khfs et kqfs sont bien de la forme w'l'
-    heatv(i) = khfs(i) + 0.608*zxt*kqfs(i)
-    ! a comparer aussi aux sorties de clqh : flux_T/RoCp et flux_q/RoLv
-    ! AM        heatv(i) = khfs(i)
-    ! AM ustar est en entree
-    ! AM        taux = zxu *zxmod*cd_m(i)
-    ! AM        tauy = zxv *zxmod*cd_m(i)
-    ! AM        ustar(i) = SQRT(taux**2+tauy**2)
-    ! AM        ustar(i) = MAX(SQRT(ustar(i)),0.01)
-    ! Theta et qT du thermique sans exces (interpolin vers surf)
-    ! chgt de niveau du thermique (jeudi 30/12/1999)
-    ! (interpolation lineaire avant integration phi_h)
-    ! AM        qT_th(i) = zxqs*beta(i) + 4./z(i,1)*(q(i,1)-zxqs*beta(i))
-    ! AM        qT_th(i) = max(qT_th(i),q(i,1))
-    qt_th(i) = q2m(i)
-    ! n The_th restera la Theta du thermique sans exces jusqu'a 2eme calcul
-    ! n reste a regler convention P) pour Theta
-    ! The_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
-    ! -                      + RLvCp*qT_th(i)
-    ! AM        Th_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
-    th_th(i) = t2m(i)
-  END DO
-
-  DO i = 1, knon
-    rhino(i, 1) = 0.0 ! Global Richardson
-    check(i) = .TRUE.
-    pblh(i) = z(i, 1) ! on initialise pblh a l'altitude du 1er niveau
-    plcl(i) = 6000.
-    ! Lambda = -u*^3 / (alpha.g.kvon.<w'Theta'v>
-    unsobklen(i) = -rg*vk*heatv(i)/(t(i,1)*max(ustar(i),usmin)**3)
-    trmb1(i) = 0.
-    trmb2(i) = 0.
-    trmb3(i) = 0.
-  END DO
-
-
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! PBL height calculation:
-  ! Search for level of pbl. Scan upward until the Richardson number between
-  ! the first level and the current level exceeds the "critical" value.
-  ! (bonne idee Nu de separer le Ric et l'exces de temp du thermique)
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  fac = 100.0
-  DO k = 2, isommet
-    DO i = 1, knon
-      IF (check(i)) THEN
-        ! pourquoi / niveau 1 (au lieu du sol) et le terme en u*^2 ?
-        ! test     zdu2 =
-        ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
-        zdu2 = u(i, k)**2 + v(i, k)**2
-        zdu2 = max(zdu2, 1.0E-20)
-        ! Theta_v environnement
-        zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
-
-        ! therm Theta_v sans exces (avec hypothese fausse de H&B, sinon,
-        ! passer par Theta_e et virpot)
-        ! zthvu=t(i,1)/s(i,1)*(1.+RETV*q(i,1))
-        ! AM         zthvu = Th_th(i)*(1.+RETV*q(i,1))
-        zthvu = th_th(i)*(1.+retv*qt_th(i))
-        ! Le Ri par Theta_v
-        ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
-        ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
-        ! AM On a nveau de ref a 2m ???
-        rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5*(zthvd+zthvu))
-
-        IF (rhino(i,k)>=ricr) THEN
-          pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))/(rhino( &
-            i,k-1)-rhino(i,k))
-          ! test04
-          pblh(i) = pblh(i) + 100.
-          pblt(i) = t(i, k-1) + (t(i,k)-t(i,k-1))*(pblh(i)-z(i,k-1))/(z(i,k)- &
-            z(i,k-1))
-          check(i) = .FALSE.
-        END IF
-      END IF
-    END DO
-  END DO
-
-
-  ! Set pbl height to maximum value where computation exceeds number of
-  ! layers allowed
-
-  DO i = 1, knon
-    IF (check(i)) pblh(i) = z(i, isommet)
-  END DO
-
-  ! Improve estimate of pbl height for the unstable points.
-  ! Find unstable points (sensible heat flux is upward):
-
-  DO i = 1, knon
-    IF (heatv(i)>0.) THEN
-      unstbl(i) = .TRUE.
-      check(i) = .TRUE.
-    ELSE
-      unstbl(i) = .FALSE.
-      check(i) = .FALSE.
-    END IF
-  END DO
-
-  ! For the unstable case, compute velocity scale and the
-  ! convective temperature excess:
-
-  DO i = 1, knon
-    IF (check(i)) THEN
-      phiminv(i) = (1.-binm*pblh(i)*unsobklen(i))**onet
-      ! ***************************************************
-      ! Wm ? et W* ? c'est la formule pour z/h < .1
-      ! ;Calcul de w* ;;
-      ! ;;;;;;;;;;;;;;;;
-      ! w_star=((g/tcls)*fcsv*z(ind))^(1/3.) [ou prendre la premiere approx
-      ! de h)
-      ! ;; CALCUL DE wm ;;
-      ! ;;;;;;;;;;;;;;;;;;
-      ! ; Ici on considerera que l'on est dans la couche de surf jusqu'a 100m
-      ! ; On prend svt couche de surface=0.1*h mais on ne connait pas h
-      ! ;;;;;;;;;;;Dans la couche de surface
-      ! if (z(ind) le 20) then begin
-      ! Phim=(1.-15.*(z(ind)/L))^(-1/3.)
-      ! wm=u_star/Phim
-      ! ;;;;;;;;;;;En dehors de la couche de surface
-      ! endif else if (z(ind) gt 20) then begin
-      ! wm=(u_star^3+c1*w_star^3)^(1/3.)
-      ! endif
-      ! ***************************************************
-      wm(i) = ustar(i)*phiminv(i)
-      ! ======================================================================
-      ! valeurs de Dominique Lambert de la campagne SEMAPHORE :
-      ! <T'^2> = 100.T*^2; <q'^2> = 20.q*^2 a 10m
-      ! <Tv'^2> = (1+1.2q).100.T* + 1.2Tv.sqrt(20*100).T*.q* +
-      ! (.608*Tv)^2*20.q*^2;
-      ! et dTetavS = sqrt(<Tv'^2>) ainsi calculee.
-      ! avec : T*=<w'T'>_s/w* et q*=<w'q'>/w*
-      ! !!! on peut donc utiliser w* pour les fluctuations <-> Lambert
-      ! (leur corellation pourrait dependre de beta par ex)
-      ! if fcsv(i,j) gt 0 then begin
-      ! dTetavs=b1*(1.+2.*.608*q_10(i,j))*(fcs(i,j)/wm(i,j))^2+$
-      ! (.608*Thetav_10(i,j))^2*b2*(xle(i,j)/wm(i,j))^2+$
-      ! 2.*.608*thetav_10(i,j)*sqrt(b1*b2)*(xle(i,j)/wm(i,j))*(fcs(i,j)/wm(i,j))
-      ! dqs=b2*(xle(i,j)/wm(i,j))^2
-      ! theta_s(i,j)=thetav_10(i,j)+sqrt(dTetavs)
-      ! q_s(i,j)=q_10(i,j)+sqrt(dqs)
-      ! endif else begin
-      ! Theta_s(i,j)=thetav_10(i,j)
-      ! q_s(i,j)=q_10(i,j)
-      ! endelse
-      ! ======================================================================
-
-      ! HBTM        therm(i) = heatv(i)*fak/wm(i)
-      ! forme Mathieu :
-      q_star = kqfs(i)/wm(i)
-      t_star = khfs(i)/wm(i)
-      ! IM 091204 BEG
-      IF (1==0) THEN
-        IF (t_star<0. .OR. q_star<0.) THEN
-          PRINT *, 'i t_star q_star khfs kqfs wm', i, t_star, q_star, &
-            khfs(i), kqfs(i), wm(i)
-        END IF
-      END IF
-      ! IM 091204 END
-      ! AM Nveau cde ref 2m =>
-      ! AM        therm(i) = sqrt( b1*(1.+2.*RETV*q(i,1))*t_star**2
-      ! AM     +             + (RETV*T(i,1))**2*b2*q_star**2
-      ! AM     +             + 2.*RETV*T(i,1)*b212*q_star*t_star
-      ! AM     +                 )
-      ! IM 091204 BEG
-      a1 = b1*(1.+2.*retv*qt_th(i))*t_star**2
-      a2 = (retv*th_th(i))**2*b2*q_star*q_star
-      a3 = 2.*retv*th_th(i)*b212*q_star*t_star
-      aa = a1 + a2 + a3
-      IF (1==0) THEN
-        IF (aa<0.) THEN
-          PRINT *, 'i a1 a2 a3 aa', i, a1, a2, a3, aa
-          PRINT *, 'i qT_th Th_th t_star q_star RETV b1 b2 b212', i, &
-            qt_th(i), th_th(i), t_star, q_star, retv, b1, b2, b212
-        END IF
-      END IF
-      ! IM 091204 END
-      therm(i) = sqrt(b1*(1.+2.*retv*qt_th(i))*t_star**2+(retv*th_th( &
-        i))**2*b2*q_star*q_star &  ! IM 101204  +             +
-                                   ! 2.*RETV*Th_th(i)*b212*q_star*t_star
-        +max(0.,2.*retv*th_th(i)*b212*q_star*t_star))
-
-      ! Theta et qT du thermique (forme H&B) avec exces
-      ! (attention, on ajoute therm(i) qui est virtuelle ...)
-      ! pourquoi pas sqrt(b1)*t_star ?
-      ! dqs = b2sr*kqfs(i)/wm(i)
-      qt_th(i) = qt_th(i) + b2sr*q_star
-      ! new on differre le calcul de Theta_e
-      ! The_th(i) = The_th(i) + therm(i) + RLvCp*qT_th(i)
-      ! ou:    The_th(i) = The_th(i) + sqrt(b1)*khfs(i)/wm(i) +
-      ! RLvCp*qT_th(i)
-      rhino(i, 1) = 0.0
-    END IF
-  END DO
-
-  ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! ++ Improve pblh estimate for unstable conditions using the +++++++
-  ! ++          convective temperature excess :                +++++++
-  ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-  DO k = 2, isommet
-    DO i = 1, knon
-      IF (check(i)) THEN
-        ! test     zdu2 =
-        ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
-        zdu2 = u(i, k)**2 + v(i, k)**2
-        zdu2 = max(zdu2, 1.0E-20)
-        ! Theta_v environnement
-        zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
-
-        ! et therm Theta_v (avec hypothese de constance de H&B,
-        ! zthvu=(t(i,1)+therm(i))/s(i,1)*(1.+RETV*q(i,1))
-        zthvu = th_th(i)*(1.+retv*qt_th(i)) + therm(i)
-
-
-        ! Le Ri par Theta_v
-        ! AM Niveau de ref 2m
-        ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
-        ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
-        rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5*(zthvd+zthvu))
-
-
-        IF (rhino(i,k)>=ricr) THEN
-          pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))/(rhino( &
-            i,k-1)-rhino(i,k))
-          ! test04
-          pblh(i) = pblh(i) + 100.
-          pblt(i) = t(i, k-1) + (t(i,k)-t(i,k-1))*(pblh(i)-z(i,k-1))/(z(i,k)- &
-            z(i,k-1))
-          check(i) = .FALSE.
-          ! IM 170305 BEG
-          IF (1==0) THEN
-            ! debug print -120;34       -34-        58 et    0;26 wamp
-            IF (i==950 .OR. i==192 .OR. i==624 .OR. i==118) THEN
-              PRINT *, ' i,Th_th,Therm,qT :', i, th_th(i), therm(i), qt_th(i)
-              q_star = kqfs(i)/wm(i)
-              t_star = khfs(i)/wm(i)
-              PRINT *, 'q* t*, b1,b2,b212 ', q_star, t_star, &
-                b1*(1.+2.*retv*qt_th(i))*t_star**2, &
-                (retv*th_th(i))**2*b2*q_star**2, 2.*retv*th_th(i)*b212*q_star &
-                *t_star
-              PRINT *, 'zdu2 ,100.*ustar(i)**2', zdu2, fac*ustar(i)**2
-            END IF
-          END IF !(1.EQ.0) THEN
-          ! IM 170305 END
-          ! q_star = kqfs(i)/wm(i)
-          ! t_star = khfs(i)/wm(i)
-          ! trmb1(i) = b1*(1.+2.*RETV*q(i,1))*t_star**2
-          ! trmb2(i) = (RETV*T(i,1))**2*b2*q_star**2
-          ! Omega now   trmb3(i) = 2.*RETV*T(i,1)*b212*q_star*t_star
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! Set pbl height to maximum value where computation exceeds number of
-  ! layers allowed
-
-  DO i = 1, knon
-    IF (check(i)) pblh(i) = z(i, isommet)
-  END DO
-
-  ! PBL height must be greater than some minimum mechanical mixing depth
-  ! Several investigators have proposed minimum mechanical mixing depth
-  ! relationships as a function of the local friction velocity, u*.  We
-  ! make use of a linear relationship of the form h = c u* where c=700.
-  ! The scaling arguments that give rise to this relationship most often
-  ! represent the coefficient c as some constant over the local coriolis
-  ! parameter.  Here we make use of the experimental results of Koracin
-  ! and Berkowicz (1988) [BLM, Vol 43] for wich they recommend 0.07/f
-  ! where f was evaluated at 39.5 N and 52 N.  Thus we use a typical mid
-  ! latitude value for f so that c = 0.07/f = 700.
-
-  DO i = 1, knon
-    pblmin = 700.0*ustar(i)
-    pblh(i) = max(pblh(i), pblmin)
-    ! par exemple :
-    pblt(i) = t(i, 2) + (t(i,3)-t(i,2))*(pblh(i)-z(i,2))/(z(i,3)-z(i,2))
-  END DO
-
-  ! ********************************************************************
-  ! pblh is now available; do preparation for diffusivity calculation :
-  ! ********************************************************************
-  DO i = 1, knon
-    check(i) = .TRUE.
-    zsat(i) = .FALSE.
-    ! omegafl utilise pour prolongement CAPE
-    omegafl(i) = .FALSE.
-    cape(i) = 0.
-    kape(i) = 0.
-    eauliq(i) = 0.
-    ctei(i) = 0.
-    pblk(i) = 0.0
-    fak1(i) = ustar(i)*pblh(i)*vk
-
-    ! Do additional preparation for unstable cases only, set temperature
-    ! and moisture perturbations depending on stability.
-    ! *** Rq: les formule sont prises dans leur forme CS ***
-    IF (unstbl(i)) THEN
-      ! AM Niveau de ref du thermique
-      ! AM          zxt=(t(i,1)-z(i,1)*0.5*RG/RCPD/(1.+RVTMP2*q(i,1)))
-      ! AM     .         *(1.+RETV*q(i,1))
-      zxt = (th_th(i)-zref*0.5*rg/rcpd/(1.+rvtmp2*qt_th(i)))* &
-        (1.+retv*qt_th(i))
-      phiminv(i) = (1.-binm*pblh(i)*unsobklen(i))**onet
-      phihinv(i) = sqrt(1.-binh*pblh(i)*unsobklen(i))
-      wm(i) = ustar(i)*phiminv(i)
-      fak2(i) = wm(i)*pblh(i)*vk
-      wstar(i) = (heatv(i)*rg*pblh(i)/zxt)**onet
-      fak3(i) = fakn*wstar(i)/wm(i)
-    ELSE
-      wstar(i) = 0.
-    END IF
-    ! Computes Theta_e for thermal (all cases : to be modified)
-    ! attention ajout therm(i) = virtuelle
-    the_th(i) = th_th(i) + therm(i) + rlvcp*qt_th(i)
-    ! ou:    The_th(i) = Th_th(i) + sqrt(b1)*khfs(i)/wm(i) + RLvCp*qT_th(i)
-  END DO
-
-  ! Main level loop to compute the diffusivities and
-  ! counter-gradient terms:
-
-  DO k = 2, isommet
-
-    ! Find levels within boundary layer:
-
-    DO i = 1, knon
-      unslev(i) = .FALSE.
-      stblev(i) = .FALSE.
-      zm(i) = z(i, k-1)
-      zp(i) = z(i, k)
-      IF (zkmin==0.0 .AND. zp(i)>pblh(i)) zp(i) = pblh(i)
-      IF (zm(i)<pblh(i)) THEN
-        zmzp = 0.5*(zm(i)+zp(i))
-        ! debug
-        ! if (i.EQ.1864) then
-        ! print*,'i,pblh(1864),obklen(1864)',i,pblh(i),obklen(i)
-        ! endif
-
-        zh(i) = zmzp/pblh(i)
-        zl(i) = zmzp*unsobklen(i)
-        zzh(i) = 0.
-        IF (zh(i)<=1.0) zzh(i) = (1.-zh(i))**2
-
-        ! stblev for points zm < plbh and stable and neutral
-        ! unslev for points zm < plbh and unstable
-
-        IF (unstbl(i)) THEN
-          unslev(i) = .TRUE.
-        ELSE
-          stblev(i) = .TRUE.
-        END IF
-      END IF
-    END DO
-    ! print*,'fin calcul niveaux'
-
-    ! Stable and neutral points; set diffusivities; counter-gradient
-    ! terms zero for stable case:
-
-    DO i = 1, knon
-      IF (stblev(i)) THEN
-        IF (zl(i)<=1.) THEN
-          pblk(i) = fak1(i)*zh(i)*zzh(i)/(1.+betas*zl(i))
-        ELSE
-          pblk(i) = fak1(i)*zh(i)*zzh(i)/(betas+zl(i))
-        END IF
-        ! pcfm(i,k) = pblk(i)
-        ! pcfh(i,k) = pcfm(i,k)
-      END IF
-    END DO
-
-    ! unssrf, unstable within surface layer of pbl
-    ! unsout, unstable within outer   layer of pbl
-
-    DO i = 1, knon
-      unssrf(i) = .FALSE.
-      unsout(i) = .FALSE.
-      IF (unslev(i)) THEN
-        IF (zh(i)<sffrac) THEN
-          unssrf(i) = .TRUE.
-        ELSE
-          unsout(i) = .TRUE.
-        END IF
-      END IF
-    END DO
-
-    ! Unstable for surface layer; counter-gradient terms zero
-
-    DO i = 1, knon
-      IF (unssrf(i)) THEN
-        term = (1.-betam*zl(i))**onet
-        pblk(i) = fak1(i)*zh(i)*zzh(i)*term
-        pr(i) = term/sqrt(1.-betah*zl(i))
-      END IF
-    END DO
-    ! print*,'fin counter-gradient terms zero'
-
-    ! Unstable for outer layer; counter-gradient terms non-zero:
-
-    DO i = 1, knon
-      IF (unsout(i)) THEN
-        pblk(i) = fak2(i)*zh(i)*zzh(i)
-        ! cgs(i,k) = fak3(i)/(pblh(i)*wm(i))
-        ! cgh(i,k) = khfs(i)*cgs(i,k)
-        pr(i) = phiminv(i)/phihinv(i) + ccon*fak3(i)/fak
-        ! cgq(i,k) = kqfs(i)*cgs(i,k)
-      END IF
-    END DO
-    ! print*,'fin counter-gradient terms non zero'
-
-    ! For all unstable layers, compute diffusivities and ctrgrad ter m
-
-    ! DO i = 1, knon
-    ! IF (unslev(i)) THEN
-    ! pcfm(i,k) = pblk(i)
-    ! pcfh(i,k) = pblk(i)/pr(i)
-    ! etc cf original
-    ! ENDIF
-    ! ENDDO
-
-    ! For all layers, compute integral info and CTEI
-
-    DO i = 1, knon
-      IF (check(i) .OR. omegafl(i)) THEN
-        IF (.NOT. zsat(i)) THEN
-          ! Th2 = The_th(i) - RLvCp*qT_th(i)
-          th2 = th_th(i)
-          t2 = th2*s(i, k)
-          ! thermodyn functions
-          zdelta = max(0., sign(1.,rtt-t2))
-          qqsat = r2es*foeew(t2, zdelta)/pplay(i, k)
-          qqsat = min(0.5, qqsat)
-          zcor = 1./(1.-retv*qqsat)
-          qqsat = qqsat*zcor
-
-          IF (qqsat<qt_th(i)) THEN
-            ! on calcule lcl
-            IF (k==2) THEN
-              plcl(i) = z(i, k)
-            ELSE
-              plcl(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(qt_th(i)-qsatbef(i))/( &
-                qsatbef(i)-qqsat)
-            END IF
-            zsat(i) = .TRUE.
-            tbef(i) = t2
-          END IF
-
-          qsatbef(i) = qqsat ! bug dans la version orig ???
-        END IF
-        ! amn ???? cette ligne a deja ete faite normalement ?
-      END IF
-      ! print*,'hbtm2 i,k=',i,k
-    END DO
-  END DO ! end of level loop
-  ! IM 170305 BEG
-  IF (1==0) THEN
-    PRINT *, 'hbtm2  ok'
-  END IF !(1.EQ.0) THEN
-  ! IM 170305 END
-  RETURN
-END SUBROUTINE hbtm
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/hbtm_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/hbtm_mod.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/hbtm_mod.F90	(revision 3851)
@@ -0,0 +1,769 @@
+module hbtm_mod
+
+  IMPLICIT NONE
+
+contains
+
+  SUBROUTINE hbtm(knon, paprs, pplay, t2m, t10m, q2m, q10m, ustar, wstar, &
+       flux_t, flux_q, u, v, t, q, pblh, cape, eauliq, ctei, pblt, therm, &
+       trmb1, trmb2, trmb3, plcl)
+    USE dimphy
+
+    ! ***************************************************************
+    ! *                                                             *
+    ! * HBTM2   D'apres Holstag&Boville et Troen&Mahrt              *
+    ! *                 JAS 47              BLM                     *
+    ! * Algorithme These Anne Mathieu                               *
+    ! * Critere d'Entrainement Peter Duynkerke (JAS 50)             *
+    ! * written by  : Anne MATHIEU & Alain LAHELLEC, 22/11/99       *
+    ! * features : implem. exces Mathieu                            *
+    ! ***************************************************************
+    ! * mods : decembre 99 passage th a niveau plus bas. voir fixer *
+    ! * la prise du th a z/Lambda = -.2 (max Ray)                   *
+    ! * Autre algo : entrainement ~ Theta+v =cste mais comment=>The?*
+    ! * on peut fixer q a .7qsat(cf non adiab)=>T2 et The2          *
+    ! * voir aussi //KE pblh = niveau The_e ou l = env.             *
+    ! ***************************************************************
+    ! * fin therm a la HBTM passage a forme Mathieu 12/09/2001      *
+    ! ***************************************************************
+    ! *
+
+
+    ! AM Fev 2003
+    ! Adaptation a LMDZ version couplee
+
+    ! Pour le moment on fait passer en argument les grdeurs de surface :
+    ! flux, t,q2m, t,q10m, on va utiliser systematiquement les grdeurs a 2m ms
+    ! on garde la possibilite de changer si besoin est (jusqu'a present la
+    ! forme de HB avec le 1er niveau modele etait conservee)
+
+
+
+
+
+    include "YOMCST.h"
+    REAL rlvcp, reps
+    ! Arguments:
+
+    INTEGER knon ! nombre de points a calculer
+    ! AM
+    REAL t2m(klon), t10m(klon) ! temperature a 2 et 10m
+    REAL q2m(klon), q10m(klon) ! q a 2 et 10m
+    REAL ustar(klon)
+    REAL wstar(klon) ! w*, convective velocity scale
+    REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
+    REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
+    REAL flux_t(klon, klev), flux_q(klon, klev) ! Flux
+    REAL u(klon, klev) ! vitesse U (m/s)
+    REAL v(klon, klev) ! vitesse V (m/s)
+    REAL t(klon, klev) ! temperature (K)
+    REAL q(klon, klev) ! vapeur d'eau (kg/kg)
+    ! AM      REAL cd_h(klon) ! coefficient de friction au sol pour chaleur
+    ! AM      REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
+
+    INTEGER isommet
+    ! um      PARAMETER (isommet=klev) ! limite max sommet pbl
+    REAL, PARAMETER :: vk = 0.35 ! Von Karman => passer a .41 ! cf U.Olgstrom
+    REAL, PARAMETER :: ricr = 0.4
+    REAL, PARAMETER :: fak = 8.5 ! b calcul du Prandtl et de dTetas
+    REAL, PARAMETER :: fakn = 7.2 ! a
+    REAL, PARAMETER :: onet = 1.0/3.0
+    REAL, PARAMETER :: t_coup = 273.15
+    REAL, PARAMETER :: zkmin = 0.01
+    REAL, PARAMETER :: betam = 15.0 ! pour Phim / h dans la S.L stable
+    REAL, PARAMETER :: betah = 15.0
+
+    REAL, PARAMETER :: betas = 5.0
+    ! Phit dans la S.L. stable (mais 2 formes / z/OBL<>1
+
+    REAL, PARAMETER :: sffrac = 0.1 ! S.L. = z/h < .1
+    REAL, PARAMETER :: usmin = 1.E-12
+    REAL, PARAMETER :: binm = betam*sffrac
+    REAL, PARAMETER :: binh = betah*sffrac
+    REAL, PARAMETER :: ccon = fak*sffrac*vk
+    REAL, PARAMETER :: b1 = 70., b2 = 20.
+    REAL, PARAMETER :: zref = 2. ! Niveau de ref a 2m peut eventuellement
+    ! etre choisi a 10m
+    REAL q_star, t_star
+    REAL b212, b2sr ! Lambert correlations T' q' avec T* q*
+
+    REAL z(klon, klev)
+    ! AM      REAL pcfm(klon,klev), pcfh(klon,klev)
+    INTEGER i, k, j
+    REAL zxt
+    ! AM      REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
+    ! AM      REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
+    REAL khfs(klon) ! surface kinematic heat flux [mK/s]
+    REAL kqfs(klon) ! sfc kinematic constituent flux [m/s]
+    REAL heatv(klon) ! surface virtual heat flux
+    REAL rhino(klon, klev) ! bulk Richardon no. mais en Theta_v
+    LOGICAL unstbl(klon) ! pts w/unstbl pbl (positive virtual ht flx)
+    LOGICAL stblev(klon) ! stable pbl with levels within pbl
+    LOGICAL unslev(klon) ! unstbl pbl with levels within pbl
+    LOGICAL unssrf(klon) ! unstb pbl w/lvls within srf pbl lyr
+    LOGICAL unsout(klon) ! unstb pbl w/lvls in outer pbl lyr
+    LOGICAL check(klon) ! True=>chk if Richardson no.>critcal
+    LOGICAL omegafl(klon) ! flag de prolongerment cape pour pt Omega
+    REAL pblh(klon)
+    REAL pblt(klon)
+    REAL plcl(klon)
+    ! AM      REAL cgh(klon,2:klev) ! counter-gradient term for heat [K/m]
+    ! AM      REAL cgq(klon,2:klev) ! counter-gradient term for constituents
+    ! AM      REAL cgs(klon,2:klev) ! counter-gradient star (cg/flux)
+    REAL unsobklen(klon) ! Monin-Obukhov lengh
+    ! AM      REAL ztvd, ztvu,
+    REAL zdu2
+    REAL, intent(out):: therm(:) ! (klon) thermal virtual temperature excess
+    REAL trmb1(klon), trmb2(klon), trmb3(klon)
+    ! Algorithme thermique
+    REAL s(klon, klev) ! [P/Po]^Kappa milieux couches
+    REAL th_th(klon) ! potential temperature of thermal
+    REAL the_th(klon) ! equivalent potential temperature of thermal
+    REAL qt_th(klon) ! total water  of thermal
+    REAL tbef(klon) ! T thermique niveau precedent
+    REAL qsatbef(klon)
+    LOGICAL zsat(klon) ! le thermique est sature
+    REAL cape(klon) ! Cape du thermique
+    REAL kape(klon) ! Cape locale
+    REAL eauliq(klon) ! Eau liqu integr du thermique
+    REAL ctei(klon) ! Critere d'instab d'entrainmt des nuages de CL
+    REAL the1, the2, aa, bb, zthvd, zthvu, xintpos, qqsat
+    ! IM 091204 BEG
+    REAL a1, a2, a3
+    ! IM 091204 END
+    REAL xhis, rnum, denom, th1, th2, thv1, thv2, ql2
+    REAL dqsat_dt, qsat2, qt1, q2, t1, t2, xnull, delt_the
+    REAL delt_qt, delt_2, quadsat, spblh, reduc
+
+    REAL phiminv(klon) ! inverse phi function for momentum
+    REAL phihinv(klon) ! inverse phi function for heat
+    REAL wm(klon) ! turbulent velocity scale for momentum
+    REAL fak1(klon) ! k*ustar*pblh
+    REAL fak2(klon) ! k*wm*pblh
+    REAL fak3(klon) ! fakn*wstar/wm
+    REAL pblk(klon) ! level eddy diffusivity for momentum
+    REAL pr(klon) ! Prandtl number for eddy diffusivities
+    REAL zl(klon) ! zmzp / Obukhov length
+    REAL zh(klon) ! zmzp / pblh
+    REAL zzh(klon) ! (1-(zmzp/pblh))**2
+    REAL zm(klon) ! current level height
+    REAL zp(klon) ! current level height + one level up
+    REAL zcor, zdelta, zcvm5
+    ! AM      REAL zxqs
+    REAL fac, pblmin, zmzp, term
+
+    include "YOETHF.h"
+    include "FCTTRE.h"
+
+
+
+    ! initialisations (Anne)
+    isommet = klev
+    th_th(:) = 0.
+    q_star = 0
+    t_star = 0
+    therm = 0.
+
+    b212 = sqrt(b1*b2)
+    b2sr = sqrt(b2)
+
+    ! ============================================================
+    ! Fonctions thermo implicites
+    ! ============================================================
+    ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! Tetens : pression partielle de vap d'eau e_sat(T)
+    ! =================================================
+    ! ++ e_sat(T) = r2*exp( r3*(T-Tf)/(T-r4) ) id a r2*FOEWE
+    ! ++ avec :
+    ! ++ Tf = 273.16 K  (Temp de fusion de la glace)
+    ! ++ r2 = 611.14 Pa
+    ! ++ r3 = 17.269 (liquide) 21.875 (solide) adim
+    ! ++ r4 = 35.86             7.66           Kelvin
+    ! ++  q_sat = eps*e_sat/(p-(1-eps)*e_sat)
+    ! ++ deriv� :
+    ! ++ =========
+    ! ++                   r3*(Tf-r4)*q_sat(T,p)
+    ! ++ d_qsat_dT = --------------------------------
+    ! ++             (T-r4)^2*( 1-(1-eps)*e_sat(T)/p )
+    ! ++ pour zcvm5=Lv, c'est FOEDE
+    ! ++ Rq :(1.-REPS)*esarg/Parg id a RETV*Qsat
+    ! ------------------------------------------------------------------
+
+    ! Initialisation
+    rlvcp = rlvtt/rcpd
+    reps = rd/rv
+
+
+    ! DO i = 1, klon
+    ! pcfh(i,1) = cd_h(i)
+    ! pcfm(i,1) = cd_m(i)
+    ! ENDDO
+    ! DO k = 2, klev
+    ! DO i = 1, klon
+    ! pcfh(i,k) = zkmin
+    ! pcfm(i,k) = zkmin
+    ! cgs(i,k) = 0.0
+    ! cgh(i,k) = 0.0
+    ! cgq(i,k) = 0.0
+    ! ENDDO
+    ! ENDDO
+
+    ! Calculer les hauteurs de chaque couche
+    ! (geopotentielle Int_dp/ro = Int_[Rd.T.dp/p] z = geop/g)
+    ! pourquoi ne pas utiliser Phi/RG ?
+    DO i = 1, knon
+       z(i, 1) = rd*t(i, 1)/(0.5*(paprs(i,1)+pplay(i,1)))&
+            *(paprs(i,1)-pplay(i,1))/rg
+       s(i, 1) = (pplay(i,1)/paprs(i,1))**rkappa
+    END DO
+    ! s(k) = [pplay(k)/ps]^kappa
+    ! + + + + + + + + + pplay  <-> s(k)   t  dp=pplay(k-1)-pplay(k)
+
+    ! -----------------  paprs <-> sig(k)
+
+    ! + + + + + + + + + pplay  <-> s(k-1)
+
+
+    ! + + + + + + + + + pplay  <-> s(1)   t  dp=paprs-pplay   z(1)
+
+    ! -----------------  paprs <-> sig(1)
+
+    DO k = 2, klev
+       DO i = 1, knon
+          z(i, k) = z(i, k-1) + rd*0.5*(t(i,k-1)+t(i,k))/paprs(i, k)&
+               *(pplay(i,k-1)-pplay(i,k))/rg
+          s(i, k) = (pplay(i,k)/paprs(i,1))**rkappa
+       END DO
+    END DO
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! +++  Determination des grandeurs de surface  +++++++++++++++++++++
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    DO i = 1, knon
+       ! AM         IF (thermcep) THEN
+       ! AM           zdelta=MAX(0.,SIGN(1.,RTT-tsol(i)))
+       ! zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
+       ! zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1))
+       ! AM           zxqs= r2es * FOEEW(tsol(i),zdelta)/paprs(i,1)
+       ! AM           zxqs=MIN(0.5,zxqs)
+       ! AM           zcor=1./(1.-retv*zxqs)
+       ! AM           zxqs=zxqs*zcor
+       ! AM         ELSE
+       ! AM           IF (tsol(i).LT.t_coup) THEN
+       ! AM              zxqs = qsats(tsol(i)) / paprs(i,1)
+       ! AM           ELSE
+       ! AM              zxqs = qsatl(tsol(i)) / paprs(i,1)
+       ! AM           ENDIF
+       ! AM         ENDIF
+       ! niveau de reference bulk; mais ici, c,a pourrait etre le niveau de ref
+       ! du thermique
+       ! AM        zx_alf1 = 1.0
+       ! AM        zx_alf2 = 1.0 - zx_alf1
+       ! AM        zxt = (t(i,1)+z(i,1)*RG/RCPD/(1.+RVTMP2*q(i,1)))
+       ! AM     .        *(1.+RETV*q(i,1))*zx_alf1
+       ! AM     .      + (t(i,2)+z(i,2)*RG/RCPD/(1.+RVTMP2*q(i,2)))
+       ! AM     .        *(1.+RETV*q(i,2))*zx_alf2
+       ! AM        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
+       ! AM        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
+       ! AM        zxq = q(i,1)*zx_alf1+q(i,2)*zx_alf2
+       ! AM
+       ! AMAM           zxu = u10m(i)
+       ! AMAM           zxv = v10m(i)
+       ! AMAM           zxmod = 1.0+SQRT(zxu**2+zxv**2)
+       ! AM Niveau de ref choisi a 2m
+       zxt = t2m(i)
+
+       ! ***************************************************
+       ! attention, il doit s'agir de <w'theta'>
+       ! ;Calcul de tcls virtuel et de w'theta'virtuel
+       ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+       ! tcls=tcls*(1+.608*qcls)
+
+       ! ;Pour avoir w'theta',
+       ! ; il faut diviser par ro.Cp
+       ! Cp=Cpd*(1+0.84*qcls)
+       ! fcs=fcs/(ro_surf*Cp)
+       ! ;On transforme w'theta' en w'thetav'
+       ! Lv=(2.501-0.00237*(tcls-273.15))*1.E6
+       ! xle=xle/(ro_surf*Lv)
+       ! fcsv=fcs+.608*xle*tcls
+       ! ***************************************************
+       ! AM        khfs(i) = (tsol(i)*(1.+RETV*q(i,1))-zxt) *zxmod*cd_h(i)
+       ! AM        kqfs(i) = (zxqs-zxq) *zxmod*cd_h(i) * beta(i)
+       ! AM
+       ! dif khfs est deja w't'_v / heatv(i) = khfs(i) + RETV*zxt*kqfs(i)
+       ! AM calcule de Ro = paprs(i,1)/Rd zxt
+       ! AM convention >0 vers le bas ds lmdz
+       khfs(i) = -flux_t(i, 1)*zxt*rd/(rcpd*paprs(i,1))
+       kqfs(i) = -flux_q(i, 1)*zxt*rd/(paprs(i,1))
+       ! AM   verifier que khfs et kqfs sont bien de la forme w'l'
+       heatv(i) = khfs(i) + 0.608*zxt*kqfs(i)
+       ! a comparer aussi aux sorties de clqh : flux_T/RoCp et flux_q/RoLv
+       ! AM        heatv(i) = khfs(i)
+       ! AM ustar est en entree
+       ! AM        taux = zxu *zxmod*cd_m(i)
+       ! AM        tauy = zxv *zxmod*cd_m(i)
+       ! AM        ustar(i) = SQRT(taux**2+tauy**2)
+       ! AM        ustar(i) = MAX(SQRT(ustar(i)),0.01)
+       ! Theta et qT du thermique sans exces (interpolin vers surf)
+       ! chgt de niveau du thermique (jeudi 30/12/1999)
+       ! (interpolation lineaire avant integration phi_h)
+       ! AM        qT_th(i) = zxqs*beta(i) + 4./z(i,1)*(q(i,1)-zxqs*beta(i))
+       ! AM        qT_th(i) = max(qT_th(i),q(i,1))
+       qt_th(i) = q2m(i)
+       ! n The_th restera la Theta du thermique sans exces jusqu'a 2eme calcul
+       ! n reste a regler convention P) pour Theta
+       ! The_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
+       ! -                      + RLvCp*qT_th(i)
+       ! AM        Th_th(i) = tsol(i) + 4./z(i,1)*(t(i,1)-tsol(i))
+       th_th(i) = t2m(i)
+    END DO
+
+    DO i = 1, knon
+       rhino(i, 1) = 0.0 ! Global Richardson
+       check(i) = .TRUE.
+       pblh(i) = z(i, 1) ! on initialise pblh a l'altitude du 1er niveau
+       plcl(i) = 6000.
+       ! Lambda = -u*^3 / (alpha.g.kvon.<w'Theta'v>
+       unsobklen(i) = -rg*vk*heatv(i)/(t(i,1)*max(ustar(i),usmin)**3)
+       trmb1(i) = 0.
+       trmb2(i) = 0.
+       trmb3(i) = 0.
+    END DO
+
+
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! PBL height calculation:
+    ! Search for level of pbl. Scan upward until the Richardson number between
+    ! the first level and the current level exceeds the "critical" value.
+    ! (bonne idee Nu de separer le Ric et l'exces de temp du thermique)
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    fac = 100.0
+    DO k = 2, isommet
+       DO i = 1, knon
+          IF (check(i)) THEN
+             ! pourquoi / niveau 1 (au lieu du sol) et le terme en u*^2 ?
+             ! test     zdu2 =
+             ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
+             zdu2 = u(i, k)**2 + v(i, k)**2
+             zdu2 = max(zdu2, 1.0E-20)
+             ! Theta_v environnement
+             zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
+
+             ! therm Theta_v sans exces (avec hypothese fausse de H&B, sinon,
+             ! passer par Theta_e et virpot)
+             ! zthvu=t(i,1)/s(i,1)*(1.+RETV*q(i,1))
+             ! AM         zthvu = Th_th(i)*(1.+RETV*q(i,1))
+             zthvu = th_th(i)*(1.+retv*qt_th(i))
+             ! Le Ri par Theta_v
+             ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
+             ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
+             ! AM On a nveau de ref a 2m ???
+             rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5&
+                  *(zthvd+zthvu))
+
+             IF (rhino(i,k)>=ricr) THEN
+                pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))&
+                     /(rhino(i,k-1)-rhino(i,k))
+                ! test04
+                pblh(i) = pblh(i) + 100.
+                pblt(i) = t(i, k-1) + (t(i,k)-t(i,k-1))*(pblh(i)-z(i,k-1))&
+                     /(z(i,k)- z(i,k-1))
+                check(i) = .FALSE.
+             END IF
+          END IF
+       END DO
+    END DO
+
+
+    ! Set pbl height to maximum value where computation exceeds number of
+    ! layers allowed
+
+    DO i = 1, knon
+       IF (check(i)) pblh(i) = z(i, isommet)
+    END DO
+
+    ! Improve estimate of pbl height for the unstable points.
+    ! Find unstable points (sensible heat flux is upward):
+
+    DO i = 1, knon
+       IF (heatv(i)>0.) THEN
+          unstbl(i) = .TRUE.
+          check(i) = .TRUE.
+       ELSE
+          unstbl(i) = .FALSE.
+          check(i) = .FALSE.
+       END IF
+    END DO
+
+    ! For the unstable case, compute velocity scale and the
+    ! convective temperature excess:
+
+    DO i = 1, knon
+       IF (check(i)) THEN
+          phiminv(i) = (1.-binm*pblh(i)*unsobklen(i))**onet
+          ! ***************************************************
+          ! Wm ? et W* ? c'est la formule pour z/h < .1
+          ! ;Calcul de w* ;;
+          ! ;;;;;;;;;;;;;;;;
+          ! w_star=((g/tcls)*fcsv*z(ind))^(1/3.) [ou prendre la premiere approx
+          ! de h)
+          ! ;; CALCUL DE wm ;;
+          ! ;;;;;;;;;;;;;;;;;;
+          ! ; Ici on considerera que l'on est dans la couche de surf jusqu'a
+          ! 100 m
+          ! ; On prend svt couche de surface=0.1*h mais on ne connait pas h
+          ! ;;;;;;;;;;;Dans la couche de surface
+          ! if (z(ind) le 20) then begin
+          ! Phim=(1.-15.*(z(ind)/L))^(-1/3.)
+          ! wm=u_star/Phim
+          ! ;;;;;;;;;;;En dehors de la couche de surface
+          ! endif else if (z(ind) gt 20) then begin
+          ! wm=(u_star^3+c1*w_star^3)^(1/3.)
+          ! endif
+          ! ***************************************************
+          wm(i) = ustar(i)*phiminv(i)
+          ! ===================================================================
+          ! valeurs de Dominique Lambert de la campagne SEMAPHORE :
+          ! <T'^2> = 100.T*^2; <q'^2> = 20.q*^2 a 10m
+          ! <Tv'^2> = (1+1.2q).100.T* + 1.2Tv.sqrt(20*100).T*.q* +
+          ! (.608*Tv)^2*20.q*^2;
+          ! et dTetavS = sqrt(<Tv'^2>) ainsi calculee.
+          ! avec : T*=<w'T'>_s/w* et q*=<w'q'>/w*
+          ! !!! on peut donc utiliser w* pour les fluctuations <-> Lambert
+          ! (leur corellation pourrait dependre de beta par ex)
+          ! if fcsv(i,j) gt 0 then begin
+          ! dTetavs=b1*(1.+2.*.608*q_10(i,j))*(fcs(i,j)/wm(i,j))^2+$
+          ! (.608*Thetav_10(i,j))^2*b2*(xle(i,j)/wm(i,j))^2+$
+          ! 2.*.608*thetav_10(i,j)*sqrt(b1*b2)*(xle(i,j)/wm(i,j))*(fcs(i,j)
+          ! /wm(i,j))
+          ! dqs=b2*(xle(i,j)/wm(i,j))^2
+          ! theta_s(i,j)=thetav_10(i,j)+sqrt(dTetavs)
+          ! q_s(i,j)=q_10(i,j)+sqrt(dqs)
+          ! endif else begin
+          ! Theta_s(i,j)=thetav_10(i,j)
+          ! q_s(i,j)=q_10(i,j)
+          ! endelse
+          ! ===================================================================
+
+          ! HBTM        therm(i) = heatv(i)*fak/wm(i)
+          ! forme Mathieu :
+          q_star = kqfs(i)/wm(i)
+          t_star = khfs(i)/wm(i)
+          ! IM 091204 BEG
+          IF (1==0) THEN
+             IF (t_star<0. .OR. q_star<0.) THEN
+                PRINT *, 'i t_star q_star khfs kqfs wm', i, t_star, q_star, &
+                     khfs(i), kqfs(i), wm(i)
+             END IF
+          END IF
+          ! IM 091204 END
+          ! AM Nveau cde ref 2m =>
+          ! AM        therm(i) = sqrt( b1*(1.+2.*RETV*q(i,1))*t_star**2
+          ! AM     +             + (RETV*T(i,1))**2*b2*q_star**2
+          ! AM     +             + 2.*RETV*T(i,1)*b212*q_star*t_star
+          ! AM     +                 )
+          ! IM 091204 BEG
+          a1 = b1*(1.+2.*retv*qt_th(i))*t_star**2
+          a2 = (retv*th_th(i))**2*b2*q_star*q_star
+          a3 = 2.*retv*th_th(i)*b212*q_star*t_star
+          aa = a1 + a2 + a3
+          IF (1==0) THEN
+             IF (aa<0.) THEN
+                PRINT *, 'i a1 a2 a3 aa', i, a1, a2, a3, aa
+                PRINT *, 'i qT_th Th_th t_star q_star RETV b1 b2 b212', i, &
+                     qt_th(i), th_th(i), t_star, q_star, retv, b1, b2, b212
+             END IF
+          END IF
+          ! IM 091204 END
+          therm(i) = sqrt(b1*(1.+2.*retv*qt_th(i))*t_star**2+(retv*th_th( &
+               i))**2*b2*q_star*q_star &  ! IM 101204  +             +
+                                ! 2.*RETV*Th_th(i)*b212*q_star*t_star
+               +max(0.,2.*retv*th_th(i)*b212*q_star*t_star))
+
+          ! Theta et qT du thermique (forme H&B) avec exces
+          ! (attention, on ajoute therm(i) qui est virtuelle ...)
+          ! pourquoi pas sqrt(b1)*t_star ?
+          ! dqs = b2sr*kqfs(i)/wm(i)
+          qt_th(i) = qt_th(i) + b2sr*q_star
+          ! new on differre le calcul de Theta_e
+          ! The_th(i) = The_th(i) + therm(i) + RLvCp*qT_th(i)
+          ! ou:    The_th(i) = The_th(i) + sqrt(b1)*khfs(i)/wm(i) +
+          ! RLvCp*qT_th(i)
+          rhino(i, 1) = 0.0
+       END IF
+    END DO
+
+    ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! ++ Improve pblh estimate for unstable conditions using the +++++++
+    ! ++          convective temperature excess :                +++++++
+    ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+    DO k = 2, isommet
+       DO i = 1, knon
+          IF (check(i)) THEN
+             ! test     zdu2 =
+             ! (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
+             zdu2 = u(i, k)**2 + v(i, k)**2
+             zdu2 = max(zdu2, 1.0E-20)
+             ! Theta_v environnement
+             zthvd = t(i, k)/s(i, k)*(1.+retv*q(i,k))
+
+             ! et therm Theta_v (avec hypothese de constance de H&B,
+             ! zthvu=(t(i,1)+therm(i))/s(i,1)*(1.+RETV*q(i,1))
+             zthvu = th_th(i)*(1.+retv*qt_th(i)) + therm(i)
+
+
+             ! Le Ri par Theta_v
+             ! AM Niveau de ref 2m
+             ! AM         rhino(i,k) = (z(i,k)-z(i,1))*RG*(zthvd-zthvu)
+             ! AM     .               /(zdu2*0.5*(zthvd+zthvu))
+             rhino(i, k) = (z(i,k)-zref)*rg*(zthvd-zthvu)/(zdu2*0.5&
+                  *(zthvd+zthvu))
+
+
+             IF (rhino(i,k)>=ricr) THEN
+                pblh(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(ricr-rhino(i,k-1))&
+                     /(rhino(i,k-1)-rhino(i,k))
+                ! test04
+                pblh(i) = pblh(i) + 100.
+                pblt(i) = t(i, k-1) + (t(i,k)-t(i,k-1))*(pblh(i)-z(i,k-1))&
+                     /(z(i,k)- z(i,k-1))
+                check(i) = .FALSE.
+                ! IM 170305 BEG
+                IF (1==0) THEN
+                   ! debug print -120;34       -34-        58 et    0;26 wamp
+                   IF (i==950 .OR. i==192 .OR. i==624 .OR. i==118) THEN
+                      PRINT *, ' i,Th_th,Therm,qT :', i, th_th(i), therm(i), &
+                           qt_th(i)
+                      q_star = kqfs(i)/wm(i)
+                      t_star = khfs(i)/wm(i)
+                      PRINT *, 'q* t*, b1,b2,b212 ', q_star, t_star, &
+                           b1*(1.+2.*retv*qt_th(i))*t_star**2, &
+                           (retv*th_th(i))**2*b2*q_star**2, 2.*retv*th_th(i)&
+                           *b212*q_star *t_star
+                      PRINT *, 'zdu2 ,100.*ustar(i)**2', zdu2, fac*ustar(i)**2
+                   END IF
+                END IF !(1.EQ.0) THEN
+                ! IM 170305 END
+                ! q_star = kqfs(i)/wm(i)
+                ! t_star = khfs(i)/wm(i)
+                ! trmb1(i) = b1*(1.+2.*RETV*q(i,1))*t_star**2
+                ! trmb2(i) = (RETV*T(i,1))**2*b2*q_star**2
+                ! Omega now   trmb3(i) = 2.*RETV*T(i,1)*b212*q_star*t_star
+             END IF
+          END IF
+       END DO
+    END DO
+
+    ! Set pbl height to maximum value where computation exceeds number of
+    ! layers allowed
+
+    DO i = 1, knon
+       IF (check(i)) pblh(i) = z(i, isommet)
+    END DO
+
+    ! PBL height must be greater than some minimum mechanical mixing depth
+    ! Several investigators have proposed minimum mechanical mixing depth
+    ! relationships as a function of the local friction velocity, u*.  We
+    ! make use of a linear relationship of the form h = c u* where c=700.
+    ! The scaling arguments that give rise to this relationship most often
+    ! represent the coefficient c as some constant over the local coriolis
+    ! parameter.  Here we make use of the experimental results of Koracin
+    ! and Berkowicz (1988) [BLM, Vol 43] for wich they recommend 0.07/f
+    ! where f was evaluated at 39.5 N and 52 N.  Thus we use a typical mid
+    ! latitude value for f so that c = 0.07/f = 700.
+
+    DO i = 1, knon
+       pblmin = 700.0*ustar(i)
+       pblh(i) = max(pblh(i), pblmin)
+       ! par exemple :
+       pblt(i) = t(i, 2) + (t(i,3)-t(i,2))*(pblh(i)-z(i,2))/(z(i,3)-z(i,2))
+    END DO
+
+    ! ********************************************************************
+    ! pblh is now available; do preparation for diffusivity calculation :
+    ! ********************************************************************
+    DO i = 1, knon
+       check(i) = .TRUE.
+       zsat(i) = .FALSE.
+       ! omegafl utilise pour prolongement CAPE
+       omegafl(i) = .FALSE.
+       cape(i) = 0.
+       kape(i) = 0.
+       eauliq(i) = 0.
+       ctei(i) = 0.
+       pblk(i) = 0.0
+       fak1(i) = ustar(i)*pblh(i)*vk
+
+       ! Do additional preparation for unstable cases only, set temperature
+       ! and moisture perturbations depending on stability.
+       ! *** Rq: les formule sont prises dans leur forme CS ***
+       IF (unstbl(i)) THEN
+          ! AM Niveau de ref du thermique
+          ! AM          zxt=(t(i,1)-z(i,1)*0.5*RG/RCPD/(1.+RVTMP2*q(i,1)))
+          ! AM     .         *(1.+RETV*q(i,1))
+          zxt = (th_th(i)-zref*0.5*rg/rcpd/(1.+rvtmp2*qt_th(i)))* &
+               (1.+retv*qt_th(i))
+          phiminv(i) = (1.-binm*pblh(i)*unsobklen(i))**onet
+          phihinv(i) = sqrt(1.-binh*pblh(i)*unsobklen(i))
+          wm(i) = ustar(i)*phiminv(i)
+          fak2(i) = wm(i)*pblh(i)*vk
+          wstar(i) = (heatv(i)*rg*pblh(i)/zxt)**onet
+          fak3(i) = fakn*wstar(i)/wm(i)
+       ELSE
+          wstar(i) = 0.
+       END IF
+       ! Computes Theta_e for thermal (all cases : to be modified)
+       ! attention ajout therm(i) = virtuelle
+       the_th(i) = th_th(i) + therm(i) + rlvcp*qt_th(i)
+       ! ou:    The_th(i) = Th_th(i) + sqrt(b1)*khfs(i)/wm(i) + RLvCp*qT_th(i)
+    END DO
+
+    ! Main level loop to compute the diffusivities and
+    ! counter-gradient terms:
+
+    DO k = 2, isommet
+
+       ! Find levels within boundary layer:
+
+       DO i = 1, knon
+          unslev(i) = .FALSE.
+          stblev(i) = .FALSE.
+          zm(i) = z(i, k-1)
+          zp(i) = z(i, k)
+          IF (zkmin==0.0 .AND. zp(i)>pblh(i)) zp(i) = pblh(i)
+          IF (zm(i)<pblh(i)) THEN
+             zmzp = 0.5*(zm(i)+zp(i))
+             ! debug
+             ! if (i.EQ.1864) then
+             ! print*,'i,pblh(1864),obklen(1864)',i,pblh(i),obklen(i)
+             ! endif
+
+             zh(i) = zmzp/pblh(i)
+             zl(i) = zmzp*unsobklen(i)
+             zzh(i) = 0.
+             IF (zh(i)<=1.0) zzh(i) = (1.-zh(i))**2
+
+             ! stblev for points zm < plbh and stable and neutral
+             ! unslev for points zm < plbh and unstable
+
+             IF (unstbl(i)) THEN
+                unslev(i) = .TRUE.
+             ELSE
+                stblev(i) = .TRUE.
+             END IF
+          END IF
+       END DO
+       ! print*,'fin calcul niveaux'
+
+       ! Stable and neutral points; set diffusivities; counter-gradient
+       ! terms zero for stable case:
+
+       DO i = 1, knon
+          IF (stblev(i)) THEN
+             IF (zl(i)<=1.) THEN
+                pblk(i) = fak1(i)*zh(i)*zzh(i)/(1.+betas*zl(i))
+             ELSE
+                pblk(i) = fak1(i)*zh(i)*zzh(i)/(betas+zl(i))
+             END IF
+             ! pcfm(i,k) = pblk(i)
+             ! pcfh(i,k) = pcfm(i,k)
+          END IF
+       END DO
+
+       ! unssrf, unstable within surface layer of pbl
+       ! unsout, unstable within outer   layer of pbl
+
+       DO i = 1, knon
+          unssrf(i) = .FALSE.
+          unsout(i) = .FALSE.
+          IF (unslev(i)) THEN
+             IF (zh(i)<sffrac) THEN
+                unssrf(i) = .TRUE.
+             ELSE
+                unsout(i) = .TRUE.
+             END IF
+          END IF
+       END DO
+
+       ! Unstable for surface layer; counter-gradient terms zero
+
+       DO i = 1, knon
+          IF (unssrf(i)) THEN
+             term = (1.-betam*zl(i))**onet
+             pblk(i) = fak1(i)*zh(i)*zzh(i)*term
+             pr(i) = term/sqrt(1.-betah*zl(i))
+          END IF
+       END DO
+       ! print*,'fin counter-gradient terms zero'
+
+       ! Unstable for outer layer; counter-gradient terms non-zero:
+
+       DO i = 1, knon
+          IF (unsout(i)) THEN
+             pblk(i) = fak2(i)*zh(i)*zzh(i)
+             ! cgs(i,k) = fak3(i)/(pblh(i)*wm(i))
+             ! cgh(i,k) = khfs(i)*cgs(i,k)
+             pr(i) = phiminv(i)/phihinv(i) + ccon*fak3(i)/fak
+             ! cgq(i,k) = kqfs(i)*cgs(i,k)
+          END IF
+       END DO
+       ! print*,'fin counter-gradient terms non zero'
+
+       ! For all unstable layers, compute diffusivities and ctrgrad ter m
+
+       ! DO i = 1, knon
+       ! IF (unslev(i)) THEN
+       ! pcfm(i,k) = pblk(i)
+       ! pcfh(i,k) = pblk(i)/pr(i)
+       ! etc cf original
+       ! ENDIF
+       ! ENDDO
+
+       ! For all layers, compute integral info and CTEI
+
+       DO i = 1, knon
+          IF (check(i) .OR. omegafl(i)) THEN
+             IF (.NOT. zsat(i)) THEN
+                ! Th2 = The_th(i) - RLvCp*qT_th(i)
+                th2 = th_th(i)
+                t2 = th2*s(i, k)
+                ! thermodyn functions
+                zdelta = max(0., sign(1.,rtt-t2))
+                qqsat = r2es*foeew(t2, zdelta)/pplay(i, k)
+                qqsat = min(0.5, qqsat)
+                zcor = 1./(1.-retv*qqsat)
+                qqsat = qqsat*zcor
+
+                IF (qqsat<qt_th(i)) THEN
+                   ! on calcule lcl
+                   IF (k==2) THEN
+                      plcl(i) = z(i, k)
+                   ELSE
+                      plcl(i) = z(i, k-1) + (z(i,k-1)-z(i,k))*(qt_th(i)&
+                           -qsatbef(i))/(qsatbef(i)-qqsat)
+                   END IF
+                   zsat(i) = .TRUE.
+                   tbef(i) = t2
+                END IF
+
+                qsatbef(i) = qqsat ! bug dans la version orig ???
+             END IF
+             ! amn ???? cette ligne a deja ete faite normalement ?
+          END IF
+          ! print*,'hbtm2 i,k=',i,k
+       END DO
+    END DO ! end of level loop
+    ! IM 170305 BEG
+    IF (1==0) THEN
+       PRINT *, 'hbtm2  ok'
+    END IF !(1.EQ.0) THEN
+    ! IM 170305 END
+
+  END SUBROUTINE hbtm
+
+end module hbtm_mod
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VAR0SV.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VAR0SV.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VAR0SV.F90	(revision 3851)
@@ -0,0 +1,33 @@
+MODULE VAR0SV
+
+USE VAR_SV, only : nsol, nsno 
+USE VARdSV, only : nsot
+
+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       :: dtz_SV2(-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       :: 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     
+      REAL       :: aKdtSV2( 0:nsot, 0:nkhy)  ! Khyd=a*eta+b: a * dt           
+      REAL       :: bKdtSV2( 0:nsot, 0:nkhy)  ! Khyd=a*eta+b: b * dt                 
+
+END MODULE VAR0SV
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VAR_SV.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VAR_SV.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VAR_SV.F90	(revision 3851)
@@ -0,0 +1,26 @@
+MODULE VAR_SV
+
+
+IMPLICIT NONE
+
+INCLUDE "dimsoil.h"
+
+! +
+! +   LMDZ_SV dims
+! +   ===================
+! +
+!      INTEGER,PARAMETER :: nsol=nsoilmx-1
+!      INTEGER,PARAMETER :: nsno=nsnowmx
+     
+      INTEGER, PARAMETER    :: nsol=nsoilmx-1
+      INTEGER, PARAMETER    :: nsot=nsoilmx+1
+      INTEGER, PARAMETER    :: nsno=nsnowmx
+      INTEGER, PARAMETER    :: nb_wri=1
+      INTEGER,SAVE      :: klonv
+!$OMP THREADPRIVATE(klonv)
+      INTEGER,SAVE      :: knonv
+!$OMP THREADPRIVATE(knonv)
+
+
+
+END MODULE VAR_SV
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARdSV.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARdSV.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARdSV.F90	(revision 3851)
@@ -0,0 +1,101 @@
+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    ::   roBdSV= 450.            ! Max blowing snow Density [kg/m3]
+      REAL,PARAMETER    ::   roSdSV= 450.            ! Max pure    snow Density [kg/m3]
+      REAL,PARAMETER    ::   ru_dSV= 200.            ! Surficial Water Scale Factor [kg/m2]
+
+!C +--Ice
+!C +  ---
+
+      REAL,PARAMETER    ::   CdidSV= 2.1
+
+
+
+!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
+
+      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 ::  iso1  !rajout hjp for ini - check if ivg,iso is possible
+
+!
+
+END MODULE VARdSV
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARphy.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARphy.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARphy.F90	(revision 3851)
@@ -0,0 +1,98 @@
+MODULE VARphy
+
+
+IMPLICIT NONE
+
+
+
+! Etienne, 08112020: merging YOMCST_SISVAT,  PHY_SV and VARphy
+! but redundancies remain
+!
+!  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
+!----------------------------
+! Constants
+                                                                              
+      CHARACTER(LEN=1), PARAMETER :: labnum(0:9) =                            &
+              (/'0','1','2','3','4','5','6','7','8','9'/)             
+!C +...                labnum: Alphanumeric Character      
+     
+                                                                               
+      INTEGER, PARAMETER ::  iun=1                                             
+      REAL, PARAMETER    ::  zer0 = 0.0e+0, half = 0.5e+0, un_1 = 1.0e+0,     &
+     &                       eps6 = 1.0e-6, R_1000=1.e3       
+      REAL, PARAMETER    ::  zero = 0.0e+0, demi = 0.5e+0, unun = 1.0e+0,     &
+     &                       epsi = 1.0e-6, eps9 = 1.0e-9         
+      REAL               ::  ea_MAX,ea_MIN                                                                               
+      REAL, PARAMETER    ::  pi = 3.141592653589793238462643e0
+     
+! A1.2 Geoide
+!-------------
+      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    ::  gravit = 9.81e0,      gravi2 = gravit**2 ,       &
+     &                       grvinv = 1./gravit                       
+!C +                   gravit: Earth Gravity Acceleration    = 9.81    m/s2    
+!C +                   gravi2: idem (squared)                                  
+!C +                   grvinv: idem (inverse)                 
+! A1.3 Radiation
+!----------------
+      REAL,PARAMETER :: StefBo=5.67e-8  
+!C +                   StefBo: Stefan-Boltzman Constant       =    5.67d-8 W/m2/K4
+
+! A1.4 Thermodynamic 
+!-----------------------------
+     
+      REAL, PARAMETER    ::  cp=1004.708845
+                                                       
+      REAL, PARAMETER    ::  RVapor=461.e0, Lv_H2O=2.5008e+6,&
+     &                       Ls_H2O=2.8345e+6, r_LvCp=2490.04,r_LcCp=332.27,  &
+     &                       r_LsCp=2822.31            
+!C +                   cp    : dry air specific heat at constant p (1004 J/kg/K) 
+
+      REAL, PARAMETER    ::  LhfH2O=3.34e+5, LhvH2O=2.5008e+6,&
+     &                       LhsH2O=2.8345e+6     
+      REAL, PARAMETER    ::  rhoWat=1000.00e0    
+!C +                   rhoWat: Water Specific Mass            = 1000.00d+0 kg/m3 
+
+      REAL, PARAMETER    ::  rhoIce=920.e0, BSnoRo=3.30e+2, frsno=300.0                             
+!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 
+!C +...                Tf_Sno: Snow  Melting  Point           =  273.16    K     
+
+
+      REAL, PARAMETER    ::  ro_Wat=1000.00e0, C__Wat=4186.00e0
+!C +                   ro_Wat: Density       of Water         = 1000.00d+0 kg/m3 
+!C +                   C__Wat: Heat Capacity of Water         = 4186.00d+0 J/kg/K
+                                                                                
+      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  
+
+! A1.6 Turbulent and molecular diffusion
+!----------------------------------------
+      REAL, PARAMETER    ::  A_MolV = 1.35e-5, vonKrm = 0.40e0
+!C +...                A_MolV: Air Viscosity                 = 1.35d-5 m2/s   
+!C +                   vonKrm: von Karman constant           = 0.4            
+                                                                          
+
+END MODULE VARphy
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARtSV.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARtSV.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARtSV.F90	(revision 3851)
@@ -0,0 +1,64 @@
+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 THREADPRIVATE(dz1_SV)
+      REAL,ALLOCATABLE,SAVE                ::   dz2_SV(:,:) ! layer thickness
+!$OMP THREADPRIVATE(dz2_SV)
+
+
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   Tsf_SV  ! surface temperature !hj12032010
+!$OMP THREADPRIVATE(Tsf_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   TsfnSV  ! new surface temperature 
+!$OMP THREADPRIVATE(TsfnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   AcoHSV, BcoHSV ! coefficients for Enthalpy
+!$OMP THREADPRIVATE(AcoHSV, BcoHSV)                             ! evolution,from atmosphere
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   AcoQSV, BcoQSV ! coefficients for Humidity
+!$OMP THREADPRIVATE( AcoQSV, BcoQSV)                            ! evolution,from atmosphere
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   ps__SV  ! surface pressure 
+!$OMP THREADPRIVATE(ps__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   p1l_SV  ! 1st layer pressure 
+!$OMP THREADPRIVATE(p1l_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   cdH_SV  ! drag coeff Energy (?)
+!$OMP THREADPRIVATE(cdH_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   cdM_SV  ! drag coeff momentum (?)
+!$OMP THREADPRIVATE(cdM_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE  ::   rsolSV  ! Radiation balance surface
+!$OMP THREADPRIVATE(rsolSV)
+      REAL,SAVE                            ::   lambSV  ! coefficient soil layers
+!$OMP THREADPRIVATE(lambSV)
+
+ 
+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(cdM_SV(klonv))                ! drag coeff momentum (?)
+      ALLOCATE(rsolSV(klonv))                ! Radiation balance surface
+
+  END SUBROUTINE INIT_VARtSV
+
+END MODULE VARtSV
+
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARxSV.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARxSV.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARxSV.F90	(revision 3851)
@@ -0,0 +1,356 @@
+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 THREADPRIVATE(LSmask)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   isotSV  ! Soil       Type                 
+!$OMP THREADPRIVATE(isotSV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   iWaFSV  ! Soil       Drainage:(1,0)=(y,n) 
+!$OMP THREADPRIVATE(iWaFSV)                                                                              
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   coszSV  ! Cosine of Sun zenithal Angle    
+!$OMP THREADPRIVATE(coszSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   sol_SV  ! Downward  Solar    Radiation    
+!$OMP THREADPRIVATE(sol_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   IRd_SV  ! Downward  Longwave Radiation    
+!$OMP THREADPRIVATE(IRd_SV)
+                                                                                
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   drr_SV  ! Rain  Intensity       [kg/m2/s] 
+!$OMP THREADPRIVATE(drr_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dsn_SV  ! Snow  Intensity       [kg/m2/s] 
+!$OMP THREADPRIVATE(dsn_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dsnbSV  ! Idem, fraction, from Drift  [-] 
+!$OMP THREADPRIVATE(dsnbSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   esnbSV  ! Idem, fraction, from Drift  [-]
+!$OMP THREADPRIVATE(esnbSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dbs_SV  ! Drift Amount            [kg/m2] 
+!$OMP THREADPRIVATE(dbs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dbs_Er  ! BS Erosion              [kg/m2]
+!$OMP THREADPRIVATE(dbs_Er)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dbs_Ac  !  BS Accumulation         [kg/m2]
+!$OMP THREADPRIVATE(dbs_Ac)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BrosSV  ! Buffer Snow Layer Density
+!$OMP THREADPRIVATE(BrosSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BG1sSV  ! Buffer Snow Layer Dendr/Sphe[-]
+!$OMP THREADPRIVATE(BG1sSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BG2sSV  ! Buffer Snow Layer Spher/Size[-][0.0001m]
+!$OMP THREADPRIVATE(BG2sSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dz0_SV  ! dz0(Sastrugi dh)            [m] 
+!$OMP THREADPRIVATE(dz0_SV)
+                                                                               
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   cld_SV  ! Cloudiness (seen from SBL)      
+!$OMP THREADPRIVATE(cld_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   za__SV  ! SBL Height                      
+!$OMP THREADPRIVATE(za__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   VV__SV  !(SBL Top)  Wind Velocity         
+!$OMP THREADPRIVATE(VV__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   VVs_SV  !(Sastr,V)  Relevance
+!$OMP THREADPRIVATE(VVs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   RRs_SV  !(Sastr,V)  Counter
+!$OMP THREADPRIVATE(RRs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   DDs_SV  !(Sastr,V)  Angle
+!$OMP THREADPRIVATE(DDs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   TaT_SV  ! SBL Top   Temperature           
+!$OMP THREADPRIVATE(TaT_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   ExnrSV  ! Exner     Potential             
+!$OMP THREADPRIVATE(ExnrSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dSdTSV  ! Sensible Heat Flux T Derivat.   
+!$OMP THREADPRIVATE(dSdTSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dLdTSV  ! Latent   Heat Flux T Derivat.   
+!$OMP THREADPRIVATE(dLdTSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rhT_SV  ! SBL Top   Air  Density          
+!$OMP THREADPRIVATE(rhT_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   QaT_SV  ! SBL Top   Specific Humidity     
+!$OMP THREADPRIVATE(QaT_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dQa_SV  ! SBL Flux  Limitation of Qa      
+!$OMP THREADPRIVATE(dQa_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   qsnoSV  ! SBL Mean  Snow       Content    
+!$OMP THREADPRIVATE(qsnoSV)                                                                   
+                                                                               
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   alb0SV  ! Soil    Albedo                  
+!$OMP THREADPRIVATE(alb0SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   slopSV  ! Snow/Ice/Soil-Water Surf. Slope 
+!$OMP THREADPRIVATE(slopSV)
+
+                                                              
+      REAL,SAVE                      ::   zSBLSV  ! SBL Height (Initial Value)      
+!$OMP THREADPRIVATE(zSBLSV)
+      REAL,SAVE                      ::   dt__SV  ! Time Step                       
+!$OMP THREADPRIVATE(dt__SV)
+      CHARACTER (len=18),SAVE        ::   daHost  ! Date Host Model                 
+!$OMP THREADPRIVATE(daHost)
+                                                                               
+                                                                               
+! +--SISVAT INPUT/OUTPUT Variables                                             
+! +  -----------------------------                                             
+                                                                               
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   isnoSV  ! Nb of Ice/Snow Layers           
+!$OMP THREADPRIVATE(isnoSV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   ispiSV  ! Uppermost superimposed ice      
+!$OMP THREADPRIVATE(ispiSV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   iiceSV  ! Nb of Ice      Layers           
+!$OMP THREADPRIVATE(iiceSV)
+      INTEGER ,ALLOCATABLE,SAVE              ::   istoSV(:,:)  ! Snow Layer     History          
+!$OMP THREADPRIVATE(istoSV)                                                                              
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   alb_SV  ! Surface Albedo           
+!$OMP THREADPRIVATE(alb_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   emi_SV  ! Surface Emissivity       
+!$OMP THREADPRIVATE(emi_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   IRs_SV  ! Soil           IR Flux          
+!$OMP THREADPRIVATE(IRs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   LMO_SV  ! Monin-Obukhov  Scale            
+!$OMP THREADPRIVATE(LMO_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   us__SV  ! Friction       Velocity         
+!$OMP THREADPRIVATE(us__SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   uts_SV  ! Temperature Turbulent Scale     
+!$OMP THREADPRIVATE(uts_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   cutsSV  ! Temperature Turbulent Scale C.  
+!$OMP THREADPRIVATE(cutsSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   uqs_SV  ! Spec.Humid. Turbulent Scale     
+!$OMP THREADPRIVATE(uqs_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   uss_SV  ! Blow.Snow   Turbulent Scale     
+!$OMP THREADPRIVATE(uss_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   usthSV  ! Blowing Snow Erosion Thresh.    
+!$OMP THREADPRIVATE(usthSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rCDmSV  ! Square  Root Contribut. Drag_m  
+!$OMP THREADPRIVATE(rCDmSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rCDhSV  ! Square  Root Contribut. Drag_h  
+!$OMP THREADPRIVATE(rCDhSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0m_SV  ! Momentum     Roughness Length   
+!$OMP THREADPRIVATE(Z0m_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0mmSV  !  z0(Momentum,    Time Mean) [m] 
+!$OMP THREADPRIVATE(Z0mmSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0mnSV  !  z0(Momentum,    instanta.) [m] 
+!$OMP THREADPRIVATE(Z0mnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0roSV  ! Subgrid Topo Roughness Length   
+!$OMP THREADPRIVATE(Z0roSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0SaSV  !  z0(Sastrugi  h)            [m] 
+!$OMP THREADPRIVATE(Z0SaSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0e_SV  !  z0(Snow eroded)            [m] 
+!$OMP THREADPRIVATE(Z0e_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0emSV  !  z0(Snow eroded, Time Mean) [m] 
+!$OMP THREADPRIVATE(Z0emSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0enSV  !  z0(Snow eroded, instanta.) [m] 
+!$OMP THREADPRIVATE(Z0enSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0h_SV  ! Heat         Roughness Length   
+!$OMP THREADPRIVATE(Z0h_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0hmSV  !  z0(Heat,        Time Mean) [m] 
+!$OMP THREADPRIVATE(Z0hmSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   Z0hnSV  !  z0(Heat,        instanta.) [m] 
+!$OMP THREADPRIVATE(Z0hnSV)
+                                                                         
+
+                                                                        
+      REAL ,ALLOCATABLE,SAVE   ::   TsisSV(:,:)  ! Snow/Ice/Soil-Water Temperature 
+!$OMP THREADPRIVATE(TsisSV)
+      REAL ,ALLOCATABLE,SAVE   ::   ro__SV(:,:)  ! Snow/Ice/Soil-Water VolumicMass 
+!$OMP THREADPRIVATE(ro__SV)
+      REAL,ALLOCATABLE,SAVE    ::   eta_SV(:,:)  ! Snow/Ice/Soil     Water Content 
+!$OMP THREADPRIVATE(eta_SV)
+      REAL,ALLOCATABLE,SAVE    ::   G1snSV(:,:)  ! Snow Dendricity/Sphericity      
+!$OMP THREADPRIVATE(G1snSV)
+      REAL,ALLOCATABLE,SAVE    ::   G2snSV(:,:)  ! Snow Sphericity/Size            
+!$OMP THREADPRIVATE(G2snSV)
+      REAL,ALLOCATABLE,SAVE    ::   dzsnSV(:,:)  ! Snow Layer  Thickness           
+!$OMP THREADPRIVATE(dzsnSV)
+      REAL,ALLOCATABLE,SAVE    ::   agsnSV(:,:)  ! Snow Age                        
+!$OMP THREADPRIVATE(agsnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BufsSV  ! Snow Buffer Layer               
+!$OMP THREADPRIVATE(BufsSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   rusnSV  ! Surficial   Water               
+!$OMP THREADPRIVATE(rusnSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   SWf_SV  ! Normalized  Decay               
+!$OMP THREADPRIVATE(SWf_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   SWS_SV  ! Surficial Water Status          
+!$OMP THREADPRIVATE(SWS_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   HFraSV  ! Frazil      Thickness           
+!$OMP THREADPRIVATE(HFraSV)
+                                                                            
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   zWE_SV  ! Current   Snow Thickness [mmWE] 
+!$OMP THREADPRIVATE(zWE_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   zWEcSV  ! Compacted Snow Thickness [mmWE] 
+!$OMP THREADPRIVATE(zWEcSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   wem_SV  ! Only Melting             [mmWE] 
+!$OMP THREADPRIVATE(wem_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   wer_SV  ! Refreezing               [mmWE] 
+!$OMP THREADPRIVATE(wer_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   wes_SV  ! Sublimation              [mmWE] 
+!$OMP THREADPRIVATE(wes_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   zn4_SV  ! snowheight change         [mm]
+!$OMP THREADPRIVATE(zn4_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   zn5_SV  ! snowheight change         [mm]
+!$OMP THREADPRIVATE(zn5_SV)                                                                            
+                                                                              
+! +--SISVAT OUTPUT       Variables                                            
+! +  -----------------------------                                            
+                                                                               
+      INTEGER,DIMENSION(nb_wri),SAVE ::   no__SV  ! OUTPUT file Unit Number         
+!$OMP THREADPRIVATE(no__SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   i___SV  ! OUTPUT point   i Coordinate    
+!$OMP THREADPRIVATE(i___SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   j___SV  ! OUTPUT point   j Coordinate     
+!$OMP THREADPRIVATE(j___SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   n___SV  ! OUTPUT point   n Coordinate     
+!$OMP THREADPRIVATE(n___SV)
+      INTEGER,DIMENSION(nb_wri),SAVE ::   lwriSV  ! OUTPUT point vec Index          
+!$OMP THREADPRIVATE(lwriSV)
+!                                                                              
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   ii__SV  ! WORK   point   i Coordinate     
+!$OMP THREADPRIVATE(ii__SV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   jj__SV  ! WORK   point   j Coordinate     
+!$OMP THREADPRIVATE(jj__SV)
+      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE ::   nn__SV  ! WORK   point   n Coordinate     
+!$OMP THREADPRIVATE(nn__SV)
+                                                                               
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   IRu_SV  ! UPward    IR Flux (effective)   
+!$OMP THREADPRIVATE(IRu_SV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   hSalSV  ! Saltating Layer Height          
+!$OMP THREADPRIVATE(hSalSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   qSalSV  ! Saltating Snow  Concentration   
+!$OMP THREADPRIVATE(qSalSV)
+      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   RnofSV  ! RunOFF    Intensity             
+!$OMP THREADPRIVATE(RnofSV)
+      REAL, DIMENSION(:,:),ALLOCATABLE,SAVE    ::   RuofSV  ! RunOFF    Intensity             
+!$OMP THREADPRIVATE(RuofSV)
+
+
+
+                  
+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(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(dbs_er(klonv))  ! Drift erosion           [kg/m2] 
+      ALLOCATE(dbs_ac(klonv))  ! Drift accumulation      [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(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(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] 
+      ALLOCATE(zn4_SV(klonv))  ! snow height change       [mm] 
+      ALLOCATE(zn5_SV(klonv))  ! snow height change       [mm]                                                                             
+                                                                              
+! +--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      
+      ALLOCATE(RuofSV(klonv,4))  ! RunOFF    Intensity      
+
+
+      DO ikl=1,klonv        
+        LSmask(ikl)   = 0
+        isotSV(ikl)   = 0                
+        iWaFSV(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: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARySV.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARySV.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/VARySV.F90	(revision 3851)
@@ -0,0 +1,120 @@
+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    ::   SoSosv  !? Surface Absorbed Solar Radiat.  
+!$OMP THREADPRIVATE(SoSosv)
+      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   Eso_sv  !? Emissivity of       Soil+Snow   
+!$OMP THREADPRIVATE(Eso_sv)
+      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, 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(SoSosv(klonv))  !? Surface Absorbed Solar Radiat.  
+      ALLOCATE(Eso_sv(klonv))  !? Emissivity of       Soil+Snow   
+      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(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: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/inlandsis.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/inlandsis.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/inlandsis.F	(revision 3851)
@@ -0,0 +1,1239 @@
+      subroutine INLANDSIS(SnoMod,BloMod,jjtime)
+
+      USE dimphy
+
+!--------------------------------------------------------------------------+
+!     INLANDSIS module                                                     |
+!     Simplified SISVAT module, containing ice and snow processes for      |
+!     ice-covered surfaces                                                 |
+!     version MARv3, november 2020                                         |
+!     SubRoutine INLANDSIS contains the fortran 77 code of the             |
+!                Soil/Ice Snow Vegetation Atmosphere Transfer Scheme       |
+!                                                                          |
+!--------------------------------------------------------------------------+
+!     PARAMETERS:  klonv: Total Number of columns =                        |
+!     ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+!                       X       Number of Mosaic Cell per grid box         |
+!                                                                          |
+!     INPUT:   daHost   : Date Host Model                                  |
+!     ^^^^^                                                                |
+!                                                                          |
+!     INPUT:   LSmask   : 1:          Land       MASK                      |
+!     ^^^^^               0:          Sea        MASK                      |
+!              isotSV   = 0,...,12:   Soil       Type                      |
+!                         0:          Water,          Liquid (Sea, Lake)   |
+!                        12:          Water, Solid           (Ice)         |
+!                                                                          |
+!     INPUT:   coszSV   : Cosine of the Sun Zenithal Distance          [-] |
+!     ^^^^^    sol_SV   : Surface Downward  Solar      Radiation    [W/m2] |
+!              IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |
+!              drr_SV   : Rain  Intensity                        [kg/m2/s] |
+!              dsn_SV   : Snow  Intensity                      [mm w.e./s] |
+!              dsnbSV   : Snow  Intensity,  Drift Fraction             [-] |
+!              dbs_SV   : Drift Amount                           [mm w.e.] |
+!              za__SV   : Surface Boundary Layer (SBL) Height          [m] |
+!              VV__SV   :(SBL Top)   Wind Velocity                   [m/s] |
+!              TaT_SV   : SBL Top    Temperature                       [K] |
+!              rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
+!              QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
+!              qsnoSV   : SBL Mean   Snow      Content             [kg/kg] |
+!              alb0SV   : Soil Basic Albedo                            [-] |
+!              slopSV   : Surface    Slope                             [-] |
+!              dt__SV   : Time  Step                                   [s] |
+!                                                                          |
+!     INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
+!     OUTPUT:  ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+!     ^^^^^^   iiceSV   = total Nb of Ice      Layers                      |
+!              istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+!                                                                          |
+!     INPUT /  alb_SV   : Surface        Albedo                        [-] |
+!     OUTPUT:  emi_SV   : Surface        Emissivity                    [-] |
+!     ^^^^^^   IRs_SV   : Soil           IR Flux  (negative)        [W/m2] |
+!              LMO_SV   : Monin-Obukhov               Scale            [m] |
+!              us__SV   : Friction          Velocity                 [m/s] |
+!              uts_SV   : Temperature       Turbulent Scale          [m/s] |
+!              uqs_SV   : Specific Humidity Velocity                 [m/s] |
+!              uss_SV   : Blowing Snow      Turbulent Scale          [m/s] |
+!              usthSV   : Blowing Snow      Erosion   Threshold      [m/s] |
+!              Z0m_SV   : Momentum     Roughness Length                [m] |
+!              Z0mmSV   : Momentum     Roughness Length (time mean)    [m] |
+!              Z0mnSV   : Momentum     Roughness Length (instantaneous)[m] |
+!              Z0SaSV   : Sastrugi     Roughness Length                [m] |
+!              Z0e_SV   : Erosion Snow Roughness Length                [m] |
+!              Z0emSV   : Erosion Snow Roughness Length (time mean)    [m] |
+!              Z0enSV   : Erosion Snow Roughness Length (instantaneous)[m] |
+!              Z0roSV   : Subgrid Topo Roughness Length                [m] |
+!              Z0h_SV   : Heat         Roughness Length                [m] |
+!              TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+!                       & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+!              ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+!              eta_SV   : Soil/Snow Water   Content                [m3/m3] |
+!              G1snSV   : snow dendricity/sphericity                       |
+!              G2snSV   : snow sphericity/grain size                       |
+!              dzsnSV   : Snow Layer        Thickness                  [m] |
+!              agsnSV   : Snow       Age                             [day] |
+!              BufsSV   : Snow Buffer Layer              [kg/m2] .OR. [mm] |
+!              BrosSV   : Snow Buffer Layer Density      [kg/m3]           |
+!              BG1sSV   : Snow Buffer Layer Dendricity / Sphericity    [-] |
+!              BG2sSV   : Snow Buffer Layer Sphericity / Size [-] [0.1 mm] |
+!              rusnSV   : Surficial   Water              [kg/m2] .OR. [mm] |
+!                                                                          |
+!     OUTPUT:  no__SV   : OUTPUT file Unit Number                      [-] |
+!     ^^^^^^   i___SV   : OUTPUT point   i Coordinate                  [-] |
+!              j___SV   : OUTPUT point   j Coordinate                  [-] |
+!              n___SV   : OUTPUT point   n Coordinate                  [-] |
+!              lwriSV   : OUTPUT point vec Index                       [-] |
+!                                                                          |
+!     OUTPUT:  IRu_SV   : Upward     IR Flux (+, upw., effective)      [K] |
+!     ^^^^^^   hSalSV   : Saltating Layer Height                       [m] |
+!              qSalSV   : Saltating Snow  Concentration            [kg/kg] |
+!              RnofSV   : RunOFF Intensity                       [kg/m2/s] |
+!                                                                          |
+!     Internal Variables:                                                  |
+!     ^^^^^^^^^^^^^^^^^^                                                   |
+!              NLaysv   = New            Snow Layer Switch             [-] |
+!              albisv   : Snow/Ice/Water/Soil Integrated Albedo        [-] |
+!              SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
+!              TBr_sv   : Brightness Temperature                       [K] |
+!              IRupsv   : Upward     IR Flux (-, upw.)              [W/m2] |
+!              ram_sv   : Aerodynamic Resistance for Momentum        [s/m] |
+!              rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+!              Evp_sv   : Evaporation                              [kg/m2] |
+!              EvT_sv   : Evapotranspiration                       [kg/m2] |
+!              HSs_sv   : Surface    Sensible Heat Flux + => absorb.[W/m2] |
+!              HLs_sv   : Surface    Latent   Heat Flux + => absorb.[W/m2] |
+!              Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
+!              Tsrfsv   : Surface    Temperature                       [K] |
+!              sEX_sv   : Verticaly Integrated Extinction Coefficient  [-] |
+!              LSdzsv   : Vertical   Discretization Factor             [-] |
+!                       =    1. Soil                                       |
+!                       = 1000. Ocean                                      |
+!              z_snsv   : Snow Pack  Thickness                         [m] |
+!              zzsnsv   : Snow Pack  Thickness                         [m] |
+!              albssv   : Soil       Albedo                            [-] |
+!              Eso_sv   : Soil+Snow       Emissivity                   [-] |
+!              Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
+!                                                                          |
+!              ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |
+!              ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |
+!              ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |
+!              EqSn_0   : Snow      Energy, before Phase Change     [J/m2] |
+!              EqSn_1   : Snow      Energy, after  Phase Change     [J/m2] |
+!              EqSn_d   : Snow      Energy,       net    Forcing    [J/m2] |
+!              Enrsvd   : SVAT      Energy Power         Forcing    [W/m2] |
+!              Enrbal   : SVAT      Energy Balance                  [W/m2] |
+!              Wats_0   : Soil Water,  before Forcing                 [mm] |
+!              Wats_1   : Soil Water,  after  Forcing                 [mm] |
+!              Wats_d   : Soil Water          Forcing                 [mm] |
+!              SIWm_0   : Snow        initial Mass               [mm w.e.] |
+!              SIWm_1   : Snow        final   Mass               [mm w.e.] |
+!              SIWa_i   : Snow Atmos. initial Forcing            [mm w.e.] |
+!              SIWa_f   : Snow Atmos. final   Forcing(noConsumed)[mm w.e.] |
+!              SIWe_i   : SnowErosion initial Forcing            [mm w.e.] |
+!              SIWe_f   : SnowErosion final   Forcing(noConsumed)[mm w.e.] |
+!              SIsubl   : Snow sublimed/deposed  Mass            [mm w.e.] |
+!              SImelt   : Snow Melted            Mass            [mm w.e.] |
+!              SIrnof   : Surficial Water + Run OFF Change       [mm w.e.] |
+!              SIvAcr   : Sea-Ice    vertical Acretion           [mm w.e.] |
+!              Watsvd   : SVAT Water          Forcing                 [mm] |
+!              Watbal   : SVAT Water  Balance                       [W/m2] |
+!                                                                          |
+!              vk2      : Square of Von Karman Constant                [-] |
+!              sqrCm0   : Factor of   Neutral Drag Coeffic.Momentum  [s/m] |
+!              sqrCh0   : Factor of   Neutral Drag Coeffic.Heat      [s/m] |
+!              EmiSol   : Soil          Emissivity                     [-] |
+!              EmiSno   : Snow          Emissivity                     [-] |
+!              EmiWat   : Water         Emissivity                     [-] |
+!              Z0mLnd   :          Land Roughness Length               [m] |
+!              sqrrZ0   : u*t/u*                                           |
+!              f_eff    : Marticorena & B. 1995 JGR (20)                   |
+!              A_Fact   : Fundamental * Roughness                          |
+!              Z0mBSn   :         BSnow Roughness Length               [m] |
+!              Z0mBS0   : Mimimum BSnow Roughness Length (blown* )     [m] |
+!              Z0m_Sn   :          Snow Roughness Length (surface)     [m] |
+!              Z0m_S0   : Mimimum  Snow Roughness Length               [m] |
+!              Z0m_S1   : Maximum  Snow Roughness Length               [m] |
+!              Z0_GIM   : Minimum GIMEX Roughness Length               [m] |
+!              Z0_ICE   : Sea Ice ISW   Roughness Length               [m] |
+!                                                                          |
+!                                                                          |
+!--------------------------------------------------------------------------+
+     
+
+
+! Global Variables
+! ================
+
+
+      USE VARphy
+      USE VAR_SV
+      USE VARdSV
+      USE VAR0SV
+      USE VARxSV
+      USE VARySV
+      USE VARtSV
+      USE surface_data, only: iflag_tsurf_inlandsis
+
+
+      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
+      real      BufPro                        ! Buffer Snow Layer Density
+      real      Buf_G1,BG1__N                 ! Buffer Snow Layer Dendr/Sphe[-]
+      real      Buf_G2,BG2__N                 ! Buffer Snow Layer Spher/Size[-]
+      real      Bdzssv(klonv)                 ! Buffer Snow Layer Thickness
+      real      z_snsv(klonv)                 ! Snow-Ice, current Thickness
+
+
+
+! Local
+! -----
+
+      integer   iwr
+      integer   ikl   ,isn   ,isl   ,ist      !
+      integer   ist__s,ist__w                 ! Soil/Water Body Identifier
+      integer   growth                        ! Seasonal               Mask
+      integer   LISmsk                        ! Land+Ice / Open    Sea Mask
+      integer   LSnMsk                        ! Snow-Ice / No Snow-Ice Mask
+      integer   IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
+      integer   SnoMsk                        ! Snow     / No Snow     Mask
+
+      real      roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
+      real      Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
+      real      Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
+      real      Polair                        ! Polar  Snow Switch
+      real      PorSno,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      EmiSol                        ! Emissivity of       Soil
+      real      EmiSno                        ! Emissivity of            Snow
+      real      EmiWat                        ! Emissivity of a Water Area
+      real      vk2                           ! Square of Von Karman Constant
+      real      u2star                        !(u*)**2
+      real      Z0mLnd                        !          Land Roughness Length
+c #ZN real      sqrrZ0                        ! u*t/u*
+      real      f_eff                         ! Marticorena & B. 1995 JGR (20)
+      real      A_Fact                        ! Fundamental * Roughness
+      real      Z0m_nu                        ! Smooth R Snow Roughness Length
+      real      Z0mBSn                        !         BSnow Roughness Length
+      real      Z0mBS0                        ! Mimimum BSnow Roughness Length
+      real      Z0m_S0                        ! Mimimum  Snow Roughness Length
+      real      Z0m_S1                        ! Maximum  Snow Roughness Length
+c #SZ real      Z0Sa_N                        ! Regime   Snow Roughness Length
+c #SZ real      Z0SaSi                        ! 1.IF Rgm Snow Roughness Length 
+c #GL real      Z0_GIM                        ! Mimimum GIMEX Roughness Length
+      real      Z0_ICE                        ! Ice ISW   Roughness Length
+      real      Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
+      real      SnoWat                        ! Snow Layer    Switch
+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
+      real      param                         ! Polynomial   fit z0=f(T)
+      real      Z0_obs                        ! Fit Z0_obs=f(T) (m)
+      real      tamin                         ! min T of linear fit (K)
+      real      tamax                         ! max T of linear fit (K)
+      real      coefa,coefb,coefc,coefd       ! Coefs for z0=f(T)
+      real      ta1,ta2,ta3                   ! Air temperature thresholds
+      real      z01,z02,z03                   ! z0 thresholds
+      real      tt_c,vv_c                     ! Critical param.
+      real      tt_tmp,vv_tmp,vv_virt         ! Temporary variables
+      logical   density_kotlyakov             ! .true. if Kotlyakov 1961
+      real      e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
+      real      zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
+
+
+
+! Internal DATA
+! =============
+
+      data      T__Min / 200.00/              ! Minimum realistic Temperature
+      data      TaPole / 263.15/              ! Maximum Polar     Temperature
+      data      roSMin /  30.  /              ! Minimum Snow  Density
+      data      roSMax / 400.  /              ! Max Fresh Snow Density
+      data      tt_c   / -2.0  /              ! Critical Temp. (degC)
+      data      vv_c   / 14.3  /              ! Critical Wind speed (m/s)
+      data      roSn_1 / 109.  /              ! Fall.Sno.Density, Indep. Param.
+      data      roSn_2 /   6.  /              ! Fall.Sno.Density, Temper.Param.
+      data      roSn_3 /  26.  /              ! Fall.Sno.Density, Wind   Param.
+      data      Dendr1 /  17.12/              ! Fall.Sno.Dendric.,Wind 1/Param.
+      data      Dendr2 / 128.  /              ! Fall.Sno.Dendric.,Wind 2/Param.
+      data      Dendr3 / -20.  /              ! Fall.Sno.Dendric.,Indep. Param.
+      data      Spher1 /   7.87/              ! Fall.Sno.Spheric.,Wind 1/Param.
+      data      Spher2 /  38.  /              ! Fall.Sno.Spheric.,Wind 2/Param.
+      data      Spher3 /  50.  /              ! Fall.Sno.Spheric.,Wind 3/Param.
+      data      Spher4 /  90.  /              ! Fall.Sno.Spheric.,Indep. Param.
+      data      EmiSol /   0.99999999/        ! 0.94Emissivity of Soil
+      data      EmiWat /   0.99999999/        ! Emissivity of a Water Area
+      data      EmiSno /   0.99999999/        ! Emissivity of Snow
+      
+!     DATA      Emissivities                  ! Pielke, 1984, pp. 383,409
+
+      data      Z0mBS0 /   0.5e-6/            ! MINimum Snow Roughness Length 
+                                              ! for Momentum if Blowing Snow
+                                              ! Gallee et al. 2001 BLM 99 (19)
+      data      Z0m_S0/    0.00005/           ! MINimum Snow Roughness Length
+                                              ! MegaDunes    included
+      data      Z0m_S1/    0.030  /           ! MAXimum Snow Roughness Length
+                                              !        (Sastrugis)
+c #GL data      Z0_GIM/    0.0013/            ! Ice Min Z0 = 0.0013 m (Broeke)
+!                                             ! Old Ice Z0 = 0.0500 m (Bruce)
+!                                             !              0.0500 m (Smeets)
+!                                             !              0.1200 m (Broeke)
+      data      Z0_ICE/    0.0010/            ! Sea-Ice Z0 = 0.0010 m (Andreas)
+!                                             !    (Ice Station Weddel -- ISW)
+      vk2    =  vonKrm  *  vonKrm             ! Square of Von Karman Constant
+
+
+! BEGIN.main.
+! ===========================
+
+
+
+
+! "Soil" Humidity of Water Bodies
+! ===============================
+
+      DO ikl=1,knonv
+
+          ist    =      isotSV(ikl)                       ! Soil Type
+          ist__s =  min(ist, 1)                           ! 1 => Soil
+          ist__w =  1 - ist__s                            ! 1 => Water Body
+        DO isl=-nsol,0
+          eta_SV(ikl,isl) = eta_SV(ikl,isl) * ist__s      ! Soil 
+     .                    + etadSV(ist)     * ist__w      ! Water Body
+        END DO
+
+
+! Vertical Discretization Factor
+! ==============================
+
+          LSdzsv(ikl)     =                   ist__s      ! Soil
+     .                    + OcndSV          * ist__w      ! Water Body
+      END DO
+
+
+! Blowing Particles Threshold Friction velocity
+! =============================================
+
+c #AE       usthSV(ikl) =                     1.0e+2
+!          END DO
+!xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+
+
+
+! Contribution of Snow to the Surface Snow Pack
+! =============================================
+
+      IF (SnoMod)                                                 THEN
+
+
+ 
+C +--Blowing Snow
+C +  ------------
+ 
+        IF (BloMod) then
+         if (klonv.eq.1) then
+          if(isnoSV(1).ge.2                   .and.
+     .       TsisSV(1,max(1,isnoSV(1)))<273.  .and.
+     .       ro__SV(1,max(1,isnoSV(1)))<500.  .and.
+     .       eta_SV(1,max(1,isnoSV(1)))<epsi) then
+C +                       **********
+                     call SISVAT_BSn
+          endif
+         else
+                     call SISVAT_BSn
+C +                       **********
+         endif
+        ENDIF
+ 
+
+
+C +--Buffer Layer
+C +  ------------
+ 
+          DO ikl=1,knonv
+c  BufsSV(ikl) [mm w.e.] i.e, i.e., [kg/m2]
+            d_Bufs      =  max(dsn_SV(ikl) *dt__SV,0.)  !
+            dsn_SV(ikl) =      0.                       !
+            Bufs_N      =      BufsSV(ikl) +d_Bufs      !
+ 
+ 
+C +--Snow Density
+C +  ^^^^^^^^^^^^
+            Polair      =      zero
+c #NP       Polair      =  max(zero,                    !
+c #NP.                         sign(unun,TaPole         !
+c #NP.                                  -TaT_SV(ikl)))  !
+            Polair      =  max(zero,                    !
+     .                         sign(unun,TaPole         !
+     .                                  -TaT_SV(ikl)))  !
+            Buf_ro      =  max( rosMin,                 ! Fallen Snow Density
+     .      roSn_1+roSn_2*     (TaT_SV(ikl)-TfSnow)     ! [kg/m3]
+     .            +roSn_3*sqrt( VV__SV(ikl)))           ! Pahaut    (CEN), Etienne: use wind speed at first model level instead of 10m wind
+c #NP       BufPro      =  max( rosMin,                 ! Fallen Snow Density
+c #NP.         104. *sqrt( max( VV10SV(ikl)-6.0,0.0)))  ! Kotlyakov (1961)
+ 
+            density_kotlyakov = .true.
+c #AC       density_kotlyakov = .false.  !C.Agosta snow densisty as if BS is on b
+c #BS       density_kotlyakov = .false.  !C.Amory BS 2018
+C + ...     Fallen Snow Density, Adapted for Antarctica
+            if (density_kotlyakov) then
+                tt_tmp = TaT_SV(ikl)-TfSnow
+                !vv_tmp = VV10SV(ikl)
+                vv_tmp=VV__SV(ikl) ! Etienne: use wind speed at first model level instead of 10m wind
+C + ...         [ A compromise between
+C + ...           Kotlyakov (1961) and Lenaerts (2012, JGR, Part1) ]
+                if (tt_tmp.ge.-10) then
+                  BufPro   =  max( rosMin,
+     .            104. *sqrt( max( vv_tmp-6.0,0.0))) ! Kotlyakov (1961)
+                else
+                  vv_virt = (tt_c*vv_tmp+vv_c*(tt_tmp+10))
+     .                     /(tt_c+tt_tmp+10)
+                  BufPro  = 104. *sqrt( max( vv_virt-6.0,0.0))
+                endif
+            else
+C + ...         [ density derived from observations of the first 50cm of
+C + ...           snow - cf. Rajashree Datta - and multiplied by 0.8 ]
+C + ...           C. Agosta, 2016-09
+cc #SD           BufPro = 149.2 + 6.84*VV10SV(ikl) + 0.48*Tsrfsv(ikl)
+cc #SD           BufPro = 125 + 14*VV10SV(ikl) + 0.6*Tsrfsv(ikl) !MAJ CK and CAm
+!                BufPro = 200 + 21 * VV10SV(ikl)!CK 29/07/19
+                 BufPro = 200 + 21 * VV__SV(ikl)!Etienne: use wind speed at first model level instead of 10m wind
+            endif
+ 
+            Bros_N      = (1. - Polair) *   Buf_ro      ! Temperate Snow
+     .                        + Polair  *   BufPro      ! Polar     Snow
+ 
+            Bros_N = max( 20.,max(rosMin,  Bros_N))
+            Bros_N = min(400.,min(rosMax-1,Bros_N)) ! for dz_min in SISVAT_zSn
+ 
+ 
+!    Density of deposited blown snow
+!    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ 
+c #BS       Bros_N      = frsno
+c #BS       ro_new      = ro__SV(ikl,max(1,isnoSV(ikl)))
+c #BS       ro_new      = max(Bros_N,min(roBdSV,ro_new))
+c #BS       Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl)))
+c #BS.                     -roBdSV)/(500.-roBdSV))
+c #BS       Fac         = max(0.,min(1.,Fac))
+c #BS       dsnbSV(ikl) = Fac*dsnbSV(ikl)
+c #BS       Bros_N      = Bros_N     * (1.0-dsnbSV(ikl))
+c #BS.                  + ro_new     *      dsnbSV(ikl)
+
+
+ 
+!    Time averaged Density of deposited blown Snow
+!    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           
+            BrosSV(ikl) =(Bros_N     *      d_Bufs      !
+     .                   +BrosSV(ikl)*      BufsSV(ikl))!
+     .                   /         max(epsi,Bufs_N)     !
+ 
+ 
+C +-- S.Falling Snow Properties (computed as in SISVAT_zAg)
+C +     ^^^^^^^^^^^^^^^^^^^^^^^
+            Buf_G1      =  max(-G1_dSV,                 ! Temperate Snow
+     .               min(Dendr1*VV__SV(ikl)-Dendr2,     !     Dendricity
+     .                   Dendr3                   ))    !
+            Buf_G2      =  min( Spher4,                 ! Temperate Snow
+     .               max(Spher1*VV__SV(ikl)+Spher2,     !     Sphericity
+     .                   Spher3                   ))    !
+            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
+
+ 
+!     S.1. Meme  Type  de Neige  / same Grain Type
+!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #BS       SameOK  =  max(zero,
+c #BS.                     sign(unun,    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(zero,sign(unun,epsi-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.                   ,  unun)                         ! 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.                   ,  unun)                         !
+c #BS       DendOK  = max(zero,                           !
+c #BS.                    sign(unun,     Sph_av *DScdSV   ! Small   Grains
+c #BS.                              +(1.-Sph_av)*DFcdSV   ! Faceted Grains
+c #BS.                              -    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
+ 
+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
+ 
+
+ 
+!     S.1. Meme  Type  de Neige  / same Grain Type
+!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            SameOK  =  max(zero,
+     .                     sign(unun,    Buf_G1 *BG1sSV(ikl)
+     .                                 - eps_21                    ))
+            G1same  = (d_Bufs*Buf_G1+BufsSV(ikl)*BG1sSV(ikl))
+     .                     /max(epsi,Bufs_N)
+            G2same  = (d_Bufs*Buf_G2+BufsSV(ikl)*BG2sSV(ikl))
+     .                     /max(epsi,Bufs_N)
+ 
+!     S.2. Types differents / differents Types
+!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+            typ__1  =  max(zero,sign(unun,epsi-Buf_G1))   ! =1.=> Dendritic
+            zroNEW  =(    typ__1  *d_Bufs                 ! fract.Dendr.Lay.
+     .              + (1.-typ__1) *BufsSV(ikl))           !
+     .                   /max(epsi,Bufs_N)                !
+            G1_NEW  =     typ__1  *Buf_G1                 ! G1 of Dendr.Lay.
+     .              + (1.-typ__1) *BG1sSV(ikl)            !
+            G2_NEW  =     typ__1  *Buf_G2                 ! G2 of Dendr.Lay.
+     .              + (1.-typ__1) *BG2sSV(ikl)            !
+            zroOLD  =((1.-typ__1) *d_Bufs                 ! fract.Spher.Lay.
+     .              +     typ__1  *BufsSV(ikl))           !
+     .                   /max(epsi,Bufs_N)                !
+            G1_OLD  = (1.-typ__1) *Buf_G1                 ! G1 of Spher.Lay.
+     .              +     typ__1  *BG1sSV(ikl)            !
+            G2_OLD  = (1.-typ__1) *Buf_G2                 ! G2 of Spher.Lay.
+     .              +     typ__1  *BG2sSV(ikl)            !
+            SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV          ! Size  Dendr.Lay.
+     .               +(1.+G1_NEW         /G1_dSV)         !
+     .                  *(G2_NEW  *DScdSV/G1_dSV          !
+     .               +(1.-G2_NEW         /G1_dSV)*DFcdSV) !
+            SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
+            SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
+            SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
+            Siz_av  =   ( zroNEW  *SizNEW+zroOLD*SizOLD)  ! Averaged Size
+            Sph_av = min( zroNEW  *SphNEW+zroOLD*SphOLD   !
+     .                  ,   unun                       )  ! Averaged Sphericity
+            Den_av = min((Siz_av  - (    Sph_av *DScdSV   !
+     .                              +(1.-Sph_av)*DFcdSV)) !
+     .                 / (DDcdSV  - (    Sph_av *DScdSV   !
+     .                              +(1.-Sph_av)*DFcdSV)) !
+     .                  ,   unun                         )!
+            DendOK  = max(zero,                           !
+     .                    sign(unun,     Sph_av *DScdSV   ! Small   Grains
+     .                              +(1.-Sph_av)*DFcdSV   ! Faceted Grains
+     .                              -    Siz_av        )) !
+C +...      REMARQUE: le  type moyen (dendritique ou non) depend
+C +         ^^^^^^^^  de la  comparaison avec le diametre optique
+C +                   d'une neige recente de   dendricite nulle
+C +...      REMARK:   the mean type  (dendritic   or not) depends
+C +         ^^^^^^    on the comparaison with the optical diameter
+C +                   of a recent snow    having zero dendricity
+ 
+            G1diff  =(   -DendOK *Den_av
+     .               +(1.-DendOK)*Sph_av) *G1_dSV
+            G2diff  =     DendOK *Sph_av  *G1_dSV
+     .               +(1.-DendOK)*Siz_av
+            G1      =     SameOK *G1same
+     .               +(1.-SameOK)*G1diff
+            G2      =     SameOK *G2same
+     .               +(1.-SameOK)*G2diff
+ 
+            BG1sSV(ikl) =                       G1      !
+     .                  *       Bufs_N/max(epsi,Bufs_N) !
+            BG2sSV(ikl) =                       G2      !
+     .                  *       Bufs_N/max(epsi,Bufs_N) !
+ 
+
+C +--Update of Buffer Layer Content & Decision about creating a new snow layer
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+            BufsSV(ikl) =       Bufs_N                  !     [mm w.e.]
+            NLaysv(ikl) = min(unun,                     !
+     .                    max(zero,                     ! Allows to create
+     .                        sign(unun,BufsSV(ikl)     ! a new snow Layer
+     .                                 -SMndSV     ))   ! if Buffer > SMndSV
+     .                   *max(zero,                     ! Except if * Erosion
+     .                        sign(unun,0.50            ! dominates
+     .                                 -dsnbSV(ikl)))   !
+     .                   +max(zero,                     ! Allows to create
+     .                        sign(unun,BufsSV(ikl)     ! a new snow Layer
+     .                                 -SMndSV*3.00)))  ! is Buffer > SMndSV*3
+            Bdzssv(ikl) = 1.e-3*BufsSV(ikl)*ro_Wat      ! [mm w.e.] -> [m w.e.]
+     .                            /max(epsi,BrosSV(ikl))!& [m w.e.] -> [m]
+ 
+
+ 
+          END DO
+ 
+
+
+! Snow Pack Discretization
+! ========================
+
+!            **********
+        call SISVAT_zSn
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_zSn  ',0)
+!            **********
+
+
+
+! Add a new Snow Layer
+! ====================
+
+          DO ikl=1,knonv
+
+            isnoSV(ikl)     = isnoSV(ikl)         +NLaysv(ikl)
+            isn             = isnoSV(ikl)
+            dzsnSV(ikl,isn) = dzsnSV(ikl,isn) * (1-NLaysv(ikl))
+     .                      + Bdzssv(ikl)     *    NLaysv(ikl) 
+            TsisSV(ikl,isn) = TsisSV(ikl,isn) * (1-NLaysv(ikl))
+     .                  + min(TaT_SV(ikl),Tf_Sno) *NLaysv(ikl) 
+
+            ro__SV(ikl,isn) = ro__SV(ikl,isn) * (1-NLaysv(ikl))
+     .                      + Brossv(ikl)     *    NLaysv(ikl) 
+            eta_SV(ikl,isn) = eta_SV(ikl,isn) * (1-NLaysv(ikl))   ! + 0. 
+            agsnSV(ikl,isn) = agsnSV(ikl,isn) * (1-NLaysv(ikl))   ! + 0. 
+            G1snSV(ikl,isn) = G1snSV(ikl,isn) * (1-NLaysv(ikl))
+     .                      + BG1ssv(ikl)     *    NLaysv(ikl)
+            G2snSV(ikl,isn) = G2snSV(ikl,isn) * (1-NLaysv(ikl))
+     .                      + BG2ssv(ikl)     *    NLaysv(ikl)
+            istoSV(ikl,isn) = istoSV(ikl,isn) * (1-NLaysv(ikl))
+     .   + max(zer0,sign(un_1,TaT_SV(ikl)
+     .                       -Tf_Sno-eps_21)) *    istdSV(2)
+     .                                        *    NLaysv(ikl)
+            BufsSV(ikl)     = BufsSV(ikl)     * (1-NLaysv(ikl))
+            NLaysv(ikl)     = 0
+
+
+          END DO
+
+
+! Snow Pack Thickness
+! -------------------
+
+        DO ikl=1,knonv
+            z_snsv(ikl)     = 0.0
+        END DO
+        DO   isn=1,nsno
+          DO ikl=1,knonv
+            z_snsv(ikl)     = z_snsv(ikl) + dzsnSV(ikl,isn)
+            zzsnsv(ikl,isn) = z_snsv(ikl)
+          END DO
+        END DO
+
+
+
+      END IF
+
+
+
+! Soil Albedo: Soil Humidity Correction
+! ==========================================
+
+!         REFERENCE: McCumber and Pielke (1981), Pielke (1984)
+!         ^^^^^^^^^
+          DO ikl=1,knonv
+            albssv(ikl) = 
+     .      alb0SV(ikl) *(1.0-min(half,eta_SV(       ikl,0)
+     .                                /etadSV(isotSV(ikl))))
+!         REMARK:    Albedo of Water Surfaces (isotSV=0): 
+!         ^^^^^^     alb0SV := 2  X  effective value, while 
+!                    eta_SV :=          etadSV
+          END DO
+
+
+! Snow Pack Optical Properties
+! ============================
+
+      IF (SnoMod)                                                 THEN
+
+!            ******
+        call SnOptP(jjtime)
+!            ******
+
+      ELSE
+        DO ikl=1,knonv
+          sEX_sv(ikl,1) = 1.0
+          sEX_sv(ikl,0) = 0.0
+          albisv(ikl)   = albssv(ikl)
+        END DO
+      END IF
+
+
+
+! Soil optical properties
+! =============================
+!Etienne: as in inlandis we do not call vgopt, we need to define
+!the albedo  alb_SV and to calculate the
+!absorbed Solar Radiation by Surfac (Normaliz)[-] SoSosv
+
+ 
+      DO ikl=1,klonv
+
+            e_pRad = 2.5   *  coszSV(ikl)       ! exponential argument,
+                                                ! V/nIR radiation partitioning,
+                                                ! DR97, 2, eqn (2.53) & (2.54)
+            e1pRad = 1.-exp(-e_pRad)            ! exponential, V/nIR Rad. Part.
+            exdRad= 1.
+ 
+! Visible Part of the Solar Radiation Spectrum (V,   0.4--0.7mi.m) 
+            A_Rad0 =      0.25 + 0.697 * e1pRad ! Absorbed    Vis. Radiation
+            absg_V = (1.-albisv(ikl))*(A_Rad0*exdRad)  !
+ 
+! Near-IR Part of the Solar Radiation Spectrum (nIR, 0.7--2.8mi.m)
+ 
+            A_Rad0 =      0.80 + 0.185 * e1pRad ! Absorbed    nIR. Radiation
+            absgnI = (1.-albisv(ikl))*(A_Rad0*exdRad)  !
+
+            SoSosv(ikl) = (absg_V+absgnI)*0.5d0
+
+            alb_SV(ikl) = albisv(ikl)
+
+      END DO
+ 
+!            **********
+! #ve   call SISVAT_wEq('SnOptP',0)
+!            **********
+
+
+! Surface Emissivity (Etienne: simplified calculation for landice)
+! =============================================================
+!
+       DO ikl=1,knonv
+            LSnMsk     =     min( 1,isnoSV(ikl))
+            Eso_sv(ikl)=  EmiSol*(1-LSnMsk)+EmiSno*LSnMsk  ! Sol+Sno Emissivity
+            emi_SV(ikl)= EmiSol*(1-LSnMsk) + EmiSno*LSnMsk
+        END DO
+
+
+
+
+!  Upward IR (INPUT, from previous time step)
+! ===================================================================
+
+        DO ikl=1,knonv
+! #e1     Enrsvd(ikl) =    - IRs_SV(ikl)
+           IRupsv(ikl) =      IRs_SV(ikl) 
+        END DO
+
+
+! Turbulence
+! ==========
+
+! Latent Heat of Vaporization/Sublimation
+! ---------------------------------------
+
+        DO ikl=1,knonv
+          SnoWat      =                     min(isnoSV(ikl),0)
+          Lx_H2O(ikl) =
+     .    (1.-SnoWat) * LhvH2O 
+     .  +     SnoWat  *(LhsH2O * (1.-eta_SV(ikl,isnoSV(ikl)))
+     .                 +LhvH2O *     eta_SV(ikl,isnoSV(ikl)) )
+        END DO
+
+
+
+
+! Aerodynamic Resistance
+! ^^^^^^^^^^^^^^^^^^^^^^
+
+
+       DO ikl=1,knonv
+          ram_sv(ikl) = 1./(cdM_SV(ikl)*max(VV__SV(ikl),eps6))
+          rah_sv(ikl) = 1./(cdH_SV(ikl)*max(VV__SV(ikl),eps6))
+        END DO
+
+
+
+! Soil   Energy Balance
+! =====================
+
+
+      if (iflag_tsurf_inlandsis .eq. 0) then
+
+       call SISVAT_TSo
+
+      else
+
+       call SISVAT_TS2
+
+      end if
+
+
+!            **********
+! #ve   call SISVAT_wEq('_TSo  ',0)
+!            **********
+
+
+
+! Soil Water     Potential
+! ------------------------
+
+      DO   isl=-nsol,0
+        DO ikl=1,knonv
+          ist             =     isotSV(ikl)        ! Soil Type
+          psi_sv(ikl,isl) =     psidSV(ist)        ! DR97, Eqn.(3.34)
+     .  *(etadSV(ist) /max(eps6,eta_SV(ikl,isl)))  !
+     .  **bCHdSV(ist)                              !
+
+
+! Soil Hydraulic Conductivity
+! ---------------------------
+
+          Khydsv(ikl,isl) =    s2__SV(ist)         ! DR97, Eqn.(3.35)
+     .  *(eta_SV(ikl,isl)**(2.*bCHdSV(ist)+3.))    !  
+        END DO
+      END DO
+
+
+! Melting / Refreezing in the Snow Pack
+! =====================================
+
+      IF (SnoMod)                                                 THEN
+
+!            **********
+        call SISVAT_qSn
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_qSn  ',0)
+!            **********
+
+
+! Snow Pack Thickness
+! -------------------
+
+          DO ikl=1,knonv
+            z_snsv(ikl)     = 0.0
+          END DO
+        DO   isn=1,nsno
+          DO ikl=1,knonv
+            z_snsv(ikl)     = z_snsv(ikl) + dzsnSV(ikl,isn)
+            zzsnsv(ikl,isn) = z_snsv(ikl)
+          END DO
+        END DO
+
+
+! Energy in Excess is added to the first Soil Layer
+! -------------------------------------------------
+        DO ikl=1,knonv
+            z_snsv(ikl)   = max(zer0,
+     .                          sign(un_1,eps6-z_snsv(ikl)))
+            TsisSV(ikl,0) = TsisSV(ikl,0)    + EExcsv(ikl)
+     .                                       /(rocsSV(isotSV(ikl))
+     .                                        +rcwdSV*eta_SV(ikl,0))
+            EExcsv(ikl)   = 0.
+        END DO
+
+
+      END IF
+
+
+! Soil   Water  Balance
+! =====================
+
+!            **********
+        call SISVAT_qSo
+! #m0.                 (Wats_0,Wats_1,Wats_d)
+!            **********
+
+
+! Surface Fluxes
+! =====================
+
+        DO ikl=1,knonv
+         IRdwsv(ikl)=IRd_SV(ikl)*Eso_sv(ikl) ! Downward IR
+!         IRdwsv(ikl)=tau_sv(ikl) *IRd_SV(ikl)*Eso_sv(ikl) ! Downward IR
+!    .          +(1.0-tau_sv(ikl))*IRd_SV(ikl)*Evg_sv(ikl) !  ! Etienne, remove vegetation component
+          IRupsv(ikl) =      IRupsv(ikl)                   ! Upward   IR
+          IRu_SV(ikl) =     -IRupsv(ikl)                   ! Upward   IR
+     .                      +IRd_SV(ikl)                   ! (effective)
+     .                      -IRdwsv(ikl)                   ! (positive)
+
+          TBr_sv(ikl) =sqrt(sqrt(IRu_SV(ikl)/StefBo))      ! Brightness
+!                                                          ! Temperature
+          uts_SV(ikl) =     (HSv_sv(ikl) +HSs_sv(ikl))     ! u*T*
+     .                     /(rhT_SV(ikl) *cp)          !
+          uqs_SV(ikl) =     (HLv_sv(ikl) +HLs_sv(ikl))     ! u*q*
+     .                     /(rhT_SV(ikl) *LhvH2O)          !
+          LMO_SV(ikl) = TaT_SV(ikl)*(us__SV(ikl)**3)
+     .                     /gravit/uts_SV(ikl)/vonKrm      ! MO length
+     
+
+! Surface Temperature
+! ^^^^^^^^^^^^^^^^^^^^
+!           Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
+
+! Etienne: extrapolation from the two uppermost levels:
+
+         if (isnoSV(ikl) >=2) then
+           zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
+           zm2=-(dzsnSV(ikl,isnoSV(ikl)) + dzsnSV(ikl,isnoSV(ikl)-1)/2.)
+         else if (isnoSV(ikl) .EQ. 1) then
+           zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
+           zm2=-(dzsnSV(ikl,isnoSV(ikl))+dz_dSV(0)/2.)
+         else
+           zm1=-dz_dSV(0)/2.
+           zm2=-(dz_dSV(0)+dz_dSV(-1)/2.)
+
+         end if
+
+           coefslope=(TsisSV(ikl,isnoSV(ikl))-TsisSV(ikl,isnoSV(ikl)-1)) 
+     .               /(zm1-zm2)
+           Tsrfsv(ikl)=TsisSV(ikl,isnoSV(ikl))+coefslope*(0. - zm1)
+
+
+        END DO
+
+
+! Snow Pack Properties (sphericity, dendricity, size)
+! ===================================================
+
+      IF (SnoMod)                                                 THEN
+
+!            **********
+        call SISVAT_GSn
+!            **********
+
+!            **********
+! #ve   call SISVAT_wEq('_GSn  ',0)
+!            **********
+
+
+
+      END IF
+
+
+! Roughness Length for next time step
+!====================================
+
+! Note that in INLANDSIS, we treat only ice covered surfaces so calculation
+! of z0 is much simpler (no subgrid fraction of ocean or land)
+! old calculations are commented below
+
+
+C +--Roughness Length for Momentum
+C +  -----------------------------
+ 
+C +--Land+Sea-Ice / Ice-free Sea Mask
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=1,klonv
+          IcIndx(ikl) = 0
+        ENDDO
+        DO isn=1,nsno
+        DO ikl=1,klonv
+          IcIndx(ikl) = max(IcIndx(ikl),
+     .                      isn*max(0,
+     .                              sign(1,
+     .                                   int(ro__SV(ikl,isn)-900.))))
+        ENDDO
+        ENDDO
+ 
+        DO ikl=1,klonv
+          LISmsk    =     1. ! in inlandsis, land only
+          IceMsk    =     max(0,sign(1   ,IcIndx(ikl)-1)  )
+          SnoMsk    = max(min(isnoSV(ikl)-iiceSV(ikl),1),0)
+
+ 
+
+          Z0mLnd      =max( Z0_ICE    ,    5.e-5  )  ! Min set := Z0 on *
+
+C +--Z0 Smooth Regime over Snow (Andreas 1995, CRREL Report 95-16, p. 8)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0m_nu =       5.e-5 ! z0s~(10-d)*exp(-vonkar/sqrt(1.1e-03))
+ 
+C +--Z0 Saltat.Regime over Snow (Gallee  et al., 2001, BLM 99 (19) p.11)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          u2star =       us__SV(ikl) *us__SV(ikl)
+          Z0mBSn =       u2star      *0.536e-3   -  61.8e-6
+          Z0mBSn =   max(Z0mBS0      ,Z0mBSn)
+ 
+C +--Z0 Smooth + Saltat. Regime
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0enSV(ikl) =  Z0m_nu
+     .                +  Z0mBSn
+ 
+C +--Rough   Snow Surface Roughness Length (Typical Value)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #tz     Z0m_Sn =    0.250e-3 ! Andreas 1995, CRREL Report 95-16, fig.1&p.2
+                               ! z0r~(10-d)*exp(-vonkar/sqrt(1.5e-03))-5.e-5
+          Z0m_Sn =    2.000e-3 ! Calibration    of MAR
+c #TZ     Z0m_Sn =    1.000e-3 ! Exemple Tuning in RACMO
+c #TZ     Z0m_Sn =    0.500e-3 ! Exemple Tuning in MAR
+ 
+C +--Rough   Snow Surface Roughness Length (Variable Sastrugi Height)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          A_Fact      =  1.0000        ! Andreas et al., 2004, p.4
+                                       ! ams.confex.com/ams/pdfpapers/68601.pdf
+ 
+! Parameterization of z0 dependance on Temperature (C. Amory, 2017)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Z0=f(T) deduced from observations, Adelie Land, dec2012-dec2013
+          coefa = 0.1658 !0.1862 !Ant
+          coefb = -50.3869 !-55.7718 !Ant
+          ta1 = 253.15 !255. Ant
+          ta2 = 273.15
+          ta3 = 273.15+3
+          z01 = exp(coefa*ta1 + coefb) !~0.2 ! ~0.25 mm
+          z02 = exp(coefa*ta2 + coefb) !~6  !~7 mm
+          z03 = z01
+          coefc = log(z03/z02)/(ta3-ta2)
+          coefd = log(z03)-coefc*ta3
+          if (TaT_SV(ikl) .lt. ta1) then
+            Z0_obs = z01
+          else if (TaT_SV(ikl).ge.ta1 .and. TaT_SV(ikl).lt.ta2) then
+            Z0_obs = exp(coefa*TaT_SV(ikl) + coefb)
+          else if (TaT_SV(ikl).ge.ta2 .and. TaT_SV(ikl).lt.ta3) then
+            ! if st > 0, melting induce smooth surface
+            Z0_obs = exp(coefc*TaT_SV(ikl) + coefd)
+          else
+            Z0_obs = z03
+          endif
+ 
+
+! pour le moment, on choisit une valeur fixe
+          Z0_obs = 1.000e-3
+ 
+cCA       Snow roughness lenght deduced from observations
+cCA       (parametrization if no Blowing Snow)
+cCA       ----------------------------------- C. Agosta 09-2016 -----
+cCA       Substract Z0enSV(ikl) because re-added later in Z0mnSV(ikl)
+          Z0m_Sn = Z0_obs - Z0enSV(ikl)
+cCA       -----------------------------------------------------------
+ 
+          param = Z0_obs/1. ! param(s) | 1.(m/s)=TUNING
+ 
+c #SZ     Z0Sa_N =                   (us__SV(ikl) -0.2)*param   ! 0.0001=TUNING
+c #SZ.           * max(zero,sign(unun,TfSnow-eps9
+c #SZ.                               -TsisSV(ikl , isnoSV(ikl))))
+!!#SZ     Z0SaSi = max(zero,sign(unun,Z0Sa_N                  ))! 1 if erosion
+c #SZ     Z0SaSi = max(zero,sign(unun,zero  -eps9 -uss_SV(ikl)))!
+c #SZ     Z0Sa_N = max(zero,          Z0Sa_N)
+c #SZ     Z0SaSV(ikl) =
+c #SZ.             max(Z0SaSV(ikl)   ,Z0SaSV(ikl)
+c #SZ.               + Z0SaSi*(Z0Sa_N-Z0SaSV(ikl))*exp(-dt__SV/43200.))
+c #SZ.               -            min(dz0_SV(ikl) ,     Z0SaSV(ikl))
+ 
+c #SZ     A_Fact      =               Z0SaSV(ikl) *  5.0/0.15   ! A=5 if h~10cm
+C +...    CAUTION: The influence of the sastrugi direction is not yet included
+ 
+c #SZ     Z0m_Sn =                    Z0SaSV(ikl)               !
+c #SZ.                              - Z0m_nu                    !
+ 
+C +--Z0 Saltat.Regime over Snow (Shao & Lin, 1999, BLM 91 (46)  p.222)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #ZN     sqrrZ0 =       usthSV(ikl)/max( us__SV(ikl),0.001)
+c #ZN     sqrrZ0 =                   min( sqrrZ0     ,0.999)
+c #ZN     Z0mBSn =       0.55 *0.55 *exp(-sqrrZ0     *sqrrZ0)
+c #ZN.                  *us__SV(ikl)*     us__SV(ikl)*grvinv*0.5
+ 
+C +--Z0 Smooth + Saltat. Regime (Shao & Lin, 1999, BLM 91 (46)  p.222)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #ZN     Z0enSV(ikl) = (Z0m_nu     **    sqrrZ0 )
+c #ZN.                * (Z0mBSn     **(1.-sqrrZ0))
+c #ZN     Z0enSV(ikl) =  max(Z0enSV(ikl), Z0m_nu)
+ 
+C +--Z0 Smooth Regime over Snow (Andreas etAl., 2004
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
+c #ZA     Z0m_nu = 0.135*akmol  / max(us__SV(ikl) , epsi)
+ 
+C +--Z0 Saltat.Regime over Snow (Andreas etAl., 2004
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
+c #ZA     Z0mBSn = 0.035*u2star      *grvinv
+ 
+C +--Z0 Smooth + Saltat. Regime (Andreas etAl., 2004
+!    (      used by Erosion)     ams.confex.com/ams/pdfpapers/68601.pdf)
+!    ^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #ZA     Z0enSV(ikl) =  Z0m_nu
+c #ZA.                +  Z0mBSn
+ 
+C +--Z0 Rough  Regime over Snow (Andreas etAl., 2004
+C +  (.NOT. used by Erosion)     ams.confex.com/ams/pdfpapers/68601.pdf)
+!    ^^^^^^^^^^^^^^^^^^^^^^^^^^
+!!#ZA     u2star =      (us__SV(ikl) -0.1800)     / 0.1
+!!#ZA     Z0m_Sn =A_Fact*Z0mBSn *exp(-u2star*u2star)
+c #ZA     Z0m_90 =(10.-0.025*VVs_SV(ikl)/5.)
+c #ZA.            *exp(-0.4/sqrt(.00275+.00001*max(0.,VVs_SV(ikl)-5.)))
+c #ZA     Z0m_Sn =           DDs_SV(ikl)* Z0m_90 / 45.
+c #ZA.         - DDs_SV(ikl)*DDs_SV(ikl)* Z0m_90 /(90.*90.)
+ 
+C +--Z0  (Erosion)    over Snow (instantaneous or time average)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0e_SV(ikl) =  Z0enSV(ikl)
+          Z0e_SV(ikl) =  Z0emSV(ikl)
+ 
+C +--Momentum  Roughness Length
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^                              ! Contribution of
+          Z0mnSV(ikl) =  Z0mLnd                              ! land Form
+     .                + (Z0m_Sn                              ! Sastrugi   Form
+     .                +  Z0enSV(ikl))   *SnoMsk              ! Snow    Erosion
+ 
+
+C +--GIS  Roughness Length
+C +  ^^^^^^^^^^^^^^^^^^^^^
+c #GL     Z0mnSV(ikl) =
+c #GL.      (1-LSmask(ikl)) *     Z0mnSV(ikl)
+c #GL.    +    LSmask(ikl)  * max(Z0mnSV(ikl),max(Z0_GIM,
+c #GL.                                            Z0_GIM+
+c #GL.      (0.0032-Z0_GIM)*(ro__SV(ikl,isnoSV(ikl))-600.)   !
+c #GL.                     /(920.00                 -600.))) !
+ 
+C +--Mom. Roughness Length, Instantaneous OR Box Moving Average in Time
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          Z0m_SV(ikl) =  Z0mnSV(ikl)                         ! Z0mnSV  instant.
+!          Z0m_SV(ikl) =  Z0mmSV(ikl)                         ! Z0mnSV  Average
+ 
+C +--Corrected Threshold Friction Velocity before Erosion    ! Marticorena and
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^    ! Bergametti 1995
+! not used anymore since Marticorena and Bergametti disabled !CK 18/07/2018
+cc #BS     Z0e_SV(ikl) =   min(Z0m_SV(ikl),Z0e_SV(ikl))       !
+cc #MB     f_eff=    log(0.35*(0.1        /Z0e_SV(ikl))**0.8) ! JGR 100
+cc #MB     f_eff=1.-(log(      Z0m_SV(ikl)/Z0e_SV(ikl)      ))! (20) p. 16420
+cc #MB.            /(max(      f_eff      ,epsi             ))! p.16426 2nd ?
+cc #MB     f_eff=    max(      f_eff      ,epsi              )! CONTROL
+cc #MB     f_eff=1.0   -(1.0 - f_eff)     /5.00               ! TUNING
+cc #MB     f_eff=    min(      f_eff      ,1.00              )!
+cc #MB    usthSV(ikl) =       usthSV(ikl)/f_eff              !
+ 
+ 
+ 
+C +--Roughness Length for Scalars
+C +  ----------------------------
+ 
+          Z0hnSV(ikl) =     Z0mnSV(ikl)/  7.4
+c #SH     Z0hnSV(ikl) =     Z0mnSV(ikl)/100.0
+C +                         Z0h = Z0m  /100.0   over the Sahel
+C +                                            (Taylor & Clark, QJRMS 127,p864)
+ 
+c #RN     rstar       =     Z0mnSV(ikl) * us__SV(ikl) / akmol
+c #RN     rstar       = max(epsi,min(rstar,thous))
+c #RN     alors       =          log(rstar)
+c #RN     rstar0      = 1.250e0 * max(zero,sign(unun,0.135e0 - rstar))
+c #RN.                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
+c #RN.                *(0.149e0 * max(zero,sign(unun,2.500e0 - rstar))
+c #RN.                + 0.317e0
+c #RN.                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
+c #RN     rstar1      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
+c #RN.                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
+c #RN.                *(-0.55e0 * max(zero,sign(unun,2.500e0 - rstar))
+c #RN.                - 0.565
+c #RN.                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
+c #RN     rstar2      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
+c #RN.                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
+c #RN.                *(0.      * max(zero,sign(unun,2.500e0 - rstar))
+c #RN.                - 0.183
+c #RN.                *(unun    - max(zero,sign(unun,2.500e0 - rstar))))
+ 
+cXF    #RN does not work over bare ice
+cXF    MAR is then too warm and not enough melt
+ 
+c #RN     if(ro__SV(ikl,isnoSV(ikl))>50
+c #RN.  .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)then
+ 
+c #RN     Z0hnSV(ikl) = max(zero
+c #RN.                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi))
+c #RN.                * exp(rstar0+rstar1*alors+rstar2*alors*alors)
+c #RN.                * 0.001e0 + Z0hnSV(ikl) * ( 1. - max(zero
+c #RN.                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)))
+ 
+c #RN     endif
+  
+          Z0h_SV(ikl) =     Z0hnSV(ikl)
+!          Z0h_SV(ikl) =     Z0hmSV(ikl)
+ 
+
+c #MT     Z0m_SV(ikl) = max(2.0e-6     ,Z0m_SV(ikl)) ! Min Z0_m (Garrat Scheme)
+!          Z0m_SV(ikl) = min(Z0m_SV(ikl),za__SV(ikl)*0.3333)
+     
+
+       END DO
+ 
+
+       return
+       end
+
+
+
+
+
+
+
+
+
+
+ 
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_bsn.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_bsn.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_bsn.F	(revision 3851)
@@ -0,0 +1,114 @@
+ 
+ 
+      subroutine SISVAT_BSn
+ 
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_BSn                               04-apr-2020  MAR |
+C |   SubRoutine SISVAT_BSn treats Snow Erosion                            |
+C |   (not deposition anymore since 2-jun 2018)                            |
+C |                                                                        |
+C |   SISVAT_bsn computes the snow erosion mass according to both the      |
+C |   theoretical maximum erosion amount computed in SISVATesbl and the    |
+C |   availability of snow (currently in the uppermost snow layer only)    |
+C |                                                                        |
+C |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+C |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+C |   FILE                 |      CONTENT                                  |
+C |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+C | # stdout               | #sb: OUTPUT of Snow Erosion                   |
+C |                        |      unit  6, SubRoutine  SISVAT_BSn **ONLY** |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--General Variables
+C +  =================
+
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VARxSV
+      use VARySV
+ 
+ 
+       IMPLICIT NONE
+
+C +--Local Variables
+C +  ===============
+ 
+ 
+      integer  ikl   ,isn
+      real     h_mmWE                        ! Eroded Snow Layer Min Thickness
+      real     dbsaux(knonv)                 ! Drift Amount   (Dummy Variable)
+      real     dzweqo,dzweqn,bsno_x          ! Conversion variables for erosion
+      real     dz_new,rho_new
+      real     snofOK                        ! Threshd Snow Fall
+      real     Fac                           ! Correction factor for erosion
+      real     densif                        ! Densification rate if erosion
+ 
+C +--DATA
+C +  ====
+ 
+      data     h_mmWE  / 0.01e00  /          ! Eroded Snow Layer Min Thickness
+ 
+C +--EROSION
+C +  =======
+ 
+      !DO isn = nsno,2,-1
+      DO ikl = 1,knonv
+ 
+        isn         = isnoSV(ikl)
+        dzweqo      = dzsnSV(ikl,isn) *ro__SV(ikl,isn)      ! [kg/m2, mm w.e.]
+ 
+        bsno_x      = min(0.,dbs_SV(ikl))
+c       Fac         = min(1.,max(1-(ro__SV(ikl,isn)/700.),0.)**2)
+c       Fac         = min(1.,max(1-(qsnoSV(ikl)*1000/30.),0.))
+c       bsno_x      = bsno_x*Fac
+ 
+        dzweqn      = dzweqo + bsno_x
+        dzweqn      = max(dzweqn,h_mmWE)
+        dzweqn      = min(dzweqn,dzweqo)
+cXF
+        dbs_SV(ikl) = dbs_SV(ikl)    +(dzweqo -dzweqn)
+        dbs_Er(ikl) = dbs_Er(ikl)    +(dzweqo -dzweqn)
+        dzsnSV(ikl,isn) =              dzweqn
+     .                       /max(epsi,ro__SV(ikl,isn))
+ 
+        ! Densification of the uppermost snow layer if erosion:
+        if((dzweqo-dzweqn)>0                    .and.
+     .     dzsnSV(ikl,isn)>0                    .and.
+     .     ro__SV(ikl,max(1,isnoSV(ikl)))<roBdSV) then
+ 
+        !characteristic time scale for drifting snow compaction set to 24h
+        !linear densification rate [kg/m3/s] over 24h
+        densif         = (450. - frsno) / (3600*24)
+ 
+        !Attenuation of compaction rate from 450 to 500 kg/m3
+        Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl)))
+     .                        -roBdSV)/(500.-roBdSV))
+        Fac         = max(0.,min(1.,Fac))
+ 
+        if (ro__SV(ikl,max(1,isnoSV(ikl)))>roBdSV) then
+          densif=densif*Fac
+        endif
+ 
+        rho_new        = min(roBdSV,ro__SV(ikl,isn)+densif*dt__SV)
+        dz_new         = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/rho_new
+        ro__SV(ikl,isn)=rho_new
+        dzsnSV(ikl,isn)=dz_new
+        endif
+ 
+        if(dzsnSV(ikl,isn)>0 .and.dzsnSV(ikl,isn)<0.0001)then
+        dbs_SV(ikl) = dbs_SV(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
+        dbs_Er(ikl) = dbs_Er(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
+        dzsnSV(ikl,isn) = 0
+        ro__SV(ikl,isn) = 0
+        isnoSV(ikl)     = max(0,isnoSV(ikl) - 1)
+        endif
+ 
+      END DO
+      !END DO
+ 
+      return
+      END
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_gsn.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_gsn.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_gsn.F	(revision 3851)
@@ -0,0 +1,925 @@
+  
+      subroutine SISVAT_GSn
+ 
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_GSn                                20-09-2003  MAR |
+C |   SubRoutine SISVAT_GSn simulates SNOW Metamorphism                    |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  knonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+C |                     X       Number of Mosaic Cell per grid box         |
+C |                                                                        |
+C |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
+C |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
+C |   ^^^^^^   istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+C |                                                                        |
+C |   INPUT:   TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+C |   ^^^^^             & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+C |            ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+C |            eta_SV   : Soil/Snow Water   Content                [m3/m3] |
+C |            slopSV   : Surface Slope                                [-] |
+C |            dzsnSV   : Snow Layer        Thickness                  [m] |
+C |            dt__SV2   : Time  Step                                   [s] |
+C |                                                                        |
+C |   INPUT /  G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+C |   OUTPUT:  G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+C |   ^^^^^^                                                               |
+C |                                                                        |
+C |   Formalisme adopte pour la Representation des Grains:                 |
+C |   Formalism         for the Representation of  Grains:                 |
+C |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                 |
+C |                                                                        |
+C |             1       - -1                 Neige Fraiche                 |
+C |            / \      |                    -------------                 |
+C |           /   \     |  Dendricite        decrite  par Dendricite       |
+C |          /     \    |  Dendricity                  et Sphericite       |
+C |         /       \   |                                                  |
+C |        2---------3  -  0                 described by Dendricity       |
+C |                                                   and Sphericity       |
+C |        |---------|                                                     |
+C |        0         1                                                     |
+C |        Sphericite                                                      |
+C |        Sphericity                                                      |
+C |                                                                        |
+C |        4---------5  -                                                  |
+C |        |         |  |                                                  |
+C |        |         |  |  Diametre (1/10eme de mm) (ou Taille)            |
+C |        |         |  |  Diameter (1/10th  of mm) (or Size  )            |
+C |        |         |  |                                                  |
+C |        |         |  |                    Neige non dendritique         |
+C |        6---------7  -                    ---------------------         |
+C |                                          decrite  par Sphericite       |
+C |                                                    et     Taille       |
+C |                                          described by Sphericity       |
+C |                                                   and       Size       |
+C |                                                                        |
+C |   Les Variables du Modele:                                             |
+C |   Model         Variables:                                             |
+C |   ^^^^^^^^^^^^^^^^^^^^^^^^                                             |
+C |     Cas Dendritique               Cas non Dendritique                  |
+C |                                                                        |
+C |     G1snSV        : Dendricite    G1snSV        : Sphericite           |
+C |     G2snSV        : Sphericite    G2snSV        : Taille (1/10e mm)    |
+C |                                                   Size                 |
+C |                                                                        |
+C |   Cas Dendritique/ Dendritic Case                                      |
+C |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                                      |
+C |   Dendricite(Dendricity) G1snSV                                        |
+C |            varie     de -G1_dSV (-99 par defaut / etoile)          a 0 |
+C |            division par -G1_dSV pour obtenir des valeurs entre 1  et 0 |
+C |            varies  from -G1_dSV (default -99    / fresh snow)     to 0 |
+C |            division  by -G1_dSV to obtain values       between 1 and 0 |
+C |                                                                        |
+C |   Sphericite(Sphericity) G2snSV                                        |
+C |            varie     de  0         (cas completement anguleux)         |
+C |                       a  G1_dSV (99 par defaut, cas spherique)         |
+C |            division par  G1_dSV pour obtenir des valeurs entre 0  et 1 |
+C |            varies  from  0      (full faceted)               to G1_dSV |
+C |                                                                        |
+C |   Cas non Dendritique / non Dendritic Case                             |
+C |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                             |
+C |   Sphericite(Sphericity) G1snSV                                        |
+C |            varie     de  0         (cas completement anguleux)         |
+C |                       a  G1_dSV (99 par defaut, cas spherique)         |
+C |            division par  G1_dSV pour obtenir des valeurs entre 0  et 1 |
+C |            varies  from  0      (full faceted)               to G1_dSV |
+C |                                                                        |
+C |   Taille    (Size)       G2snSV                                        |
+C |            superieure a  ADSdSV (.4 mm) et ne fait que croitre         |
+C |            greater than  ADSdSV (.4 mm) always increases               |
+C |                                                                        |
+C |   Exemples: Points caracteristiques des Figures ci-dessus              |
+C |   ^^^^^^^^^                                                            |
+C |                                                                        |
+C |               G1snSV    G2snSV     dendricite  sphericite  taille      |
+C |                                    dendricity  sphericity  size        |
+C |   ------------------------------------------------------------------   |
+C |                                                            [1/10 mm]   |
+C |     1        -G1_dSV    sph3SN          1           0.5                |
+C |     2           0         0             0           0                  |
+C |     3           0       G1_dSV          0           1                  |
+C |     4           0       ADSdSV                      0       4.         |
+C |     5         G1_dSV    ADSdSV-vsphe1               1       3.         |
+C |     6           0         --                        0       --         |
+C |     7         G1_dSV      --                        1       --         |
+C |                                                                        |
+C |   par defaut: G1_dSV=99.                                               |
+C |                         sph3SN=50.                                     |
+C |                         ADSdSV= 4.                                     |
+C |                                vsphe1=1.                               |
+C |                                                                        |
+C |   Methode:                                                             |
+C |   ^^^^^^^^                                                             |
+C |   1. Evolution Types de Grains selon Lois de Brun et al. (1992):       |
+C |      Grain metamorphism according to         Brun et al. (1992):       |
+C |      Plusieurs Cas sont a distiguer  /  the different Cases are:       |
+C |       1.1 Metamorphose Neige humide  /  wet Snow                       |
+C |       1.2 Metamorphose Neige seche   /  dry Snow                       |
+C |         1.2.1 Gradient faible        /  low      Temperature Gradient  |
+C |         1.2.2 Gradient moyen         /  moderate Temperature Gradient  |
+C |         1.2.3 Gradient fort          /  high     Temperature Gradient  |
+C |      Dans chaque Cas on separe Neige Dendritique et non Dendritique    |
+C |                           le Passage Dendritique -> non Dendritique    |
+C |                           se fait lorsque  G1snSV devient > 0          |
+C |      the Case of Dentritic or non Dendritic Snow is treated separately |
+C |      the Limit   Dentritic -> non Dendritic is reached when G1snSV > 0 |
+C |                                                                        |
+C |   2. Tassement: Loi de Viscosite adaptee selon le Type de Grains       |
+C |      Snow Settling:    Viscosity depends on the   Grain Type           |
+C |                                                                        |
+C |   3. Update Variables historiques (cas non dendritique seulement)      |
+C |      nhSNow defaut                                                     |
+C |                0    Cas normal                                         |
+C |      istdSV(1) 1    Grains anguleux / faceted cristal                  |
+C |      istdSV(2) 2    Grains ayant ete en presence d eau liquide         |
+C |                     mais n'ayant pas eu de caractere anguleux    /     |
+C |                     liquid water and no faceted cristals before        |
+C |      istdSV(3) 3    Grains ayant ete en presence d eau liquide         |
+C |                     ayant eu auparavant un caractere anguleux    /     |
+C |                     liquid water and    faceted cristals before        |
+C |                                                                        |
+C |   REFER. : Brun et al.      1989, J. Glaciol 35 pp. 333--342           |
+C |   ^^^^^^^^ Brun et al.      1992, J. Glaciol 38 pp.  13-- 22           |
+C |            (CROCUS Model, adapted to MAR at CEN by H.Gallee)           |
+C |                                                                        |
+C |   REFER. : Marbouty, D.     1980, J. Glaciol 26 pp. xxx--xxx           |
+C |   ^^^^^^^^ (CROCUS Model, adapted to MAR at CEN by H.Gallee)           |
+C |            (for angular shapes)                                        |
+C |                                                                        |
+C |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+C |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+C |   FILE                 |      CONTENT                                  |
+C |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+C | # SISVAT_GSn.vp        | #vp: OUTPUT/Verification: Snow   Properties   |
+C |                        |      unit 47, SubRoutines SISVAT_zSn, _GSn    |
+C | # stdout               | #wp: OUTPUT/Verification: Snow   Properties   |
+C |                        |      unit  6, SubRoutine  SISVAT_GSn          |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VAR0SV
+      use VARxSV
+      use VARtSV
+
+  
+      IMPLICIT NONE
+  
+     
+ 
+C +--INPUT/OUTPUT
+C +  ------------
+ 
+ 
+C +--OUTPUT
+C +  ------
+ 
+      integer   dt__SV2
+ 
+ 
+C +--Local  Variables
+C +  ================
+ 
+      logical   vector                        !
+      integer   ikl                           !
+      integer   isn   ,isnp                   !
+      integer   istoOK                        !
+      real      G1_bak,G2_bak                 ! Old Values of G1, G2
+      real      ro_dry(knonv,      nsno)      ! Dry Density            [g/cm3]
+      real      etaSno(knonv,      nsno)      ! Liquid Water Content   [g/cm2]
+      real      SnMass(knonv)                 ! Snow   Mass            [kg/m2]
+      real      dTsndz                        ! Temperature Gradient
+      real      sWater                        !        Water Content       [%]
+      real      exp1Wa                        !
+      real      dDENDR                        ! Dendricity Increment
+      real      DENDRn                        ! Normalized Dendricity
+      real      SPHERn                        ! Normalized Sphericity
+      real      Wet_OK                        ! Wet Metamorphism Switch
+      real      OK__DE                        !
+      real      OK__wd                        ! New G*, from wet Dendritic
+      real      G1__wd                        ! New G1, from wet Dendritic
+      real      G2__wd                        ! New G2, from wet Dendritic
+      real      OKlowT                        !
+      real      facVap                        !
+      real      OK_ldd                        !
+      real      G1_ldd                        !
+      real      G2_ldd                        !
+      real      DiamGx                        !
+      real      DiamOK                        !
+      real      No_Big                        !
+      real      dSPHER                        !
+      real      SPHER0                        !
+      real      SPHbig                        !
+      real      G1_lds                        !
+      real      OK_mdT                        !
+      real      OKmidT                        !
+      real      OKhigT                        !
+      real      OK_mdd                        !
+      real      G1_mdd                        !
+      real      G2_mdd                        !
+      real      G1_mds                        !
+      real      OK_hdd                        !
+      real      G1_hdd                        !
+      real      G2_hdd                        !
+      real      OK_hds                        !
+      real      G1_hds                        !
+      real      T1__OK,T2__OK                 !
+      real      T3_xOK,T3__OK,T3_nOK          !
+      real      ro1_OK,ro2_OK                 !
+      real      dT1_OK,dT2_OK,dT3xOK,dT3_OK   !
+      real      dT4xOK,dT4_OK,dT4nOK,AngSno   !
+      real      G2_hds,SphrOK,HISupd          !
+      real      H1a_OK,H1b_OK,H1__OK          !
+      real      H23aOK,H23bOK,H23_OK          !
+      real      H2__OK,H3__OK                 !
+      real      H45_OK,H4__OK,H5__OK          !
+      real      ViscSn,OK_Liq,OK_Ang,OKxLiq   !
+      real      dSnMas,dzsnew,rosnew,rosmax,smb_old,smb_new
+      real      zn_old,zn_new
+ 
+      real      epsi5                         ! Alpha ev67 single precision	
+      real      vdiam1                        ! Small Grains Min.Diam.[.0001m]
+      real      vdiam2                        ! Spher.Variat.Max Diam.    [mm]
+      real      vdiam3                        ! Min.Diam.|Limit Spher.    [mm]
+      real      vdiam4                        ! Min.Diam.|Viscosity Change
+      real      vsphe1                        ! Max Sphericity
+      real      vsphe2                        ! Low T Metamorphism  Coeff.
+      real      vsphe3                        ! Max.Sphericity (history=1)
+      real      vsphe4                        ! Min.Sphericity=>history=1
+      real      vtang1,vtang2,vtang3,vtang4   ! Temperature Contribution
+      real      vtang5,vtang6,vtang7,vtang8   !
+      real      vtang9,vtanga,vtangb,vtangc   !
+      real      vrang1,vrang2                 ! Density     Contribution
+      real      vgang1,vgang2,vgang3,vgang4   ! Grad(T)     Contribution
+      real      vgang5,vgang6,vgang7,vgang8   !
+      real      vgang9,vganga,vgangb,vgangc   !
+      real      vgran6                        ! Max.Sphericity for Settling
+      real      vtelv1                        ! Threshold | history = 2, 3
+      real       vvap1                        ! Vapor Pressure Coefficient
+      real       vvap2                        ! Vapor Pressure Exponent
+      real      vgrat1                        ! Boundary weak/mid   grad(T)
+      real      vgrat2                        ! Boundary mid/strong grad(T)
+      real         vfi                        ! PHI,         strong grad(T)
+      real      vvisc1,vvisc2,vvisc3,vvisc4   ! Viscosity Coefficients
+      real      vvisc5,vvisc6,vvisc7          ! id., wet Snow
+      real      rovisc                        ! Wet Snow Density  Influence
+      real        vdz3                        ! Maximum Layer Densification
+      real      OK__ws                        ! New G2
+      real      G1__ws                        ! New G1, from wet Spheric
+      real      G2__ws                        ! New G2, from wet Spheric
+      real      husi_0,husi_1,husi_2,husi_3   ! Constants for New G2
+      real      vtail1,vtail2                 ! Constants for New G2
+      real      frac_j                        ! Time Step            [Day]
+ 
+      real       vdent1                       ! Wet Snow Metamorphism
+      integer   nvdent1                       ! (Coefficients for
+      integer   nvdent2                       !           Dendricity)
+ 
+C +--Snow Properties: IO
+C +  ~~~~~~~~~~~~~~~~~~~
+! #vp real      G_curr(18),Gcases(18)
+! #vp common   /GSnLOC/    Gcases
+! #wp real                 D__MAX
+! #wp common   /GSnMAX/    D__MAX
+ 
+ 
+C +--DATA
+C +  ====
+ 
+      data       vector/.true./               ! Vectorization  Switch
+      data       vdent1/ 0.5e8/               ! Wet Snow Metamorphism
+cXF                      tuned for Greenland (2.e8=old value)
+      data      nvdent1/ 3   /                ! (Coefficients for
+      data      nvdent2/16   /                !           Dendricity)
+ 
+      data       husi_0 /20.      /           !   10  * 2
+      data       husi_1 / 0.23873 /           ! (3/4) /pi
+      data       husi_2 / 4.18880 /           ! (4/3) *pi
+      data       husi_3 / 0.33333 /           !  1/3
+      data       vtail1 / 1.28e-08/           !  Wet Metamorphism
+      data       vtail2 / 4.22e-10/           ! (NON Dendritic / Spheric)
+ 
+      data       epsi5  / 1.0e-5  /           !
+ 
+      data       vdiam1 / 4.0     /           ! Small Grains Min.Diameter
+ 
+      data       vdiam2 / 0.5     /           ! Spher.Variat.Max Diam.[mm]
+      data       vdiam3 / 3.0     /           ! Min.Diam.|Limit Spher.[mm]
+      data       vdiam4 / 2.0     /           ! Min.Diam.|Viscosity Change
+ 
+      data       vsphe1 / 1.0     /           ! Max Sphericity
+      data       vsphe2 / 1.0e9   /           ! Low T Metamorphism  Coeff.
+      data       vsphe3 / 0.5     /           ! Max.Sphericity (history=1)
+      data       vsphe4 / 0.1     /           ! Min.Sphericity=>history=1
+ 
+      data       vgran6 / 51.     /           ! Max.Sphericity for Settling
+      data       vtelv1 / 5.e-1   /           ! Threshold | history = 2, 3
+ 
+      data        vvap1 /-6.e3    /           ! Vapor Pressure Coefficient
+      data        vvap2 / 0.4     /           ! Vapor Pressure Exponent
+ 
+      data       vgrat1 /0.05     /           ! Boundary weak/mid   grad(T)
+      data       vgrat2 /0.15     /           ! Boundary mid/strong grad(T)
+      data          vfi /0.09     /           ! PHI,         strong grad(T)
+ 
+      data       vvisc1 / 0.70    /           ! Viscosity Coefficients
+      data       vvisc2 / 1.11e5  /           !
+      data       vvisc3 /23.00    /           !
+      data       vvisc4 / 0.10    /           !
+      data       vvisc5 / 1.00    /           ! id., wet Snow
+      data       vvisc6 / 2.00    /           !
+      data       vvisc7 /10.00    /           !
+      data       rovisc / 0.25    /           ! Wet Snow Density  Influence
+      data         vdz3 / 0.30    /           ! Maximum Layer Densification
+ 
+ 
+C +--DATA (Coefficient Fonction fort Gradient Marbouty)
+C +  --------------------------------------------------
+ 
+      data       vtang1 /40.0/                ! Temperature Contribution
+      data       vtang2 / 6.0/                !
+      data       vtang3 /22.0/                !
+      data       vtang4 / 0.7/                !
+      data       vtang5 / 0.3/                !
+      data       vtang6 / 6.0/                !
+      data       vtang7 / 1.0/                !
+      data       vtang8 / 0.8/                !
+      data       vtang9 /16.0/                !
+      data       vtanga / 0.2/                !
+      data       vtangb / 0.2/                !
+      data       vtangc /18.0/                !
+ 
+      data       vrang1 / 0.40/               ! Density     Contribution
+      data       vrang2 / 0.15/               !
+ 
+      data       vgang1 / 0.70/               ! Grad(T)     Contribution
+      data       vgang2 / 0.25/               !
+      data       vgang3 / 0.40/               !
+      data       vgang4 / 0.50/               !
+      data       vgang5 / 0.10/               !
+      data       vgang6 / 0.15/               !
+      data       vgang7 / 0.10/               !
+      data       vgang8 / 0.55/               !
+      data       vgang9 / 0.65/               !
+      data       vganga / 0.20/               !
+      data       vgangb / 0.85/               !
+      data       vgangc / 0.15/               !
+ 
+! #wp data       D__MAX / 4.00/               !
+ 
+ 
+C +-- 1. Metamorphoses dans les Strates
+C +      Metamorphism
+C +      ==============================
+ 
+      dt__SV2= dt__SV
+      frac_j = dt__SV2 / 86400.                        ! Time Step [Day]
+ 
+      zn4_SV = 0
+ 
+ 
+C +-- 1.1 Initialisation: teneur en eau liquide et gradient de temperature
+C +   ------------------  liquid water content and temperature gradient
+ 
+       DO ikl=1,knonv
+        DO   isn=1,isnoSV(ikl)
+ 
+          ro_dry(ikl,isn) = 1.e-3 *ro__SV(ikl,isn)    ! Dry Density
+     .                    *(1.    -eta_SV(ikl,isn))   !         [g/cm3]
+          etaSno(ikl,isn) = 1.e-1 *dzsnSV(ikl,isn)    ! Liquid Water
+     .                    *        ro__SV(ikl,isn)    ! Content [g/cm2]
+     .                    *        eta_SV(ikl,isn)    !
+        END DO
+      END DO
+ 
+c!$OMP PARALLEL DO default(firstprivate)
+c!$OMP.shared (/xSISVAT_I/,/xSISVAT_R/,/SoR0SV/,/SoI0SV/,/Sn_dSV/)
+       DO ikl=1,knonv
+        DO   isn=1,isnoSV(ikl)
+          isnp   = min(isn+1,isnoSV(ikl))
+ 
+          dTsndz = abs( (TsisSV(ikl,isnp)-TsisSV(ikl,isn-1)) *2.e-2
+     .            /max(((dzsnSV(ikl,isnp)+dzsnSV(ikl,isn)  )
+     .                 *(           isnp -           isn)
+     .                 +(dzsnSV(ikl,isn )+dzsnSV(ikl,isn-1))),epsi))
+C +...    Factor 1.d-2 for Conversion K/m --> K/cm
+ 
+ 
+C +-- 1.2 Metamorphose humide
+C +       Wet Snow Metamorphism
+C +       ---------------------
+ 
+          Wet_OK = max(zero,sign(unun,eta_SV(ikl,isn)-epsi))
+ 
+ 
+C +--     Vitesse de diminution de la dendricite
+C +       Rate of the dendricity decrease
+C +       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          sWater=1.d-1*ro__SV(ikl,isn)*eta_SV(ikl,isn)
+     .       /max(epsi,ro_dry(ikl,isn))
+C +...    sWater:Water Content [%]
+C +              1.d-1= 1.d2(1->%) * 1.d-3(ro__SV*eta_SV:kg/m3->g/cm3)
+ 
+          exp1Wa=   sWater**nvdent1
+          dDENDR=max(exp1Wa/nvdent2,vdent1*exp(vvap1/TfSnow))
+ 
+C +-- 1.2.1 Cas dendritique/dendritic Case
+C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          OK__wd=max(zero,                            !
+     .               sign(unun,-G1snSV(ikl,isn)       !
+     .                         -epsi           ))     !
+ 
+          DENDRn=-G1snSV(ikl,isn)/G1_dSV  ! Normalized Dendricity (+)
+          SPHERn= G2snSV(ikl,isn)/G1_dSV  ! Normalized Sphericity
+          DENDRn= DENDRn -dDENDR *frac_j  ! New        Dendricity (+)
+          SPHERn= SPHERn +dDENDR *frac_j  ! New        Sphericity
+ 
+          OK__DE=max(zero,                            ! IF 1.,
+     .               sign(unun, DENDRn                ! NO change
+     .                         -epsi           ))     ! Dendr. -> Spheric
+ 
+          G1__wd=OK__DE *    (      -DENDRn*G1_dSV)   ! Dendritic
+     .      +(1.-OK__DE)* min(G1_dSV,SPHERn*G1_dSV)   ! Dendr. -> Spheric
+          G2__wd=OK__DE * min(G1_dSV,SPHERn*G1_dSV)   ! Spheric
+     .      +(1.-OK__DE)*(ADSdSV-min(SPHERn,vsphe1))  ! Spher. -> Size
+ 
+C +-- 1.2.2 Cas non dendritique non completement spherique
+C +         Evolution de la Sphericite seulement.
+C +         Non dendritic and not completely spheric Case
+C +         Evolution of    Sphericity only (not size)
+C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          OK__ws=max(zero,                            !
+     .               sign(unun, G1_dSV                !
+     .                         -epsi5                 !
+     .                         -G1snSV(ikl,isn)))     !
+ 
+          SPHERn= G1snSV(ikl,isn)/G1_dSV
+          SPHERn= SPHERn +dDENDR *frac_j
+          G1__ws=         min(G1_dSV,SPHERn*G1_dSV)
+ 
+C +-- 1.2.3 Cas non dendritique et spherique / non dendritic and spheric
+C +         Evolution de la Taille seulement / Evolution of Size only
+C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          G2__ws =  husi_0
+     .           *( husi_1
+     .            *(husi_2 *( G2snSV(ikl,isn)/husi_0)**3
+     .                      +(vtail1 +vtail2 *exp1Wa    )*dt__SV2))
+     .           ** husi_3
+ 
+ 
+C +-- 1.3 Metamorposes seches / Dry Metamorphism
+C +       --------------------------------------
+ 
+ 
+C +-- 1.3.1 Calcul Metamorphose faible/low Gradient (0.00-0.05 deg/cm)
+C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          OKlowT=max(zero,                            !
+     .               sign(unun, vgrat1                !
+     .                         -dTsndz         ))     !
+ 
+          facVap=exp(vvap1/TsisSV(ikl,isn))
+ 
+C +-- 1.3.1.1 Cas dendritique / dendritic Case
+ 
+          OK_ldd=max(zero,                            !
+     .               sign(unun,-G1snSV(ikl,isn)       !
+     .                         -epsi           ))     !
+ 
+          DENDRn=-G1snSV(ikl,isn)     /G1_dSV
+          SPHERn= G2snSV(ikl,isn)     /G1_dSV
+          DENDRn= DENDRn-vdent1*facVap*frac_j
+          SPHERn= SPHERn+vsphe2*facVap*frac_j
+ 
+          OK__DE=max(zero,                            ! IF 1.,
+     .               sign(unun, DENDRn                ! NO change
+     .                         -epsi           ))     ! Dendr. -> Spheric
+ 
+          G1_ldd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
+     .       +(1.-OK__DE)* min(G1_dSV,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+          G2_ldd= OK__DE * min(G1_dSV,SPHERn*G1_dSV)  ! Spheric
+     .       +(1.-OK__DE)*(ADSdSV-min(SPHERn,vsphe1)) ! Spher. -> Size
+ 
+C +-- 1.3.1.2 Cas non dendritique / non dendritic Case
+ 
+          SPHERn=G1snSV(ikl,isn)/G1_dSV
+          DiamGx=G2snSV(ikl,isn)*0.1
+ 
+          istoOK=min( abs(istoSV(ikl,isn)-
+     .                    istdSV(1)      ),1)         ! zero if istoSV = 1
+          DiamOK=max(zero,  sign(unun,vdiam2-DiamGx))
+          No_Big=    istoOK+DiamOK
+          No_Big=min(No_Big,unun)
+ 
+          dSPHER=           vsphe2*facVap*frac_j      !
+          SPHER0=    SPHERn+dSPHER                    ! small grains
+          SPHbig=    SPHERn+dSPHER                    ! big   grains
+     .        *exp(min(zero,vdiam3-G2snSV(ikl,isn)))  ! (history = 2 or 3)
+          SPHbig=       min(vsphe3,SPHbig)            ! limited sphericity
+          SPHERn= No_Big *  SPHER0
+     .      + (1.-No_Big)*  SPHbig
+ 
+          G1_lds=       min(G1_dSV,SPHERn*G1_dSV)
+ 
+C +-- 1.3.2 Calcul Metamorphose Gradient Moyen/Moderate (0.05-0.15)
+C +         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          OK_mdT=max(zero,                            !
+     .               sign(unun, vgrat2                !
+     .                         -dTsndz))              !
+          OKmidT=               OK_mdT  *(1.-OKlowT)  !
+          OKhigT=          (1. -OK_mdT) *(1.-OKlowT)  !
+ 
+          facVap=vdent1*exp(vvap1/TsisSV(ikl,isn))
+     .                 *   (1.e2 *dTsndz)**vvap2
+ 
+C +-- 1.3.2.1 cas dendritique / dendritic case.
+ 
+          OK_mdd=max(zero,                            !
+     .               sign(unun,-G1snSV(ikl,isn)       !
+     .                         -epsi           ))     !
+ 
+          DENDRn=-G1snSV(ikl,isn)/G1_dSV
+          SPHERn= G2snSV(ikl,isn)/G1_dSV
+          DENDRn= DENDRn - facVap*frac_j
+          SPHERn= SPHERn - facVap*frac_j
+ 
+          OK__DE=max(zero,                            ! IF 1.,
+     .               sign(unun, DENDRn                ! NO change
+     .                         -epsi           ))     ! Dendr. -> Spheric
+ 
+          G1_mdd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
+     .       +(1.-OK__DE)* max(zero  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+          G2_mdd= OK__DE * max(zero  ,SPHERn*G1_dSV)  ! Spheric
+     .       +(1.-OK__DE)*(ADSdSV-max(SPHERn,zero  )) ! Spher. -> Size
+ 
+C +-- 1.3.2.2 Cas non dendritique / non dendritic Case
+ 
+          SPHERn=G1snSV(ikl,isn)/G1_dSV
+          SPHERn=         SPHERn-facVap*frac_j
+          G1_mds=max(zero,SPHERn*G1_dSV)
+ 
+C +-- 1.3.3 Calcul Metamorphose fort / high Gradient
+C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          facVap=vdent1*exp(vvap1/TsisSV(ikl,isn))
+     .                 *   (1.e2 *dTsndz)**vvap2
+ 
+C +-- 1.3.3.1 Cas dendritique / dendritic Case
+ 
+          OK_hdd=max(zero,                            !
+     .               sign(unun,-G1snSV(ikl,isn)       !
+     .                         -epsi           ))     !
+ 
+          DENDRn=-G1snSV(ikl,isn)/G1_dSV              !
+          SPHERn= G2snSV(ikl,isn)/G1_dSV              !
+          DENDRn= DENDRn - facVap*frac_j              !
+          SPHERn= SPHERn - facVap*frac_j              ! Non dendritic
+C +                                                   ! and angular
+          OK__DE=max(zero,                            ! IF 1.,
+     .               sign(unun, DENDRn                ! NO change
+     .                         -epsi  ))              ! Dendr. -> Spheric
+ 
+          G1_hdd= OK__DE *    (      -DENDRn*G1_dSV)  ! Dendritic
+     .       +(1.-OK__DE)* max(zero  ,SPHERn*G1_dSV)  ! Dendr. -> Spheric
+          G2_hdd= OK__DE * max(zero  ,SPHERn*G1_dSV)  ! Spheric
+     .       +(1.-OK__DE)*(ADSdSV-max(SPHERn,zero  )) ! Spher. -> Size
+ 
+C +-- 1.3.3.2 Cas non dendritique non completement anguleux.
+C +           non dendritic and spericity gt. 0
+ 
+          OK_hds=max(zero,                            !
+     .               sign(unun, G1snSV(ikl,isn)       !
+     .                         -epsi           ))     !
+ 
+          SPHERn= G1snSV(ikl,isn)/G1_dSV
+          SPHERn= SPHERn - facVap*frac_j
+          G1_hds= max(zero,SPHERn*G1_dSV)
+ 
+C +-- 1.3.3.3 Cas non dendritique et anguleux
+C +           dendritic and spericity = 0.
+ 
+          T1__OK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang1))
+          T2__OK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang2))
+          T3_xOK = max(zero,sign(unun,TsisSV(ikl,isn)-TfSnow+vtang3))
+          T3__OK =                    T3_xOK  * (1. - T2__OK)
+          T3_nOK =              (1. - T3_xOK) * (1. - T2__OK)
+          ro1_OK = max(zero,sign(unun,vrang1-ro_dry(ikl,isn)))
+          ro2_OK = max(zero,sign(unun,ro_dry(ikl,isn)-vrang2))
+          dT1_OK = max(zero,sign(unun,vgang1-dTsndz         ))
+          dT2_OK = max(zero,sign(unun,vgang2-dTsndz         ))
+          dT3xOK = max(zero,sign(unun,vgang3-dTsndz         ))
+          dT3_OK =                    dT3xOK  * (1. - dT2_OK)
+          dT4xOK = max(zero,sign(unun,vgang4-dTsndz         ))
+          dT4_OK =                    dT4xOK  * (1. - dT3_OK)
+     .                                        * (1. - dT2_OK)
+          dT4nOK =              (1. - dT4xOK) * (1. - dT3_OK)
+     .                                        * (1. - dT2_OK)
+ 
+C +-- Influence de la Temperature /Temperature Influence
+C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          AngSno =
+     .      T1__OK                                                       ! 11
+     .    *(T2__OK*(vtang4+vtang5*(TfSnow       -TsisSV(ikl,isn))        ! 12
+     .                    /vtang6)                                       !
+     .     +T3__OK*(vtang7-vtang8*(TfSnow-vtang2-TsisSV(ikl,isn))        ! 13
+     .                    /vtang9)                                       !
+     .     +T3_nOK*(vtanga-vtangb*(TfSnow-vtang3-TsisSV(ikl,isn))        ! 14
+     .                    /vtangc))                                      !
+ 
+C +-- Influence de la Masse Volumique /Density Influence
+C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+     .    * ro1_OK
+     .        *(   ro2_OK*(1. - (ro_dry(ikl,isn)-vrang2)                 !
+     .                                  /(vrang1-vrang2))                !
+     .         +1.-ro2_OK                                )               !
+ 
+C +-- Influence du Gradient de Temperature /Temperature Gradient Influence
+C +   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+     .        *(   dT1_OK*(dT2_OK*vgang5*(dTsndz-vgang6)                 ! 15
+     .                                  /(vgang2-vgang6)                 !
+     .                    +dT3_OK*vgang7                                 ! 16
+     .                    +dT4_OK*vgang9                                 ! 17
+     .                    +dT4nOK*vgangb                )                ! 18
+     .         +1.-dT1_OK                                )               !
+     .    + ro1_OK
+     .        *    dT1_OK*(dT3_OK*vgang8*(dTsndz-vgang2)
+     .                                  /(vgang3-vgang2)
+     .                    +dT4_OK*vganga*(dTsndz-vgang3)
+     .                                  /(vgang4-vgang3)
+     .                    +dT4nOK*vgangc*(dTsndz-vgang4)
+     .                                  /(vgang1-vgang4))
+ 
+          G2_hds = G2snSV(ikl,isn) + 1.d2 *AngSno*vfi     *frac_j
+ 
+ 
+C +--New Properties
+C +  --------------
+ 
+          G1_bak          = G1snSV(ikl,isn)
+          G2_bak          = G2snSV(ikl,isn)
+ 
+          G1snSV(ikl,isn) = Wet_OK * (    OK__wd             *G1__wd    !  1
+     .                               +(1.-OK__wd)*    OK__ws *G1__ws    !  2
+     .                               +(1.-OK__wd)*(1.-OK__ws)*G1_bak)   !  3
+     .               +(1. - Wet_OK)                                     !
+     .                *(    OKlowT  *(    OK_ldd             *G1_ldd    !  4
+     .                               +(1.-OK_ldd)            *G1_lds)   !  5
+     .                    + OKmidT  *(    OK_mdd             *G1_mdd    !  6
+     .                               +(1.-OK_mdd)            *G1_mds)   !  7
+     .                    + OKhigT  *(    OK_hdd             *G1_hdd    !  8
+     .                               +(1.-OK_hdd)*    OK_hds *G1_hds    !  9
+     .                               +(1.-OK_hdd)*(1.-OK_hds)*G1_bak))  ! 10
+ 
+cXF
+      if(G1snSV(ikl,isn)<0.1)
+     .    G2_hds = G2snSV(ikl,isn) + 1.d1 *AngSno*vfi     *frac_j
+cXF
+ 
+ 
+          G2snSV(ikl,isn) = Wet_OK * (    OK__wd             *G2__wd    !  1
+     .                               +(1.-OK__wd)*    OK__ws *G2_bak    !  2
+     .                               +(1.-OK__wd)*(1.-OK__ws)*G2__ws)   !  3
+     .               +(1. - Wet_OK)                                     !
+     .                *(    OKlowT  *(    OK_ldd             *G2_ldd    !  4
+     .                               +(1.-OK_ldd)            *G2_bak)   !  5
+     .                    + OKmidT  *(    OK_mdd             *G2_mdd    !  6
+     .                               +(1.-OK_mdd)            *G2_bak)   !  7
+     .                    + OKhigT  *(    OK_hdd             *G2_hdd    !  8
+     .                               +(1.-OK_hdd)*    OK_hds *G2_bak    !  9
+     .                               +(1.-OK_hdd)*(1.-OK_hds)*G2_hds))  ! 10
+ 
+C +--Snow Properties: IO Set Up
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~
+! #vp     G_curr( 1) =     Wet_OK             *    OK__wd
+! #vp     G_curr( 2) =     Wet_OK             *(1.-OK__wd)*    OK__ws
+! #vp     G_curr( 3) =     Wet_OK             *(1.-OK__wd)*(1.-OK__ws)
+! #vp     G_curr( 4) = (1.-Wet_OK)*    OKlowT *    OK_ldd
+! #vp     G_curr( 5) = (1.-Wet_OK)*    OKlowT *(1.-OK_ldd)
+! #vp     G_curr( 6) = (1.-Wet_OK)*    OKmidT *    OK_mdd
+! #vp     G_curr( 7) = (1.-Wet_OK)*    OKmidT *(1.-OK_mdd)
+! #vp     G_curr( 8) = (1.-Wet_OK)*    OKhigT *    OK_hdd
+! #vp     G_curr( 9) = (1.-Wet_OK)*    OKhigT *(1.-OK_hdd)*    OK_hds
+! #vp     G_curr(10) = (1.-Wet_OK)*    OKhigT *(1.-OK_hdd)*(1.-OK_hds)
+! #vp     G_curr(11) =     T1__OK                         * G_curr(10)
+! #vp     G_curr(12) =     T2__OK                         * G_curr(10)
+! #vp     G_curr(13) =     T3__OK                         * G_curr(10)
+! #vp     G_curr(14) =     T3_nOK                         * G_curr(10)
+! #vp     G_curr(15) =     ro1_OK*     dT1_OK *    dT2_OK * G_curr(10)
+! #vp     G_curr(16) =     ro1_OK*     dT1_OK *    dT3_OK * G_curr(10)
+! #vp     G_curr(17) =     ro1_OK*     dT1_OK *    dT4_OK * G_curr(10)
+! #vp     G_curr(18) =     ro1_OK*     dT1_OK *    dT4nOK * G_curr(10)
+ 
+! #vp     Gcases( 1) = max(Gcases( 1),G_curr( 1))
+! #vp     Gcases( 2) = max(Gcases( 2),G_curr( 2))
+! #vp     Gcases( 3) = max(Gcases( 3),G_curr( 3))
+! #vp     Gcases( 4) = max(Gcases( 4),G_curr( 4))
+! #vp     Gcases( 5) = max(Gcases( 5),G_curr( 5))
+! #vp     Gcases( 6) = max(Gcases( 6),G_curr( 6))
+! #vp     Gcases( 7) = max(Gcases( 7),G_curr( 7))
+! #vp     Gcases( 8) = max(Gcases( 8),G_curr( 8))
+! #vp     Gcases( 9) = max(Gcases( 9),G_curr( 9))
+! #vp     Gcases(10) = max(Gcases(10),G_curr(10))
+! #vp     Gcases(11) = max(Gcases(11),G_curr(11))
+! #vp     Gcases(12) = max(Gcases(12),G_curr(12))
+! #vp     Gcases(13) = max(Gcases(13),G_curr(13))
+! #vp     Gcases(14) = max(Gcases(14),G_curr(14))
+! #vp     Gcases(15) = max(Gcases(15),G_curr(15))
+! #vp     Gcases(16) = max(Gcases(16),G_curr(16))
+! #vp     Gcases(17) = max(Gcases(17),G_curr(17))
+! #vp     Gcases(18) = max(Gcases(18),G_curr(18))
+ 
+C +--Snow Properties: IO
+C +  ~~~~~~~~~~~~~~~~~~~
+! #vp     IF          (isn    .le.     isnoSV(ikl))
+! #vp.    write(47,471)isn            ,isnoSV(ikl)                    ,
+! #vp.                 TsisSV(ikl,isn),ro__SV(ikl,isn),eta_SV(ikl,isn),
+! #vp.                 G1_bak         ,G2_bak         ,istoSV(ikl,isn),
+! #vp.                 dTsndz,
+! #vp.                (       k ,k=1,18),
+! #vp.                (G_curr(k),k=1,18),
+! #vp.                (Gcases(k),k=1,18),
+! #vp.                 Wet_OK,OK__wd,G1__wd,G2__wd,
+! #vp.                     1.-OK__wd,OK__ws,G1__ws,1.-OK__ws,G2__ws,
+! #vp.              1.-Wet_OK,OKlowT,OK_ldd,G1_ldd,          G2_ldd,
+! #vp.                            1.-OK_ldd,G1_lds,
+! #vp.                        OKmidT,OK_mdd,G1_mdd,          G1_mdd,
+! #vp.                            1.-OK_mdd,G1_mds,
+! #vp.                        OKhigT,OK_hdd,G1_hdd,          G2_hdd,
+! #vp.                            1.-OK_hdd,OK_hds,          G1_hds,
+! #vp.                                             1.-OK_hds,G2_hds,
+! #vp.                 G1snSV(ikl,isn),
+! #vp.                 G2snSV(ikl,isn)
+
+        END DO
+      END DO
+c!$OMP END PARALLEL DO
+ 
+C +-- 2. Mise a Jour Variables Historiques (Cas non dendritique)
+C +      Update of the historical Variables
+C +      =======================================================
+ 
+      IF (vector)                                                   THEN
+cXF
+         DO  ikl=1,knonv
+          DO isn=1,isnoSV(ikl)
+          SphrOK = max(zero,sign(unun,       G1snSV(ikl,isn)))
+          H1a_OK = max(zero,sign(unun,vsphe4-G1snSV(ikl,isn)))
+          H1b_OK =     1   - min(1   ,       istoSV(ikl,isn))
+          H1__OK =                    H1a_OK*H1b_OK
+          H23aOK = max(zero,sign(unun,vsphe4-G1_dSV
+     .                                      +G1snSV(ikl,isn)))
+          H23bOK = max(zero,sign(unun,etaSno(ikl,isn)
+     .                      /max(epsi,dzsnSV(ikl,isn))
+     .                                      -vtelv1         ))
+          H23_OK =                    H23aOK*H23bOK
+          H2__OK =     1   - min(1   ,       istoSV(ikl,isn))
+          H3__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(1)))
+          H45_OK = max(zero,sign(unun,TfSnow-TsisSV(ikl,isn)+epsi))
+          H4__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(2)))
+          H5__OK =     1   - min(1   ,   abs(istoSV(ikl,isn)-istdSV(3)))
+ 
+          HISupd          =
+     .    SphrOK*(H1__OK                             *istdSV(1)
+     .       +(1.-H1__OK)*    H23_OK         *(H2__OK*istdSV(2)
+     .                                        +H3__OK*istdSV(3))
+     .       +(1.-H1__OK)*(1.-H23_OK) *H45_OK*(H4__OK*istdSV(4)
+     .                                        +H5__OK*istdSV(5)))
+          istoSV(ikl,isn) =   HISupd  +
+     .           (1.-min(unun,HISupd))               *istoSV(ikl,isn)
+        END DO
+        END DO
+      ELSE
+ 
+ 
+C +-- 2. Mise a Jour Variables Historiques (Cas non dendritique)
+C +      Update of the historical Variables
+C +      =======================================================
+ 
+        DO ikl=1,knonv
+        DO isn=iiceSV(ikl),isnoSV(ikl)
+          IF  (G1snSV(ikl,isn).ge.0.)                               THEN
+            IF(G1snSV(ikl,isn).lt.vsphe4.and.istoSV(ikl,isn).eq.0)  THEN
+                   istoSV(ikl,isn)=istdSV(1)
+            ELSEIF(G1_dSV-G1snSV(ikl,isn)         .lt.vsphe4.and.
+     .             etaSno(ikl,isn)/dzsnSV(ikl,isn).gt.vtelv1)       THEN
+              IF  (istoSV(ikl,isn).eq.0)
+     .             istoSV(ikl,isn)=   istdSV(2)
+              IF  (istoSV(ikl,isn).eq.istdSV(1))
+     .             istoSV(ikl,isn)=   istdSV(3)
+            ELSEIF(TsisSV(ikl,isn).lt.TfSnow)                       THEN
+              IF  (istoSV(ikl,isn).eq.istdSV(2))
+     .             istoSV(ikl,isn)=   istdSV(4)
+              IF  (istoSV(ikl,isn).eq.istdSV(3))
+     .             istoSV(ikl,isn)=   istdSV(5)
+            END IF
+          END IF
+        END DO
+        END DO
+      END IF
+ 
+ 
+C +-- 3. Tassement mecanique /mechanical Settlement
+C +      ==========================================
+ 
+        DO ikl=1,knonv
+          SnMass(ikl) = 0.
+        END DO
+cXF
+      DO ikl=1,knonv
+ 
+        smb_old = 0.
+         zn_old = 0
+        DO isn  = 1, isnoSV(ikl)
+        smb_old = smb_old + dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+         zn_old = zn_old  + dzsnSV(ikl,isn)
+        ENDDO
+ 
+        DO   isn=isnoSV(ikl),1,-1
+          dSnMas     = 100.*dzsnSV(ikl,isn)*ro_dry(ikl,isn)
+          SnMass(ikl)=      SnMass(ikl)+0.5*dSnMas
+          ViscSn     =      vvisc1         *vvisc2
+     .               *exp(vvisc3           *ro_dry(ikl,isn)
+     .                   +vvisc4*abs(TfSnow-TsisSV(ikl,isn)))
+     .                                     *ro_dry(ikl,isn)/rovisc
+ 
+C +-- Changement de Viscosite si Teneur en Eau liquide
+C +   Change of the Viscosity if liquid Water Content
+C +   ------------------------------------------------
+ 
+          OK_Liq     =    max(zero,sign(unun,etaSno(ikl,isn)-epsi))
+          OK_Ang     =    max(zero,sign(unun,vgran6-G1snSV(ikl,isn)))
+     .                *(1-min(1   , abs(istoSV(ikl,isn)-istdSV(1))))
+! #wp     IF (G1snSV(ikl,isn).gt.0..AND.G1snSV(ikl,isn).lt.vsphe4
+! #wp.                             .AND.istoSV(ikl,isn).eq.     0)
+! #wp.    THEN
+! #wp       write(6,*) ikl,isn,' G1,G2,hist,OK_Ang  ',
+! #wp.          G1snSV(ikl,isn), G2snSV(ikl,isn),istoSV(ikl,isn),OK_Ang
+! #wp       stop "Grains anguleux mal d?finis"
+! #wp     END IF
+          OKxLiq     =    max(zero,sign(unun,vtelv1-etaSno(ikl,isn)
+     .                                    /max(epsi,dzsnSV(ikl,isn))))
+     .               *    max(0   ,sign(1   ,istoSV(ikl,isn)
+     .                                      -istdSV(1)      ))
+          ViscSn     =
+     .    ViscSn*(    OK_Liq/(vvisc5+vvisc6*etaSno(ikl,isn)
+     .                            /max(epsi,dzsnSV(ikl,isn)))
+     .           +(1.-OK_Liq)                               )
+     .          *(    OK_Ang*exp(min(ADSdSV,G2snSV(ikl,isn)-vdiam4))
+     .           +(1.-OK_Ang)                                       )
+     .          *(    OKxLiq*        vvisc7
+     .           +(1.-OKxLiq)              )
+ 
+ 
+C +-- Calcul nouvelle Epaisseur / new Thickness
+C +   -----------------------------------------
+ 
+          dzsnew         =
+     .    dzsnSV(ikl,isn)
+     .     *max(vdz3,
+     .         (unun-dt__SV2*max(SnMass(ikl)*cos(slopSV(ikl)),unun)
+     .                     /max(ViscSn                      ,epsi)))
+          rosnew         = ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+     .                            /max(1e-10,dzsnew)
+          rosmax         = 1.   /( (1. -eta_SV(ikl,isn)) /ro_Ice
+     .                           +      eta_SV(ikl,isn)  /ro_Wat)
+          rosnew         = min(rosnew ,rosmax)
+          dzsnew         = dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+     .                            /max(1e-10,rosnew)
+          ro__SV(ikl,isn)= rosnew
+          dzsnSV(ikl,isn)= dzsnew
+          ro_dry(ikl,isn)= ro__SV(ikl,isn)*(1.-eta_SV(ikl,isn))*1.e-3
+C +...    ro_dry: Dry Density (g/cm3)
+C +
+          SnMass(ikl)    = SnMass(ikl)+dSnMas*0.5
+        END DO
+ 
+        smb_new = 0.
+        DO isn  = 1, isnoSV(ikl)
+        smb_new = smb_new + dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+        ENDDO
+ 
+        isn=1
+        if (dzsnSV(ikl,isn)>0.and.ro__SV(ikl,isn)>0) then
+        dzsnSV(ikl,isn) = dzsnSV(ikl,isn) +0.9999*(smb_old-smb_new)
+     .                  / ro__SV(ikl,isn)
+        endif
+ 
+         zn_new = 0
+        DO isn  = 1, isnoSV(ikl)
+         zn_new = zn_new  + dzsnSV(ikl,isn)
+        ENDDO
+        zn4_SV(ikl) = zn4_SV(ikl) + (zn_new - zn_old)
+ 
+      END DO
+ 
+
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_qsn.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_qsn.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_qsn.F	(revision 3851)
@@ -0,0 +1,722 @@
+ 
+ 
+      subroutine SISVAT_qSn
+     .                     (
+! #e1.                      EqSn_0,EqSn_1,EqSn_d
+! #m1.                     ,SIsubl,SImelt,SIrnof
+     .                     )
+ 
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_qSn                           Fri 29-Jul-2011  MAR |
+C |   SubRoutine SISVAT_qSn updates  the Snow Water Content                |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  knonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+C |                     X       Number of Mosaic Cell per grid box         |
+C |                                                                        |
+C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
+C |   ^^^^^                                                                |
+C |                                                                        |
+C |   INPUT:   TaT_SV   : SBL Top    Temperature                       [K] |
+C |   ^^^^^    dt__SV   : Time Step                                    [s] |
+C |                                                                        |
+C |   INPUT /  drr_SV   : Rain Intensity                         [kg/m2/s] |
+C |   OUTPUT:  dzsnSV   : Snow Layer Thickness                         [m] |
+C |   ^^^^^^   eta_SV   : Snow Water Content                       [m3/m3] |
+C |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
+C |            TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+C |                     & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+C |                                                                        |
+C |   OUTPUT:  SWS_SV   : Surficial Water Status                           |
+C |   ^^^^^^                                                               |
+C |            EExcsv   : Snow Energy in Excess, initial Forcing    [J/m2] |
+C |            EqSn_d   : Snow Energy in Excess, remaining          [J/m2] |
+C |            EqSn_0   : Snow Energy, before Phase Change          [J/m2] |
+C |            EqSn_1   : Snow Energy, after  Phase Change          [J/m2] |
+C |            SIsubl   : Snow sublimed/deposed Mass             [mm w.e.] |
+C |            SImelt   : Snow Melted           Mass             [mm w.e.] |
+C |            SIrnof   : Surficial Water + Run OFF Change       [mm w.e.] |
+C |                                                                        |
+C |   Internal Variables:                                                  |
+C |   ^^^^^^^^^^^^^^^^^^                                                   |
+C |                                                                        |
+C | # OPTIONS: #E0: IO for Verification: Energy       Budget               |
+C | # ^^^^^^^                                                              |
+C | #          #su: IO for Verification: Slush        Diagnostic           |
+C |                                                                        |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VAR0SV
+      use VARxSV
+      use VARySV
+
+      IMPLICIT NONE
+
+ 
+! Energy          Budget
+! ~~~~~~~~~~~~~~~~~~~~~~
+! #e1 real     EqSn_d(knonv)                 ! Energy in Excess, initial
+! #e1 real     EqSn_0(knonv)                 ! Snow Energy, befor Phase Change
+! #vm real     EqSn01(knonv)                 ! Snow Energy, after Phase Change
+! #vm real     EqSn02(knonv)                 ! Snow Energy, after Phase Change
+                                             !              .AND. Last Melting
+! #e1 real     EqSn_1(knonv)                 ! Snow Energy, after Phase Change
+                                             !              .AND. Mass Redistr.
+! Snow/Ice (Mass) Budget
+! ~~~~~~~~~~~~~~~~~~~~~~
+! #m1 real     SIsubl(knonv)                 ! Snow Deposed Mass
+! #m1 real     SImelt(knonv)                 ! Snow Melted  Mass
+! #m1 real     SIrnof(knonv)                 ! Local Surficial Water + Run OFF
+ 
+ 
+C +--Internal Variables
+C +  ==================
+ 
+      integer  ikl   ,isn                    !
+      integer  nh                            ! Non erodible Snow: up.lay.Index
+      integer  LayrOK                        ! 1 (0)  if In(Above) Snow Pack
+      integer  k_face                        ! 1 (0)  if Crystal(no) faceted
+      integer  LastOK                        ! 1 ==>  1! Snow Layer
+      integer  NOLayr                        ! 1     Layer  Update
+      integer  noSnow(knonv)                 ! Nb of Layers Updater
+      integer  kSlush                        ! Slush Switch
+      real     dTSnow                        ! Temperature                  [C]
+      real     EExdum(knonv)                 ! Energy in Excess when no Snow
+      real     OKmelt                        ! 1 (0)  if        (no) Melting
+      real     EnMelt                        ! Energy in excess, for Melting
+      real     SnHLat                        ! Energy consumed   in  Melting
+      real     AdEnrg,B_Enrg                 ! Additional Energy from  Vapor
+      real     dzVap0,dzVap1                 ! Vaporized Thickness          [m]
+      real     dzMelt(knonv)                 ! Melted    Thickness          [m]
+      real     rosDry                        ! Snow volumic Mass if no Water in
+      real     PorVol                        ! Pore volume
+      real     PClose                        ! Pore Hole Close OFF Switch
+      real     SGDiam                        !      Snow Grain Diameter
+      real     SGDmax                        ! Max. Snow Grain Diameter
+      real     rWater                        ! Retained Water           [kg/m2]
+      real     drrNEW                        ! New available Water      [kg/m2]
+      real     rdzNEW                        ! Snow          Mass       [kg/m2]
+      real     rdzsno                        ! Snow          Mass       [kg/m2]
+      real     EnFrez                        ! Energy Release    in  Freezing
+      real     WaFrez                        ! Water  consumed   in  Melting
+      real     RapdOK                        ! 1. ==> Snow melts rapidly
+      real     ThinOK                        ! 1. ==> Snow Layer is thin
+      real     dzepsi                        ! Minim. Snow Layer Thickness (!)
+      real     dz_Min                        ! Minim. Snow Layer Thickness
+      real     z_Melt                        ! Last (thin) Layer Melting
+      real     rusnew                        ! Surficial Water Thickness   [mm]
+      real     zWater                        ! Max Slush Water Thickness   [mm]
+      real     zSlush                        !     Slush Water Thickness   [mm]
+      real     ro_new                        ! New Snow/ice  Density    [kg/m3]
+      real     zc,zt                         ! Non erod.Snow Thickness[mm w.e.]
+      real     rusnSV0(knonv)
+      real     Tsave
+ 
+C +--OUTPUT of SISVAT Trace Statistics (see assignation in PHY_SISVAT)
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      integer             isnnew,isinew,isnUpD,isnitr
+ 
+! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! #wx integer             iSV_v1,jSV_v1,nSV_v1,kSV_v1,lSV_v1
+! #wx common/SISVAT_EV/   iSV_v1,jSV_v1,nSV_v1,kSV_v1,lSV_v1
+ 
+C +--Energy and Mass Budget
+C +  ~~~~~~~~~~~~~~~~~~~~~~
+! #vm real     WqSn_0(knonv)                 ! Snow Water+Forcing  Initial
+! #vm real     WqSn_1(knonv)                 ! Snow Water+Forcing, Final
+! #vm logical         emopen                 ! IO   Switch
+! #vm common/Se_qSn_L/emopen                 !
+! #vm integer         no_err                 !
+! #vm common/Se_qSn_I/no_err                 !
+! #vm real     hourer,timeer                 !
+! #vm common/Se_qSn_R/timeer                 !
+ 
+C +--Slush Diagnostic: IO
+C +  ~~~~~~~~~~~~~~~~~~~~
+! #vu logical         su_opn                 ! IO   Switch
+! #vu common/SI_qSn_L/su_opn                 !
+ 
+ 
+C +--DATA
+C +  ====
+ 
+      data      dzepsi/0.0001/                ! Minim. Snow Layer Thickness (!)
+c #?? data      dz_Min/0.005/                 ! Minim. Snow Layer Thickness
+c ... Warning: Too high for Col de Porte: precludes 1st snow (layer) apparition
+      data      dz_Min/2.5e-3/                ! Minim. Snow Layer Thickness
+      data      SGDmax/0.003/                 ! Maxim. Snow Grain Diameter  [m]
+                                              ! (Rowe et al. 1995, JGR p.16268)
+ 
+C +--Energy Budget (IN)
+C +  ==================
+ 
+! #e1   DO ikl=1,knonv
+! #e1     EqSn_0(ikl) = 0.
+! #e1   END DO
+! #e1 DO   isn=nsno,1,-1
+! #e1   DO ikl=1,knonv
+! #e1     EqSn_0(ikl) = EqSn_0(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+! #e1.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+! #e1.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+! #e1   END DO
+! #e1 END DO
+ 
+ 
+C +--Water  Budget (IN)
+C +  ==================
+ 
+! #vm   DO ikl=1,knonv
+! #vm     WqSn_0(ikl) = drr_SV(ikl) * dt__SV
+! #vm.                 +rusnSV(ikl)
+! #vm   END DO
+! #vm DO   isn=nsno,1,-1
+! #vm   DO ikl=1,knonv
+! #vm     WqSn_0(ikl) = WqSn_0(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+! #vm   END DO
+! #vm END DO
+ 
+ 
+C +--Snow Melt Budget
+C +  ================
+ 
+! #m1   DO ikl=1,knonv
+! #m1     SImelt(ikl) = 0.
+! #m1     SIrnof(ikl) = rusnSV(ikl) + RnofSV(ikl) * dt__SV
+! #m1   END DO
+ 
+ 
+C +--Initialization
+C +  ==============
+ 
+      DO ikl=1,knonv
+        noSnow(ikl)   = 0                   ! Nb of Layers Updater
+        ispiSV(ikl)   = 0                   ! Pore Hole Close OFF Index
+                                            ! (assumed to be the Top of
+                                            !  the surimposed Ice Layer)
+        zn5_SV(ikl)   = 0.
+        rusnSV0(ikl)  = 0.
+
+      END DO
+ 
+ 
+C +--Melting/Freezing Energy
+C +  =======================
+ 
+C +...REMARK: Snow liquid Water Temperature assumed = TfSnow
+C +   ^^^^^^
+        DO ikl=1,knonv
+          EExdum(ikl) = drr_SV(ikl)     * C__Wat *(TaT_SV(ikl)-TfSnow)
+     .                                  * dt__SV
+          EExcsv(ikl) = EExdum(ikl)     *    min(1,isnoSV(ikl)) ! Snow exists
+          EExdum(ikl) = EExdum(ikl)     -          EExcsv(ikl)  !
+! #e1     EqSn_d(ikl) = EExcsv(ikl)                             !
+        END DO
+ 
+ 
+C +--Surficial Water Status
+C +  ----------------------
+ 
+        DO ikl=1,knonv
+          SWS_SV(ikl) = max(zero,sign(unun,TfSnow
+     .                                    -TsisSV(ikl,isnoSV(ikl))))
+        END DO
+ 
+      DO ikl=1,knonv
+       DO isn=min(nsno,isnoSV(ikl)+1),1,-1
+! EV          DO isn=nsno,1,-1
+C +--Energy, store Previous Content
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          dTSnow      = TsisSV(ikl,isn) -          TfSnow
+          EExcsv(ikl) = EExcsv(ikl)
+     .                + ro__SV(ikl,isn) * Cn_dSV * dTSnow
+     .                                           * dzsnSV(ikl,isn)
+
+          Tsave       = TsisSV(ikl,isn)
+
+          TsisSV(ikl,isn) =                        TfSnow
+ 
+C +--Water,  store Previous Content
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          drr_SV(ikl) = drr_SV(ikl)
+     .                + ro__SV(ikl,isn)          * eta_SV(ikl,isn)
+     .                                           * dzsnSV(ikl,isn)
+     .                / dt__SV
+          ro__SV(ikl,isn) =
+     .                  ro__SV(ikl,isn) *(1.     - eta_SV(ikl,isn))
+          eta_SV(ikl,isn) =  0.
+ 
+ 
+C +--Melting  if EExcsv > 0
+C +  ======================
+ 
+          EnMelt      =    max(zero,          EExcsv(ikl) )
+ 
+C +--Energy Consumption
+C +  ^^^^^^^^^^^^^^^^^^
+          SnHLat      = ro__SV(ikl,isn) * Lf_H2O
+          dzMelt(ikl) = EnMelt      / max(SnHLat,    epsi )
+          noSnow(ikl) = noSnow(ikl)
+     .      + max(zero  ,sign(unun,dzMelt(ikl)                !
+     .                            -dzsnSV(ikl ,isn)))         ! 1 if full Melt
+     .       *min(1     , max(0 ,1+isnoSV(ikl)-isn))          ! 1 in the  Pack
+          dzMelt(ikl) =
+     .              min(dzsnSV(ikl, isn),dzMelt(ikl))
+          dzsnSV(ikl,isn) =
+     .                  dzsnSV(ikl,isn) -dzMelt(ikl)
+          zn5_SV(ikl) = zn5_SV(ikl)     +dzMelt(ikl)
+          EExcsv(ikl) = EExcsv(ikl)     -dzMelt(ikl)*SnHLat
+          wem_SV(ikl) = wem_SV(ikl)     -dzMelt(ikl)*ro__SV(ikl,isn)
+ 
+C +--Water  Production
+C +  ^^^^^^^^^^^^^^^^^
+          drr_SV(ikl) = drr_SV(ikl)
+     .                + ro__SV(ikl,isn) * dzMelt(ikl)/dt__SV
+! #m1     SImelt(ikl) = SImelt(ikl)
+! #m1.                + ro__SV(ikl,isn) * dzMelt(ikl)
+          OKmelt      =max(zero,sign(unun,drr_SV(ikl)-epsi))
+ 
+C +--Snow History
+C +  ^^^^^^^^^^^^
+          k_face          =       min(    istoSV(ikl,isn),istdSV(1)) ! = 1  if
+     .                           *max(0,2-istoSV(ikl,isn)          ) ! faceted
+          istoSV(ikl,isn) =                                          !
+     .        (1.-OKmelt) *               istoSV(ikl,isn)            !
+     .      +     OKmelt  *((1-k_face) *  istdSV(2)                  !
+     .                     +   k_face  *  istdSV(3)      )           !
+ 
+ 
+C +--Freezing if EExcsv < 0
+C +  ======================
+ 
+          rdzsno      =          ro__SV(ikl,isn) * dzsnSV(ikl ,isn)
+          LayrOK      = min(   1, max(0          , isnoSV(ikl)-isn+1))
+          EnFrez      = min(zero,                  EExcsv(ikl))
+          WaFrez      =   -(     EnFrez          * LayrOK / Lf_H2O)
+          drrNEW      = max(zero,drr_SV(ikl)     - WaFrez / dt__SV)
+          WaFrez      =    (     drr_SV(ikl)     - drrNEW)* dt__SV
+          drr_SV(ikl) =          drrNEW
+          EExcsv(ikl) =          EExcsv(ikl)     + WaFrez * Lf_H2O
+          EnFrez      = min(zero,EExcsv(ikl))    * LayrOK
+          rdzNEW      = WaFrez + rdzsno
+          ro__SV(ikl,isn) =      rdzNEW /max(epsi, dzsnSV(ikl,isn))
+
+! EV: condition on Enfrez
+!          if (EnFrez .eq. 0.) then
+          
+          TsisSV(ikl,isn) = Tsave
+!          else
+          TsisSV(ikl,isn) =      TfSnow
+     .                + EnFrez /(Cn_dSV *max(epsi, rdzNEW)        )
+!          end if
+          EExcsv(ikl) =          EExcsv(ikl)     - EnFrez
+          wer_SV(ikl) = WaFrez
+     .                + wer_SV(ikl)
+ 
+ 
+
+C +--Snow Water Content
+C +  ==================
+ 
+C +--Percolation Velocity
+C +  ^^^^^^^^^^^^^^^^^^^^
+c #PW     SGDiam    = 1.6d-4
+c #PW.              + 1.1d-13 *(ro__SV(ikl,isn)*ro__SV(ikl,isn)
+c #PW.                         *ro__SV(ikl,isn)*ro__SV(ikl,isn))
+ 
+C +--Pore   Volume [-]
+C +  ^^^^^^^^^^^^^^^^^
+          rosDry      =(1.     - eta_SV(ikl,isn))* ro__SV(ikl,isn) !
+          PorVol      = 1.     - rosDry          / ro_Ice          !
+          PorVol      =      max(PorVol          , zero  )         !
+ 
+C +--Water  Retention
+C +  ^^^^^^^^^^^^^^^^
+          rWater      = ws0dSV * PorVol * ro_Wat * dzsnSV(ikl,isn)
+          drrNEW      = max(zero,drr_SV(ikl)     - rWater /dt__SV)
+          rWater      =    (     drr_SV(ikl)     - drrNEW)*dt__SV
+          drr_SV(ikl)     =      drrNEW
+          rdzNEW          =      rWater
+     .                         + rosDry          * dzsnSV(ikl,isn)
+          eta_SV(ikl,isn) =      rWater / max(epsi,rdzNEW)
+          ro__SV(ikl,isn) =      rdzNEW / max(epsi,dzsnSV(ikl,isn))
+ 
+C +--Pore Hole Close OFF
+C +  ^^^^^^^^^^^^^^^^^^^
+          PClose = max(zero,
+     .                 sign(unun,ro__SV(ikl,isn)
+     .                          -roCdSV         ))
+          ispiSV(ikl) =          ispiSV(ikl)      *(1.-PClose)
+     .                +      max(ispiSV(ikl),isn)    * Pclose
+          PClose = max(0   ,                         ! Water under SuPer.Ice
+     .                 min (1   ,ispiSV(ikl)         ! contributes to
+     .                          -isn            ))   ! Surficial   Water
+ 
+cXF
+          if(ro__SV(ikl,isn) >= roCdSV.and.ro__SV(ikl,1)<900)
+     .    PClose = min(0.50,PClose *
+     .    (1.-(ro_ice-ro__SV(ikl,isn))/(ro_ice-roCdSV)))
+ 
+          PClose = max(0.,min(1.,PClose))
+ 
+          if(isn==1) then
+               PClose = 1
+           ispiSV(ikl)= max(ispiSV(ikl),1)
+          endif
+ 
+          if(drr_SV(ikl)    >0  .and.TsisSV(ikl,isn)>273.14) then
+           if((ro__SV(ikl,isn)>900.and.ro__SV(ikl,isn)<920).or.
+     .         ro__SV(ikl,isn)>950) then
+             dzsnSV(ikl,isn) = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/ro_ice
+             ro__SV(ikl,isn) = ro_ice
+             PClose          = 1
+           endif
+          endif
+ 
+c         if (isn>1.and.isn<nsno     .and.
+c    .      ro__SV(ikl,isn-1)>900    .and.
+c    .      ro__SV(ikl,isn)  >roCdSV .and.
+c    .      ro__SV(ikl,isn)  <900    .and.
+c    .      TsisSV(ikl,isn)  >273.14 .and.
+c    .      TsisSV(ikl,isn+1)<273.15 .and.
+c    .      drr_SV(ikl)      >0)     then
+c          TsisSV(ikl,isn)=273.14
+c          PClose = 1
+c         endif
+ 
+cXF
+          rusnSV(ikl) =          rusnSV(ikl)
+     .                +          drr_SV(ikl) *dt__SV * PClose
+          rusnSV0(ikl)=         rusnSV0(ikl)
+     .                +          drr_SV(ikl) *dt__SV * PClose
+          drr_SV(ikl) =          drr_SV(ikl)      *(1.-PClose)
+ 
+        END DO
+
+      END DO
+ 
+ 
+C +--Remove Zero-Thickness Layers
+C +  ============================
+ 
+ 1000 CONTINUE
+           isnitr =          0
+      DO   ikl=1,knonv
+           isnUpD =          0
+           isinew =          0
+cXF
+
+
+        DO isn=1,min(nsno-1,isnoSV(ikl))
+           isnnew =(unun-max(zero  ,sign(unun,dzsnSV(ikl,isn)-dzepsi)))
+     .             *     max(0     , min(1   ,isnoSV(ikl) +1 -isn ))
+           isnUpD =      max(isnUpD,          isnnew)
+           isnitr =      max(isnitr,          isnnew)
+           isinew =      isn*isnUpD *max(0, 1-isinew)      ! LowerMost  0-Layer
+     .                                       +isinew       ! Index
+           dzsnSV(ikl,isn) =                  dzsnSV(ikl,isn+isnnew)
+           ro__SV(ikl,isn) =                  ro__SV(ikl,isn+isnnew)
+           TsisSV(ikl,isn) =                  TsisSV(ikl,isn+isnnew)
+           eta_SV(ikl,isn) =                  eta_SV(ikl,isn+isnnew)
+           G1snSV(ikl,isn) =                  G1snSV(ikl,isn+isnnew)
+           G2snSV(ikl,isn) =                  G2snSV(ikl,isn+isnnew)
+           dzsnSV(ikl,isn+isnnew) =(1-isnnew)*dzsnSV(ikl,isn+isnnew)
+           ro__SV(ikl,isn+isnnew) =(1-isnnew)*ro__SV(ikl,isn+isnnew)
+           eta_SV(ikl,isn+isnnew) =(1-isnnew)*eta_SV(ikl,isn+isnnew)
+           G1snSV(ikl,isn+isnnew) =(1-isnnew)*G1snSV(ikl,isn+isnnew)
+           G2snSV(ikl,isn+isnnew) =(1-isnnew)*G2snSV(ikl,isn+isnnew)
+
+        END DO
+           isnoSV(ikl)   =   isnoSV(ikl)-isnUpD            ! Nb of Snow   Layer
+           ispiSV(ikl)   =   ispiSV(ikl)                   ! Nb of SuperI Layer
+     .    -isnUpD *max(0,min(ispiSV(ikl)-isinew,1))        ! Update  if I=0
+ 
+      END DO
+
+      IF  (isnitr.GT.0)                                       GO TO 1000
+ 
+ 
+C +--New upper Limit of the non erodible Snow (istoSV .GT. 1)
+C +  ========================================
+ 
+      DO   ikl=1,knonv
+           nh =     0
+cXF
+        DO isn=  isnoSV(ikl),1,-1
+           nh =    nh + isn* min(istoSV(ikl,isn)-1,1)*max(0,1-nh)
+        ENDDO
+           zc =     0.
+           zt =     0.
+cXF
+        DO isn=1,isnoSV(ikl)
+           zc =    zc +          dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+     .                     * max(0,min(1,nh+1-isn))
+           zt =    zt +          dzsnSV(ikl,isn) *ro__SV(ikl,isn)
+        END DO
+           zWE_SV(ikl) =                 zt
+           zWEcSV(ikl) = min(zWEcSV(ikl),zt)
+           zWEcSV(ikl) = max(zWEcSV(ikl),zc)
+      END DO
+ 
+ 
+C +--Energy Budget (OUT)
+C +  ===================
+ 
+! #vm   DO ikl=1,knonv
+! #vm     EqSn01(ikl) =-EqSn_0(ikl)
+! #vm.                 -EExcsv(ikl)
+! #vm   END DO
+! #vm DO   isn=nsno,1,-1
+! #vm   DO ikl=1,knonv
+! #vm     EqSn01(ikl) = EqSn01(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+! #vm.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+! #vm.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+! #vm   END DO
+! #vm END DO
+ 
+ 
+C +--"Negative Heat" from supercooled rain
+C +   ------------------------------------
+ 
+      DO ikl=1,knonv
+          EExcsv(ikl) = EExcsv(ikl) + EExdum(ikl)
+ 
+ 
+C +--Surficial Water Run OFF
+C +  -----------------------
+ 
+          rusnew      = rusnSV(ikl) * SWf_SV(ikl)
+ 
+          if(isnoSV(ikl)<=1) rusnew = 0.
+          !if(ivgtSV(ikl)>=1) rusnew = 0.
+ 
+c #EU                        rusnew = 0.
+c #AC                        rusnew = 0.
+          RnofSV(ikl) = RnofSV(ikl)
+     .                +(rusnSV(ikl) - rusnew     ) / dt__SV
+          RuofSV(ikl,1) = RuofSV(ikl,1)
+     .                +(rusnSV(ikl) - rusnew     ) / dt__SV
+          RuofSV(ikl,4) = RuofSV(ikl,4)
+     .                +(rusnSV0(ikl)             ) / dt__SV
+          rusnSV(ikl) = rusnew
+      END DO
+ 
+ 
+C +--Percolation down the Continental Ice Pack
+C +  -----------------------------------------
+ 
+        DO ikl=1,knonv
+          drr_SV(ikl) = drr_SV(ikl) + rusnSV(ikl)
+     .                     * (1-min(1,ispiSV(ikl)))/ dt__SV
+          rusnSV(ikl) = rusnSV(ikl)
+     .                     *    min(1,ispiSV(ikl))
+        END DO
+ 
+cXF removal of too thin snowlayers if TT> 275.15 + bug if TT>> 273.15
+        DO ikl=1,knonv
+         zt=0.
+         DO isn=1,isnoSV(ikl)
+          zt=zt+dzsnSV(ikl,isn)
+         ENDDO
+         
+         if(zt<0.005+(TaT_SV(ikl)-TfSnow)/1000..and.
+     .      isnoSV(ikl)             >0         .and.
+     .      TaT_SV(ikl)             >=TfSnow   .and.
+     .      istoSV(ikl,isnoSV(ikl)) >1       ) then
+          DO isn=1,isnoSV(ikl)
+           drr_SV(ikl)    = drr_SV(ikl)
+     .                    + dzsnSV(ikl,isn)*ro__SV(ikl,isn) /dt__SV
+           dzsnSV(ikl,isn)= 0.
+
+          ENDDO
+          isnoSV(ikl)     = 0
+         endif
+        ENDDO
+ 
+C +--Slush Formation (CAUTION: ADD RunOff Possibility before Activation)
+C +  ---------------  ^^^^^^^  ^^^
+ 
+ 
+c #SU DO  ikl=1,knonv
+c #SU  DO isn=1,isnoSV(ikl)
+c #SU     kSlush = min(1,max(0,isn+1-ispiSV(ikl)))        ! Slush Switch
+ 
+C +--Available Additional Pore   Volume [-]
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #SU     PorVol = 1. - ro__SV(ikl,isn)                    ! [--]
+c #SU.           *(1. - eta_SV(ikl,isn))/ ro_Ice           !
+c #SU.           -      eta_SV(ikl,isn)                    !
+c #SU.                 *ro__SV(ikl,isn) / ro_Wat           !
+c #SU     PorVol =  max(PorVol          , zero  )          !
+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     ro_new      =(dzsnSV(ikl,isn) * ro__SV(ikl,isn)  !
+c #SU.                 +zSlush                           ) !
+c #SU.            / max(dzsnSV(ikl,isn) , epsi           ) !
+c #SU     if(ro_new<ro_Ice+20) then ! MAX 940kg/m3         !
+c #SU      rusnSV(ikl)  = rusnSV(ikl)          - zSlush    ! [mm] OR [kg/m2]
+c #SU      RuofSV(ikl,4)= max(0.,RuofSV(ikl,4) - zSlush/dt__SV)
+c #SU      eta_SV(ikl,isn) =(ro_new - ro__SV(ikl,isn)      !
+c #SU.                     *(1.     - eta_SV(ikl,isn)))    !
+c #SU.                / max (ro_new , epsi            )    !
+c #SU      ro__SV(ikl,isn) =      ro_new                   !
+c #SU     endif
+c #SU   END DO
+c #SU END DO
+ 
+ 
+C +--Impact of the Sublimation/Deposition on the Surface Mass Balance
+C +  ================================================================
+ 
+      DO ikl=1,knonv
+         isn                     = isnoSV(ikl)
+          dzVap0                  =                   dt__SV
+     .  * HLs_sv(ikl)         * min(isn             , 1   )
+     .  /(Lx_H2O(ikl)         * max(ro__SV(ikl,isn) , epsi))
+          NOLayr=min(zero,sign(unun,dzsnSV(ikl,isn) + dzVap0))
+          dzVap1=min(zero,          dzsnSV(ikl,isn) + dzVap0)
+ 
+ 
+C +--Additional Energy
+C +  -----------------
+ 
+c #VH     AdEnrg = dzVap0 * ro__SV(ikl,isnoSV(ikl))           ! Water   Vapor
+c #VH.            *C__Wat *(TsisSV(ikl,isnoSV(ikl)) -TfSnow)  ! Sensible Heat
+ 
+c #aH     B_Enrg =(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+c #aH.            -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+c #aH.           /(1.          + dzVap0 /max(epsi,dzsnSV(ikl,isn)))
+c #aH     eta_SV(ikl,isn) =
+c #aH.           max(zero,unun +(B_Enrg
+c #aH.                         -(TsisSV(ikl,isn) -TfSnow)*Cn_dSV)
+c #aH.                          /Lf_H2O                          )
+c #aH     TsisSV(ikl,isn) =    ( B_Enrg
+c #aH.                         +(1.              -eta_SV(ikl,isn))
+c #aH.                          *Lf_H2O                          )
+c #aH.                         / Cn_dSV
+c #aH.                         + TfSnow
+ 
+! #e1     STOP "PLEASE add Energy (#aH) from deposition/sublimation"
+ 
+ 
+C +--Update of the upper Snow layer Thickness
+C +  ----------------------------------------
+ 
+          dzsnSV(ikl,isn) =
+     .           max(zero,  dzsnSV(ikl,isnoSV(ikl)) + dzVap0)
+          isnoSV(ikl)     = isnoSV(ikl)             + NOLayr
+          isn             = isnoSV(ikl)
+          dzsnSV(ikl,isn) = dzsnSV(ikl,isn) + dzVap1
+          wes_SV(ikl)     = ro__SV(ikl,isn) * dzVap0
+
+      END DO
+ 
+ 
+C +--Energy Budget (OUT)
+C +  ===================
+ 
+! #vm   DO ikl=1,knonv
+! #vm     EqSn02(ikl) =-EqSn_0(ikl)
+! #vm.                 -EExcsv(ikl)
+! #vm   END DO
+! #vm DO   isn=nsno,1,-1
+! #vm   DO ikl=1,knonv
+! #vm     EqSn02(ikl) = EqSn01(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+! #vm.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+! #vm.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+! #vm   END DO
+! #vm END DO
+ 
+ 
+C +--Snow/I Budget
+C +  -------------
+ 
+! #m1   DO ikl=1,knonv
+! #m1     SIsubl(ikl) = dt__SV*HLs_sv(ikl)*min(isnoSV(ikl),1)
+! #m1.                        /Lx_H2O(ikl)
+! #m1     SIrnof(ikl) = rusnSV(ikl) + RnofSV(ikl) * dt__SV
+! #m1.                - SIrnof(ikl)
+! #m1   END DO
+ 
+ 
+C +--Anticipated Disappearance of a rapidly Melting too thin Last Snow Layer
+C +  =======================================================================
+ 
+      DO ikl=1,knonv
+        LastOK = min(1   , max(0   ,iiceSV(ikl)-isnoSV(ikl)+2)
+     .                    *min(1   ,isnoSV(ikl)-iiceSV(ikl))
+     .                    +min(1   ,isnoSV(ikl))              )
+        RapdOK = max(zero,sign(unun,dzMelt(ikl)-epsi         ))
+        ThinOK = max(zero,sign(unun,dz_Min     -dzsnSV(ikl,1)))
+        z_Melt = LastOK     *RapdOK*ThinOK
+        noSnow(ikl)   = noSnow(ikl)   + z_Melt
+        z_Melt        =                 z_Melt *dzsnSV(ikl,1)
+        dzsnSV(ikl,1) = dzsnSV(ikl,1) - z_Melt
+        EExcsv(ikl)   = EExcsv(ikl)   - z_Melt *ro__SV(ikl,1)
+     .                                *(1.     -eta_SV(ikl,1))*Lf_H2O
+ 
+C +--Water  Production
+C +  ^^^^^^^^^^^^^^^^^
+        drr_SV(ikl)   = drr_SV(ikl)
+     .                + ro__SV(ikl,1) * z_Melt /dt__SV
+      END DO
+ 
+ 
+C +--Update Nb of Layers
+C +  ===================
+ 
+      DO ikl=1,knonv
+        isnoSV(ikl)   = isnoSV(ikl)
+     .     * min(1,iabs(isnoSV(ikl)-noSnow(ikl)))
+      END DO
+ 
+ 
+! Energy Budget (OUT)
+! ===================
+ 
+! #e1   DO ikl=1,knonv
+! #e1     EqSn_1(ikl) = 0.
+! #e1   END DO
+! #e1 DO   isn=nsno,1,-1
+! #e1   DO ikl=1,knonv
+! #e1     EqSn_1(ikl) = EqSn_1(ikl) + ro__SV(ikl,isn) *dzsnSV(ikl,isn)
+! #e1.                *(Cn_dSV      *(TsisSV(ikl,isn) -TfSnow         )
+! #e1.                 -Lf_H2O      *(1.              -eta_SV(ikl,isn)))
+! #e1   END DO
+! #e1 END DO
+ 
+ 
+C +--Water  Budget (OUT)
+C +  ===================
+ 
+! #vm   DO ikl=1,knonv
+! #vm     WqSn_0(ikl) = WqSn_0(ikl)
+! #vm.                + HLs_sv(ikl)    * dt__SV
+! #vm.             *min(isnoSV(ikl),1) / Lx_H2O(ikl)
+! #vm     WqSn_1(ikl) = drr_SV(ikl)    * dt__SV
+! #vm.                + rusnSV(ikl)
+! #vm.                + RnofSV(ikl)    * dt__SV
+! #vm   END DO
+! #vm DO   isn=nsno,1,-1
+! #vm   DO ikl=1,knonv
+! #vm     WqSn_1(ikl) = WqSn_1(ikl)
+! #vm.                + ro__SV(ikl,isn)* dzsnSV(ikl,isn)
+! #vm   END DO
+! #vm END DO
+ 
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_qso.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_qso.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_qso.F	(revision 3851)
@@ -0,0 +1,710 @@
+ 
+ 
+      subroutine SISVAT_qSo
+! #m0.                     (Wats_0,Wats_1,Wats_d)
+ 
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_qSo                                 6-04-2001  MAR |
+C |   SubRoutine SISVAT_qSo computes the Soil      Water  Balance          |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  knonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+C |                     X       Number of Mosaic Cell per grid box         |
+C |                                                                        |
+C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
+C |   ^^^^^    isotSV   = 0,...,11:   Soil       Type                      |
+C |                       0:          Water, Solid or Liquid               |
+C |                                                                        |
+C |   INPUT:   rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
+C |   ^^^^^    drr_SV   : Rain   Intensity                       [kg/m2/s] |
+C |            LSdzsv   : Vertical   Discretization Factor             [-] |
+C |                     =    1. Soil                                       |
+C |                     = 1000. Ocean                                      |
+C |            dt__SV   : Time   Step                                  [s] |
+C |                                                                        |
+C |            Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
+C |            HLs_sv   : Latent Heat  Flux                         [W/m2] |
+C |                                                                        |
+C |   INPUT /  eta_SV   : Water      Content                       [m3/m3] |
+C |   OUTPUT:  Khydsv   : Soil   Hydraulic    Conductivity           [m/s] |
+C |   ^^^^^^                                                               |
+C |                                                                        |
+C |   OUTPUT:  RnofSV   : RunOFF Intensity                       [kg/m2/s] |
+C |   ^^^^^^   Wats_0   : Soil Water,  before Forcing                 [mm] |
+C |            Wats_1   : Soil Water,  after  Forcing                 [mm] |
+C |            Wats_d   : Soil Water          Forcing                 [mm] |
+C |                                                                        |
+C |   Internal Variables:                                                  |
+C |   ^^^^^^^^^^^^^^^^^^                                                   |
+C |            z_Bump   : (Partly)Bumpy Layers Height                  [m] |
+C |            z0Bump   :         Bumpy Layers Height                  [m] |
+C |            dzBump   :  Lowest Bumpy Layer:                         [m] |
+C |            etBump   :         Bumps Layer Averaged Humidity    [m3/m3] |
+C |            etaMid   : Layer Interface's Humidity               [m3/m3] |
+C |            eta__f   : Layer             Humidity  (Water Front)[m3/m3] |
+C |            Dhyd_f   : Soil  Hydraulic Diffusivity (Water Front) [m2/s] |
+C |            Dhydif   : Soil  Hydraulic Diffusivity               [m2/s] |
+C |            WgFlow   : Water         gravitational     Flux   [kg/m2/s] |
+C |            Wg_MAX   : Water MAXIMUM gravitational     Flux   [kg/m2/s] |
+C |            SatRat   : Water         Saturation        Flux   [kg/m2/s] |
+C |            WExces   : Water         Saturation Excess Flux   [kg/m2/s] |
+C |            Dhydtz   : Dhydif * dt / dz                             [m] |
+C |            FreeDr   : Free Drainage Fraction                       [-] |
+C |            Elem_A   : A Diagonal Coefficient                           |
+C |            Elem_C   : C Diagonal Coefficient                           |
+C |            Diag_A   : A Diagonal                                       |
+C |            Diag_B   : B Diagonal                                       |
+C |            Diag_C   : C Diagonal                                       |
+C |            Term_D   :   Independant Term                               |
+C |            Aux__P   : P Auxiliary Variable                             |
+C |            Aux__Q   : Q Auxiliary Variable                             |
+C |                                                                        |
+C |   TUNING PARAMETER:                                                    |
+C |   ^^^^^^^^^^^^^^^^                                                     |
+C |            z0soil   : Soil Surface averaged Bumps Height           [m] |
+C |                                                                        |
+C |   METHOD: NO   Skin Surface Humidity                                   |
+C |   ^^^^^^  Semi-Implicit Crank Nicholson Scheme                         |
+C |           (Partial) free Drainage, Water Bodies excepted (Lakes, Sea)  |
+C |                                                                        |
+
+C |                                                                        |
+C | # OPTIONS: #GF: Saturation Front                                       |
+C | # ^^^^^^^  #GH: Saturation Front allows Horton Runoff                  |
+C | #          #GA: Soil Humidity Geometric Average                        |
+C | #          #BP: Parameterization of Terrain Bumps                      |
+C |                                                                        |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+ 
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VAR0SV
+      use VARxSV
+      use VARySV
+
+     
+      IMPLICIT NONE
+
+ 
+C +--OUTPUT
+C +  ------
+ 
+! Water (Mass) Budget
+! ~~~~~~~~~~~~~~~~~~~
+! #m0 real      Wats_0(knonv)                 ! Soil Water,  before forcing
+! #m0 real      Wats_1(knonv)                 ! Soil Water,  after  forcing
+! #m0 real      Wats_d(knonv)                 ! Soil Water          forcing
+ 
+ 
+C +--Internal Variables
+C +  ==================
+ 
+      integer   isl   ,jsl   ,ist   ,ikl      !
+      integer   ikm   ,ikp   ,ik0   ,ik1      !
+      integer   ist__s,ist__w                 ! Soil/Water Body Identifier
+c #BP real      z0soil                        ! Soil Surface Bumps Height  [m]
+c #BP real      z_Bump                        !(Partly)Bumpy Layers Height [m]
+c #BP real      z0Bump                        !        Bumpy Layers Height [m]
+c #BP real      dzBump                        ! Lowest Bumpy Layer:
+ 
+c #BP real      etBump(knonv)                 ! Bumps Layer Averaged Humidity
+      real      etaMid                        ! Layer Interface's Humidity
+      real      Dhydif                        ! Hydraulic Diffusivity   [m2/s]
+      real      eta__f                        ! Water Front Soil Water Content
+      real      Khyd_f                        ! Water Front Hydraulic Conduct.
+      real      Khydav                        ! Hydraulic Conductivity   [m/s]
+      real      WgFlow                        ! Water gravitat. Flux [kg/m2/s]
+      real      Wg_MAX                        ! Water MAX.grav. Flux [kg/m2/s]
+      real      SatRat                        ! Saturation      Flux [kg/m2/s]
+      real      WExces                        ! Saturat. Excess Flux [kg/m2/s]
+      real      SoRnOF(knonv)                 ! Soil     Run    OFF
+      real      Dhydtz(knonv,-nsol:0)         ! Dhydif * dt / dz           [m]
+      real      Elem_A,Elem_B,Elem_C          !   Diagonal Coefficients
+      real      Diag_A(knonv,-nsol:0)         ! A Diagonal
+      real      Diag_B(knonv,-nsol:0)         ! B Diagonal
+      real      Diag_C(knonv,-nsol:0)         ! C Diagonal
+      real      Term_D(knonv,-nsol:0)         !   Independant Term
+      real      Aux__P(knonv,-nsol:0)         ! P Auxiliary Variable
+      real      Aux__Q(knonv,-nsol:0)         ! Q Auxiliary Variable
+      real      etaaux(knonv,-nsol:-nsol+1)   ! Soil Water Content     [m3/m3]
+      real      FreeDr                        ! Free Drainage Fraction (actual)
+      real      FreeD0                        ! Free Drainage Fraction (1=Full)
+      real      aKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: a * dt
+      real      bKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: b * dt
+ 
+! Water (Mass) Budget
+! ~~~~~~~~~~~~~~~~~~~
+c #mw logical         mwopen                  ! IO   Switch
+c #mw common/Sm_qSo_L/mwopen                  !
+c #mw real     hourwr,timewr                  !
+c #mw common/Sm_qSo_R/timewr                  !
+c #mw real            Evapor(knonv)           !
+ 
+ 
+C +--Internal DATA
+C +  =============
+ 
+c #BP data      z0soil/0.020/                 ! Soil Surface Bumps Height  [m]
+      data      FreeD0/1.000/                 ! Free Drainage Fraction (1=Full)
+ 
+      aKdtSV3=aKdtSV2*dt__SV
+      bKdtSV3=bKdtSV2*dt__SV
+ 
+! Water  Budget (IN)
+! ==================
+ 
+! #m0   DO ikl=1,knonv
+! #m0     Wats_0(ikl) = 0.                    ! OLD RunOFF Contrib.
+! #m0     Wats_d(ikl) = drr_SV(ikl)           ! Water Surface Forc.
+! #m0   END DO
+ 
+! #m0      isl= -nsol
+! #m0   DO ikl=1,knonv
+! #m0     Wats_0(ikl) = Wats_0(ikl)
+! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+! #m0.                + eta_SV(ikl,isl+1) *dz_8SV(isl) ) * LSdzsv(ikl)
+! #m0   END DO
+ 
+! #m0 DO   isl= -nsol+1,-1
+! #m0   DO ikl=1,knonv
+! #m0     Wats_0(ikl) = Wats_0(ikl)
+! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz34SV(isl)
+! #m0.                +(eta_SV(ikl,isl-1)
+! #m0.                 +eta_SV(ikl,isl+1))*dz_8SV(isl) ) * LSdzsv(ikl)
+! #m0   END DO
+! #m0 END DO
+ 
+! #m0      isl=  0
+! #m0   DO ikl=1,knonv
+! #m0     Wats_0(ikl) = Wats_0(ikl)
+! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+! #m0.                + eta_SV(ikl,isl-1) *dz_8SV(isl) ) * LSdzsv(ikl)
+! #m0   END DO
+ 
+ 
+C +--Gravitational Flow
+C +  ==================
+ 
+C +...    METHOD: Surface Water Flux saturates successively the soil layers
+C +       ^^^^^^  from up to below, but is limited by infiltration capacity.
+C +               Hydraulic Conductivity again contributes after this step,
+C +               not redundantly because of a constant (saturated) profile.
+ 
+C +--Flux  Limitor
+C +  ^^^^^^^^^^^^^
+           isl=0
+        DO ikl=1,knonv
+          ist    = isotSV(ikl)                     ! Soil Type
+          ist__s = min(ist, 1)                     ! 1 => Soil
+          ist__w = 1 - ist__s                      ! 1 => Water Body
+          Dhydif = s1__SV(ist)
+     .               *max(epsi,eta_SV(ikl,isl))    ! Hydraulic Diffusivity
+     .                      **(bCHdSV(ist)+2.)     ! DR97, Eqn.(3.36)
+          Dhydif = ist__s    * Dhydif              !
+     .           + ist__w    * vK_dSV              ! Water Bodies
+C +
+          Khydav = ist__s    * Ks_dSV(ist)         ! DR97  Assumption
+     .           + ist__w    * vK_dSV              ! Water Bodies
+C +
+          Wg_MAX = ro_Wat     *Dhydif              ! MAXimum  Infiltration
+     .           *(etadSV(ist)-eta_SV(ikl,isl))    !          Rate
+     .           /(dzAvSV(isl)*LSdzsv(ikl)    )    !
+     .          +  ro_Wat     *Khydav              !
+ 
+C +--Surface Horton RunOFF
+C +  ^^^^^^^^^^^^^^^^^^^^^
+          SoRnOF(ikl) =
+     .                max(zero,drr_SV(ikl)-Wg_MAX)
+        RuofSV(ikl,1) = RuofSV(ikl,1) +    SoRnOF(ikl)
+          drr_SV(ikl) =        drr_SV(ikl)-SoRnOF(ikl)
+        RuofSV(ikl,2) = RuofSV(ikl,2) +max(0.,drr_SV(ikl))
+        END DO
+ 
+c #GF DO   isl=0,-nsol,-1
+c #GF   DO ikl=1,knonv
+c #GF     ist    = isotSV(ikl)                     ! Soil Type
+c #GF     ist__s = min(ist, 1)                     ! 1 => Soil
+c #GF     ist__w = 1 - ist__s                      ! 1 => Water Body
+ 
+C +--Water Diffusion
+C +  ^^^^^^^^^^^^^^^
+c #GF     Dhydif = s1__SV(ist)
+c #GF.               *max(epsi,eta_SV(ikl,isl))    ! Hydraulic Diffusivity
+c #GF.                      **(bCHdSV(ist)+2.)     ! DR97, Eqn.(3.36)
+c #GF     Dhydif = ist__s    * Dhydif              !
+c #GF.           + ist__w    * vK_dSV              ! Water Bodies
+ 
+C +--Water Conduction (without Horton Runoff)
+C +  ^^^^^^^^^^^^^^^^
+c #GF     Khyd_f =             Ks_dSV(ist)
+C +...    Uses saturated K ==> Horton Runoff ~0    !
+ 
+C +--Water Conduction (with    Horton Runoff)
+C +  ^^^^^^^^^^^^^^^^
+c #GH     ik0    = nkhy       *eta_SV(ikl,isl)
+c #GH.                        /etadSV(ist)
+c #GH     eta__f         =            1.
+c #GH.   -aKdtSV3(ist,ik0)/(2. *dzAvSV(isl)
+c #GH.                        *LSdzsv(ikl))
+c #GH     eta__f         = max(eps_21,eta__f)
+c #GH     eta__f         = min(etadSV(ist),
+c #GH.                         eta_SV(ikl,isl) +
+c #GH.   (aKdtSV3(ist,ik0)     *eta_SV(ikl,isl)
+c #GH.   +bKdtSV3(ist,ik0))   /(dzAvSV(isl)
+c #GH.                        *LSdzsv(ikl))
+c #GH.                       / eta__f          )
+c #GH     eta__f         = .5*(eta_SV(ikl,isl)
+c #GH.                        +eta__f)
+ 
+c #gh     eta__f         =     eta_SV(ikl,isl)
+ 
+c #GH     ik0    = nkhy       *eta__f
+c #GH.                        /etadSV(ist)
+c #GH     Khyd_f =
+c #GH.   (aKdtSV3(ist,ik0)     *eta__f
+c #GH.   +bKdtSV3(ist,ik0))    /dt__SV
+ 
+c #GF     Khydav = ist__s    * Khyd_f              ! DR97  Assumption
+c #GF.           + ist__w    * vK_dSV              ! Water Bodies
+ 
+C +--Gravitational Flow
+C +  ^^^^^^^^^^^^^^^^^^
+c #GF     Wg_MAX =                                 ! MAXimum  Infiltration
+c #GF.             ro_Wat     *Dhydif              !          Rate
+c #GF.           *(etadSV(ist)-eta_SV(ikl,isl))    !
+c #GF.           /(dzAvSV(isl)*LSdzsv(ikl)    )    !
+c #GF.          +  ro_Wat     *Khydav              !
+c #GF   END DO
+c #GF END DO
+c #GF   DO ikl=1,knonv
+c #GF     SoRnOF(ikl)     =    SoRnOF(ikl)         ! RunOFF Intensity
+c #GF.                    +    drr_SV(ikl)         ! [kg/m2/s]
+C +!!!    Inclure la possibilite de creer une mare sur un bedrock impermeable
+c #GF     drr_SV(ikl) = 0.
+c #GF   END DO
+ 
+ 
+C +--Temperature Correction due to a changed Soil Energy Content
+C +  ===========================================================
+ 
+C +!!!    Mettre en oeuvre le couplage humidit?-?nergie
+ 
+ 
+C +--Full Resolution of the Richard's Equation
+C +  =========================================
+ 
+C +...    METHOD: Water content evolution results from water fluxes
+C +       ^^^^^^  at the layer boundaries
+C +               Conductivity is approximated by a piecewise linear profile.
+C +               Semi-Implicit Crank-Nicholson scheme is used.
+C +              (Bruen, 1997, Sensitivity of hydrological processes
+C +                            at the land-atmosphere interface.
+C +                            Proc. Royal Irish Academy,  IGBP symposium
+C +                            on global change and the Irish Environment.
+C +                            Publ.: Maynooth)
+ 
+C +                      - - - - - - - -   isl+1/2   - -  ^
+C +                                                       |
+C +   eta_SV(isl)        ---------------   isl     -----  +--dz_dSV(isl)  ^
+C +                                                       |               |
+C +   Dhydtz(isl) etaMid - - - - - - - -   isl-1/2   - -  v  dzmiSV(isl)--+
+C +                                                                       |
+C +   eta_SV(isl-1)      ---------------   isl-1   -----                  v
+ 
+C +--Transfert       Coefficients
+C +  ----------------------------
+ 
+      DO   isl=-nsol+1,0
+        DO ikl=1,knonv
+          ist    =      isotSV(ikl)                       ! Soil Type
+          ist__s =      min(ist, 1)                       ! 1 => Soil
+          ist__w =      1 - ist__s                        ! 1 => Water Body
+          etaMid =     (dz_dSV(isl)  *eta_SV(ikl,isl-1)   ! eta at layers
+     .                 +dz_dSV(isl-1)*eta_SV(ikl,isl)  )  !     interface
+     .           /(2.0* dzmiSV(isl))                      ! LSdzsv implicit !
+c #GA     etaMid = sqrt(dz_dSV(isl)  *eta_SV(ikl,isl-1)   ! Idem, geometric
+c #GA.                 *dz_dSV(isl-1)*eta_SV(ikl,isl)  )  !       average
+c #GA.           /(2.0* dzmiSV(isl))                      ! (Vauclin&al.1979)
+          Dhydif          =    s1__SV(ist)                ! Hydraul.Diffusi.
+     .  *(etaMid         **(   bCHdSV(ist)+2.))           ! DR97, Eqn.(3.36)
+          Dhydtz(ikl,isl) =    Dhydif*dt__SV              !
+     .                              /(dzmiSV(isl)         !
+     .                               *LSdzsv(ikl))        !
+          Dhydtz(ikl,isl) =    Dhydtz(ikl,isl) * ist__s   ! Soil
+     .        +0.5*dzmiSV(isl)*LSdzsv(ikl)     * ist__w   ! Water bodies
+ 
+        END DO
+      END DO
+           isl=-nsol
+        DO ikl=1,knonv
+          Dhydtz(ikl,isl) =    0.0                        !
+        END DO
+ 
+ 
+C +--Tridiagonal Elimination: Set Up
+C +  -------------------------------
+ 
+C +--Soil/Snow Interior
+C +  ^^^^^^^^^^^^^^^^^^
+ 
+      DO   isl=0,-nsol,-1
+        DO ikl=1,knonv
+         ist             = isotSV(ikl)
+         eta_SV(ikl,isl) = max(epsi,           eta_SV(ikl,isl))
+        END DO
+      END DO
+ 
+      DO   isl=-nsol,-nsol+1
+        DO ikl=1,knonv
+          etaaux(ikl,isl) =  eta_SV(ikl,isl)
+        END DO
+      END DO
+ 
+      DO   isl=-nsol+1,-1
+        DO ikl=1,knonv
+          ist      =         isotSV(ikl)
+          ikm      = nkhy *  eta_SV(ikl,isl-1) / etadSV(ist)
+          ik0      = nkhy *  eta_SV(ikl,isl)   / etadSV(ist)
+          ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
+ 
+          if(ikm<0.or.ik0<0.or.ikp<0)then
+           print *,"CRASH1 in sisvat_qso.f on pixel (i,j,n)",
+     .     ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
+           print *,"decrease your time step or increase ntphys "//
+     .             "and ntdiff in time_steps.f"
+           stop
+          endif
+ 
+ 
+          Elem_A   =         Dhydtz(ikl,isl)
+     .                    -  aKdtSV3(ist,ikm)* dziiSV(isl)  *LSdzsv(ikl)
+          Elem_B   =      - (Dhydtz(ikl,isl)
+     .                      +Dhydtz(ikl,isl+1)
+     .                      -aKdtSV3(ist,ik0)*(dziiSV(isl+1)
+     .                                       -dzi_SV(isl) )*LSdzsv(ikl))
+          Elem_C   =         Dhydtz(ikl,isl+1)
+     .                    +  aKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
+          Diag_A(ikl,isl) =  dz_8SV(isl)        *LSdzsv(ikl)
+     .                      -Implic            * Elem_A
+          Diag_B(ikl,isl) =  dz34SV(isl)        *LSdzsv(ikl)
+     .                      -Implic            * Elem_B
+          Diag_C(ikl,isl) =  dz_8SV(isl)        *LSdzsv(ikl)
+     .                      -Implic            * Elem_C
+ 
+          Term_D(ikl,isl) = (dz_8SV(isl) *LSdzsv(ikl)
+     .                      +Explic      *Elem_A     )*eta_SV(ikl,isl-1)
+     .                    + (dz34SV(isl) *LSdzsv(ikl)
+     .                      +Explic      *Elem_B     )*eta_SV(ikl,isl)
+     .                    + (dz_8SV(isl) *LSdzsv(ikl)
+     .                      +Explic      *Elem_C     )*eta_SV(ikl,isl+1)
+     .                    + (bKdtSV3(ist,ikp)* dzi_SV(isl+1)
+     .                      +bKdtSV3(ist,ik0)*(dziiSV(isl+1)
+     .                                       -dzi_SV(isl)  )
+     .                      -bKdtSV3(ist,ikm)* dziiSV(isl)   )
+     .                                      * LSdzsv(ikl)
+        END DO
+      END DO
+ 
+           isl=-nsol
+        DO ikl=1,knonv
+          ist      =         isotSV(ikl)
+c #       FreeDr   =         FreeD0            *  min(ist,1)
+          FreeDr   =         iWaFSV(ikl)       *  min(ist,1)
+          ik0      = nkhy *  eta_SV(ikl,isl  ) / etadSV(ist)
+          ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
+ 
+          if(ik0<0.or.ikp<0)then
+           print *,"CRASH2 in sisvat_qso.f on pixel (i,j,n)",
+     .     ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
+           print *,"decrease your time step or increase ntphys "//
+     .             "and ntdiff in time_steps.f"
+           stop
+          endif
+ 
+          Elem_A   =         0.
+          Elem_B   =      - (Dhydtz(ikl,isl+1)
+     .                      -aKdtSV3(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl)
+     .                                       -FreeDr                  ))
+          Elem_C   =         Dhydtz(ikl,isl+1)
+     .                    +  aKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
+          Diag_A(ikl,isl) =  0.
+          Diag_B(ikl,isl) =  dz78SV(isl) *LSdzsv(ikl)
+     .                      -Implic      *Elem_B
+          Diag_C(ikl,isl) =  dz_8SV(isl) *LSdzsv(ikl)
+     .                      -Implic      *Elem_C
+ 
+          Term_D(ikl,isl) = (dz78SV(isl) *LSdzsv(ikl)
+     .                      +Explic      *Elem_B     )*eta_SV(ikl,isl)
+     .                    + (dz_8SV(isl) *LSdzsv(ikl)
+     .                      +Explic      *Elem_C     )*eta_SV(ikl,isl+1)
+     .                    + (bKdtSV3(ist,ikp)* dzi_SV(isl+1)*LSdzsv(ikl)
+     .                      +bKdtSV3(ist,ik0)*(dziiSV(isl+1)*LSdzsv(ikl)
+     .                                       -FreeDr                  ))
+        END DO
+ 
+           isl=0
+        DO ikl=1,knonv
+          ist      =         isotSV(ikl)
+          ikm      = nkhy *  eta_SV(ikl,isl-1) / etadSV(ist)
+          ik0      = nkhy *  eta_SV(ikl,isl)   / etadSV(ist)
+          Elem_A   =         Dhydtz(ikl,isl)
+     .                    -  aKdtSV3(ist,ikm)* dziiSV(isl)*LSdzsv(ikl)
+          Elem_B   =      - (Dhydtz(ikl,isl)
+     .                      +aKdtSV3(ist,ik0)* dzi_SV(isl)*LSdzsv(ikl))
+          Elem_C   =         0.
+          Diag_A(ikl,isl) =  dz_8SV(isl) *LSdzsv(ikl)
+     .                    -  Implic      *Elem_A
+          Diag_B(ikl,isl) =  dz78SV(isl) *LSdzsv(ikl)
+     .                    -  Implic      *Elem_B
+          Diag_C(ikl,isl) =  0.
+C +
+          Term_D(ikl,isl) = (dz_8SV(isl) *LSdzsv(ikl)
+     .                      +Explic      *Elem_A     )*eta_SV(ikl,isl-1)
+     .                    + (dz78SV(isl) *LSdzsv(ikl)
+     .                      +Explic      *Elem_B     )*eta_SV(ikl,isl)
+     .                    - (bKdtSV3(ist,ik0)* dzi_SV(isl)
+     .                      +bKdtSV3(ist,ikm)* dziiSV(isl))*LSdzsv(ikl)
+     .            + dt__SV *(HLs_sv(ikl)    *     (1-min(1,isnoSV(ikl)))
+     .                     / (ro_Wat *dz_dSV(0) * Lx_H2O(ikl))
+cXF bug 17/05/2017
+     .                      +drr_SV(ikl))/ro_Wat
+        END DO
+ 
+        DO ikl=1,knonv
+         drr_SV(ikl)=0. ! drr is included in the 1st soil layer
+        ENDDO
+ 
+C +
+C +
+C +--Tridiagonal Elimination
+C +  =======================
+C +
+C +--Forward  Sweep
+C +  ^^^^^^^^^^^^^^
+        DO ikl=  1,knonv
+          Aux__P(ikl,-nsol) = Diag_B(ikl,-nsol)
+          Aux__Q(ikl,-nsol) =-Diag_C(ikl,-nsol)/Aux__P(ikl,-nsol)
+        END DO
+C +
+      DO   isl=-nsol+1,0
+        DO ikl=      1,knonv
+          Aux__P(ikl,isl)   = Diag_A(ikl,isl)  *Aux__Q(ikl,isl-1)
+     .                       +Diag_B(ikl,isl)
+          Aux__Q(ikl,isl)   =-Diag_C(ikl,isl)  /Aux__P(ikl,isl)
+        END DO
+      END DO
+C +
+        DO ikl=      1,knonv
+          eta_SV(ikl,-nsol) = Term_D(ikl,-nsol)/Aux__P(ikl,-nsol)
+        END DO
+C +
+      DO   isl=-nsol+1,0
+        DO ikl=      1,knonv
+          eta_SV(ikl,isl)   =(Term_D(ikl,isl)
+     .                       -Diag_A(ikl,isl)  *eta_SV(ikl,isl-1))
+     .                                         /Aux__P(ikl,isl)
+        END DO
+      END DO
+ 
+C +--Backward Sweep
+C +  ^^^^^^^^^^^^^^
+      DO   isl=-1,-nsol,-1
+        DO ikl= 1,knonv
+          eta_SV(ikl,isl)   = Aux__Q(ikl,isl)  *eta_SV(ikl,isl+1)
+     .                                         +eta_SV(ikl,isl)
+        END DO
+      END DO
+ 
+ 
+C +--Horton RunOFF Intensity
+C +  =======================
+ 
+      DO   isl=0,-nsol,-1
+        DO ikl=1,knonv
+          ist    =   isotSV(ikl)                   ! Soil Type
+          SatRat =  (eta_SV(ikl,isl)-etadSV(ist))  ! OverSaturation Rate
+     .              *ro_Wat         *dzAvSV(isl)   !
+     .                              *LSdzsv(ikl)   !
+     .                              /dt__SV        !
+          SoRnOF(ikl)     =          SoRnOF(ikl)   !
+     .                    + max(zero,SatRat)       !
+          RuofSV(ikl,3)   = RuofSV(ikl,3) +
+     .                    + max(zero,SatRat)
+          eta_SV(ikl,isl) = max(epsi               !
+c #ED.                         +etamSV(isotSV(ikl))!
+     .                         ,eta_SV(ikl,isl))   !
+          eta_SV(ikl,isl) = min(eta_SV(ikl,isl)    !
+     .                         ,etadSV(ist)    )   !
+        END DO
+      END DO
+ 
+C +--IO, for Verification
+C +  ~~~~~~~~~~~~~~~~~~~~
+c #WR     write(6,6010)
+ 6010     format(/,1x)
+      DO   isl= 0,-nsol,-1
+        DO ikl= 1,knonv
+          ist      =          isotSV(ikl)
+          ikp      = nkhy  *  eta_SV(ikl,isl)  /etadSV(ist)
+          Khydsv(ikl,isl)   =(aKdtSV3(ist,ikp)  *eta_SV(ikl,isl)
+     .                       +bKdtSV3(ist,ikp)) *2.0/dt__SV
+c #WR     write(6,6011) ikl,isl,eta_SV(ikl,isl)*1.e3,
+c #WR.                  ikp,    aKdtSV3(ist,ikp),bKdtSV3(ist,ikp),
+c #WR.                          Khydsv(ikl,isl)
+ 6011     format(2i3,f8.1,i3,3e12.3)
+        END DO
+      END DO
+ 
+ 
+C +--Additional RunOFF Intensity
+C +  ===========================
+ 
+        DO ikl=1,knonv
+          ist      =          isotSV(ikl)
+          ik0      = nkhy  *  etaaux(ikl,-nsol  ) /etadSV(ist)
+c #       FreeDr   =          FreeD0            *  min(ist,1)
+          FreeDr   =          iWaFSV(ikl)       *  min(ist,1)
+          SoRnOF(ikl) =  SoRnOF(ikl)
+     .                + (aKdtSV3(ist,ik0)*(etaaux(ikl,-nsol)*Explic
+     .                                   +eta_SV(ikl,-nsol)*Implic)
+     .                 + bKdtSV3(ist,ik0)                           )
+     .                 * FreeDr          *ro_Wat           /dt__SV
+        RuofSV(ikl,3) = RuofSV(ikl,3)
+     .                + (aKdtSV3(ist,ik0)*(etaaux(ikl,-nsol)*Explic
+     .                                   +eta_SV(ikl,-nsol)*Implic)
+     .                 + bKdtSV3(ist,ik0)                           )
+     .                 * FreeDr          *ro_Wat           /dt__SV
+ 
+C +--Full Run OFF: Update
+C +  ~~~~~~~~~~~~~~~~~~~~
+          RnofSV(ikl)   = RnofSV(ikl)   + SoRnOF(ikl)
+          RuofSV(ikl,4) = RuofSV(ikl,4) + SoRnOF(ikl)
+        END DO
+ 
+ 
+C +--Temperature Correction due to a changed Soil Energy Content
+C +  ===========================================================
+ 
+C +!!!    Mettre en oeuvre le couplage humidit?-?nergie
+ 
+ 
+C +--Bumps/Asperites Treatment
+C +  =========================
+ 
+C +--Average over Bump Depth (z0soil)
+C +  --------------------------------
+ 
+c #BP       z_Bump      = 0.
+c #BP     DO ikl=1,knonv
+c #BP       etBump(ikl) = 0.
+c #BP     END DO
+C +
+c #BP DO     isl=0,-nsol,-1
+c #BP       z0Bump      = z_Bump
+c #BP       z_Bump      = z_Bump      +  dzAvSV(isl)
+c #BP   IF (z_Bump.lt.z0soil)                                       THEN
+c #BP     DO ikl=1,knonv
+c #BP       etBump(ikl) = etBump(ikl) +  dzAvSV(isl)   *eta_SV(ikl,isl)
+c #BP     END DO
+c #BP   END IF
+c #BP   IF (z_Bump.gt.z0soil.AND.z0Bump.lt.z0soil)                  THEN
+c #BP     DO ikl=1,knonv
+c #BP       etBump(ikl) = etBump(ikl) + (z0soil-z0Bump)*eta_SV(ikl,isl)
+c #BP       etBump(ikl) = etBump(ikl) /  z0soil
+c #BP     END DO
+c #BP   END IF
+c #BP END DO
+ 
+ 
+C +--Correction
+C +  ----------
+ 
+c #BP       z_Bump      = 0.
+c #BP DO     isl=0,-nsol,-1
+c #BP       z0Bump =  z_Bump
+c #BP       z_Bump =  z_Bump +dzAvSV(isl)
+c #BP   IF (z_Bump.lt.z0soil)                                       THEN
+c #BP     DO ikl=1,knonv
+c #BP       eta_SV(ikl,isl) = etBump(ikl)
+c #BP     END DO
+c #BP   END IF
+c #BP   IF (z_Bump.gt.z0soil.AND.z0Bump.lt.z0soil)                  THEN
+c #BP       dzBump          =    z_Bump -  z0soil
+c #BP     DO ikl=1,knonv
+c #BP       eta_SV(ikl,isl) =(etBump(ikl)    *(dzAvSV(isl)-dzBump)
+c #BP.                      + eta_SV(ikl,isl)*             dzBump)
+c #BP.                      /                  dzAvSV(isl)
+c #BP     END DO
+c #BP   END IF
+c #BP END DO
+ 
+ 
+C +--Positive Definite
+C +  =================
+ 
+c #BP DO   isl= 0,-nsol,-1
+c #BP   DO ikl= 1,knonv
+c #BP     eta_SV(ikl,isl)   =          max(epsi,eta_SV(ikl,isl))
+c #BP   END DO
+c #BP END DO
+ 
+ 
+C +--Water  Budget (OUT)
+C +  ===================
+ 
+! #m0   DO ikl=1,knonv
+! #m0     Wats_d(ikl) = Wats_d(ikl)                    !
+! #m0.                + drr_SV(ikl)     *zero          ! Precipitation is
+C +                                      \______________ already included
+! #m0.                + HLs_sv(ikl)
+! #m0.          *(1-min(isnoSV(ikl),1)) /Lx_H2O(ikl)   ! Evaporation
+! #m0.                - SoRnOF(ikl)                    ! Soil RunOFF Contrib.
+! #m0     Wats_1(ikl) = 0.                             !
+c #mw     Evapor(ikl) = HLs_sv(ikl)     *dt__SV        !
+c #mw.          *(1-min(isnoSV(ikl),1)) /Lx_H2O(ikl)   !
+! #m0   END DO
+ 
+! #m0 DO   isl= -nsol,0
+! #m0   DO ikl=1,knonv
+! #m0     Wats_d(ikl) = Wats_d(ikl)                    !
+! #m0   END DO
+! #m0 END DO
+! #m0   DO ikl=1,knonv
+! #m0     Wats_d(ikl) = Wats_d(ikl)     *dt__SV        !
+! #m0   END DO
+ 
+! #m0      isl= -nsol
+! #m0   DO ikl=1,knonv
+! #m0     Wats_1(ikl) = Wats_1(ikl)
+! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+! #m0.                + eta_SV(ikl,isl+1) *dz_8SV(isl) ) *LSdzsv(ikl)
+! #m0   END DO
+ 
+! #m0 DO   isl= -nsol+1,-1
+! #m0   DO ikl=1,knonv
+! #m0     Wats_1(ikl) = Wats_1(ikl)
+! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz34SV(isl)
+! #m0.                +(eta_SV(ikl,isl-1)
+! #m0.                 +eta_SV(ikl,isl+1))*dz_8SV(isl) ) *LSdzsv(ikl)
+! #m0   END DO
+! #m0 END DO
+ 
+! #m0      isl=  0
+! #m0   DO ikl=1,knonv
+! #m0     Wats_1(ikl) = Wats_1(ikl)
+! #m0.      + ro_Wat *( eta_SV(ikl,isl)   *dz78SV(isl)
+! #m0.                + eta_SV(ikl,isl-1) *dz_8SV(isl) ) *LSdzsv(ikl)
+! #m0   END DO
+ 
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_sop.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_sop.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_sop.F	(revision 3851)
@@ -0,0 +1,521 @@
+ 
+ 
+      subroutine SnOptP(jjtime)
+ 
+C +------------------------------------------------------------------------+
+C | MAR/SISVAT   SnOptP                                    12-08-2019  MAR |
+C |   SubRoutine SnOptP computes the Snow Pack optical Properties          |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  knonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     Grid Boxes       |
+C |                     X       Number of Mosaic Cell per Grid Box         |
+C |                                                                        |
+C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |
+C |   ^^^^^    ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+C |                                                                        |
+C |                                                                        |
+C |   INPUT:   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+C |   ^^^^^    G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+C |            agsnSV   : Snow       Age                             [day] |
+C |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
+C |            eta_SV   : Water      Content                       [m3/m3] |
+C |            rusnSV   : Surficial  Water   Thickness   [kg/m2] .OR. [mm] |
+C |            SWS_SV   : Surficial  Water   Status                        |
+C |            dzsnSV   : Snow       Layer   Thickness                 [m] |
+C |                                                                        |
+C |            albssv   : Soil       Albedo                            [-] |
+C |            zzsnsv   : Snow       Pack    Thickness                 [m] |
+C |                                                                        |
+C |   OUTPUT:  albisv   : Snow/Ice/Water/Soil Integrated Albedo        [-] |
+C |   ^^^^^^   sEX_sv   : Verticaly Integrated Extinction Coefficient      |
+C |                                                                        |
+C |   Internal Variables:                                                  |
+C |   ^^^^^^^^^^^^^^^^^^                                                   |
+C |            SnOpSV   : Snow Grain optical Size                      [m] |
+C |            EX1_sv   : Integrated Snow Extinction (0.3--0.8micr.m)      |
+C |            EX2_sv   : Integrated Snow Extinction (0.8--1.5micr.m)      |
+C |            EX3_sv   : Integrated Snow Extinction (1.5--2.8micr.m)      |
+C |                                                                        |
+C |   METHODE:    Calcul de la taille optique des grains ? partir de       |
+C |   ^^^^^^^    -leur type decrit par les deux variables descriptives     |
+C |                    continues sur la plage -99/+99 passees en appel.    |
+C |              -la taille optique (1/10mm) des etoiles,                  |
+C |                                          des grains fins et            |
+C |                                          des jeunes faces planes       |
+C |                                                                        |
+C |   METHOD:     Computation of the optical diameter of the grains        |
+C |   ^^^^^^      described with the CROCUS formalism G1snSV / G2snSV      |
+C |                                                                        |
+C |   REFERENCE: Brun et al.      1989, J. Glaciol 35 pp. 333--342         |
+C |   ^^^^^^^^^  Brun et al.      1992, J. Glaciol 38 pp.  13-- 22         |
+C |              Eric Martin Sept.1996                                     |
+C |                                                                        |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+ 
+
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VARxSV
+      use VARySV
+      use VARtSV
+      USE surface_data, only: iflag_albzenith
+
+      IMPLICIT NONE
+
+ 
+C + -- INPUT
+      integer jjtime
+
+C +--Internal Variables
+C +  ==================
+ 
+      real      coalb1(knonv)                      ! weighted Coalbedo, Vis.
+      real      coalb2(knonv)                      ! weighted Coalbedo, nIR 1
+      real      coalb3(knonv)                      ! weighted Coalbedo, nIR 2
+      real      coalbm                             ! weighted Coalbedo, mean
+      real      sExt_1(knonv)                      ! Extinction Coeff., Vis.
+      real      sExt_2(knonv)                      ! Extinction Coeff., nIR 1
+      real      sExt_3(knonv)                      ! Extinction Coeff., nIR 2
+      real      SnOpSV(knonv,      nsno)           ! Snow Grain optical Size
+c #AG real      agesno
+ 
+      integer   isn   ,ikl   ,isn1  
+      real      sbeta1,sbeta2,sbeta3,sbeta4,sbeta5
+      real      AgeMax,AlbMin,HSnoSV,HIceSV,doptmx,SignG1,Sph_OK
+      real      dalbed,dalbeS,dalbeW
+      real      bsegal,czemax,csegal
+      real      RoFrez,DiffRo,SignRo,SnowOK,OpSqrt
+      real      albSn1,albIc1,a_SnI1,a_SII1
+      real      albSn2,albIc2,a_SnI2,a_SII2
+      real      albSn3,albIc3,a_SnI3,a_SII3
+      real      albSno,albIce,albSnI,albSII,albWIc,albmax
+      real      doptic,Snow_H,SIce_H,SnownH,SIcenH
+      real      exarg1,exarg2,exarg3,sign_0,sExt_0
+      real      albedo_old,albCor
+      real      ro_ave,dz_ave,minalb
+      real      thetazs,thetazs0,aap,bbp,ccp,alb0      ! parameters for zenoth angle effect at Dome C
+
+
+ 
+C +--Local   DATA
+C +  ============
+ 
+C +--For the computation of the solar irradiance extinction in snow
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      data      sbeta1/0.0192/,sbeta2/0.4000/,sbeta3/0.1098/
+      data      sbeta4/1.0000/
+      data      sbeta5/2.00e1/
+ 
+C +--Snow Age Maximum (Taiga, e.g. Col de Porte)
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      data      AgeMax  /60.0/
+C +...          AgeMax:  Snow Age Maximum                              [day]
+ 
+      data      AlbMin  /0.94/
+C +...          AlbMin:  Albedo   Minimum / visible (0.3--0.8 micrometers)
+ 
+      data      HSnoSV  /0.01/
+C +...          HSnoSV:  Snow     Thickness through witch
+C +                      Albedo is interpolated to Ice  Albedo
+      data      HIceSV  /0.10/
+C +...          HIceSV:  Snow/Ice Thickness through witch
+C +                      Albedo is interpolated to Soil Albedo
+      data      doptmx  /2.3e-3/
+C +...          doptmx:  Maximum  optical Diameter    (pi * R**2)        [m]
+C +
+      data      czeMAX  /0.173648178/  ! 80.deg (Segal et al., 1991 JAS)
+
+      data      bsegal  /4.00       /  !
+      data      albmax  /0.99       /  ! Albedo max
+
+C +-- For the computation of solar zenoth angle effect from Dome C data
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      data      aap/0.00016/,bbp/-0.017/,ccp/1.2/
+
+ 
+ 
+C +--Snow Grain optical Size
+C +  =======================
+ 
+        DO ikl=1,knonv
+         DO   isn=1,max(1,isnoSV(ikl))
+ 
+          G2snSV(ikl,isn) =  max(epsi,G2snSV(ikl,isn))
+C +...    Avoid non physical Values
+ 
+          SignG1          = sign(unun,G1snSV(ikl,isn))
+          Sph_OK          =  max(zero,SignG1)
+ 
+          SnOpSV(ikl,isn) =   1.e-4 *
+C +...    SI:           (from 1/10 mm to m)
+ 
+ 
+C +--Contribution of Non Dendritic Snow
+C +  ----------------------------------
+ 
+     .    (    Sph_OK *(      G2snSV(ikl,isn)*G1snSV(ikl,isn)/G1_dSV
+     .              +max(demi*G2snSV(ikl,isn),DFcdSV)
+     .                 *(unun-G1snSV(ikl,isn)                /G1_dSV))
+ 
+ 
+C +--Contribution of     Dendritic Snow
+C +  ----------------------------------
+ 
+     .    +(1.-Sph_OK)*(     -G1snSV(ikl,isn)*DDcdSV         /G1_dSV
+     .                 +(unun+G1snSV(ikl,isn)                /G1_dSV)
+     .                  *    (G2snSV(ikl,isn)*DScdSV         /G1_dSV
+     .                 +(unun-G2snSV(ikl,isn)                /G1_dSV)
+     .                                       *DFcdSV                 )))
+          SnOpSV(ikl,isn) =  max(zero,SnOpSV(ikl,isn))
+        END DO
+      END DO
+ 
+ 
+C +--Snow/Ice Albedo
+C +  ===============
+
+ 
+ 
+C +--Uppermost effective Snow Layer
+C +  ------------------------------
+ 
+        DO ikl=1,knonv
+ 
+           isn   =  max(iun,isnoSV(ikl))
+ 
+          SignRo = sign(unun, rocdSV - ro__SV(ikl,isn))
+          SnowOK =  max(zero,SignRo) ! Ice Density Threshold
+ 
+          OpSqrt = sqrt(SnOpSV(ikl,isn))
+ 
+cCA    +--Correction of snow albedo for Antarctica/Greenland
+cCA       --------------------------------------------------
+          albCor = 1.
+c #GL     albCor = 1.01
+c #AC     albCor = 1.01
+ 
+          albSn1 =  0.96-1.580*OpSqrt
+          albSn1 =  max(albSn1,AlbMin)
+ 
+          albSn1 =  max(albSn1,zero)
+          albSn1 =  min(albSn1*albCor,unun)
+ 
+          albSn2 =  0.95-15.40*OpSqrt
+          albSn2 =  max(albSn2,zero)
+          albSn2 =  min(albSn2*albCor,unun)
+ 
+          doptic =  min(SnOpSV(ikl,isn),doptmx)
+          albSn3 =  346.3*doptic -32.31*OpSqrt +0.88
+          albSn3 =  max(albSn3,zero)
+          albSn3 =  min(albSn3*albCor,unun)
+ 
+          !snow albedo corection if wetsnow
+c #GL     albSn1 =  albSn1*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
+c #GL     albSn2 =  albSn2*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
+c #GL     albSn3 =  albSn3*max(0.9,(1.-1.5*eta_SV(ikl,isn)))
+ 
+          albSno =  So1dSV*albSn1
+     .           +  So2dSV*albSn2
+     .           +  So3dSV*albSn3
+ 
+cXF
+          minalb =  (aI2dSV + (aI3dSV -aI2dSV)
+     .           *  (ro__SV(ikl,isn)-ro_Ice)/(roSdSV-ro_Ice))
+          minalb =  min(aI3dSV,max(aI2dSV,minalb)) ! pure/firn albedo
+ 
+          SnowOK =  SnowOK*max(zero,sign(unun,     albSno-minalb))
+          albSn1 =  SnowOK*albSn1+(1.0-SnowOK)*max(albSno,minalb)
+          albSn2 =  SnowOK*albSn2+(1.0-SnowOK)*max(albSno,minalb)
+          albSn3 =  SnowOK*albSn3+(1.0-SnowOK)*max(albSno,minalb)
+ 
+c +           ro < roSdSV |          min al > aI3dSV
+c +  roSdSV < ro < rocdSV | aI2dSV < min al < aI3dSV (fct of density)
+ 
+ 
+C +--Snow/Ice Pack Thickness
+C +  -----------------------
+ 
+          isn    =    max(min(isnoSV(ikl) ,ispiSV(ikl)),0)
+          Snow_H =  zzsnsv(ikl,isnoSV(ikl))-zzsnsv(ikl,isn)
+          SIce_H =  zzsnsv(ikl,isnoSV(ikl))
+          SnownH =  Snow_H  /  HSnoSV
+          SnownH =  min(unun,  SnownH)
+          SIcenH =  SIce_H  / (HIceSV)
+          SIcenH =  min(unun,  SIcenH)
+ 
+C +       The value of SnownH is set to 1 in case of ice lenses above
+C +       1m of dry snow (ro<600kg/m3) for using CROCUS albedo
+ 
+c         ro_ave =  0.
+c         dz_ave =  0.
+c         SnowOK =  1.
+c      do isn    =  isnoSV(ikl),1,-1
+c         ro_ave =  ro_ave + ro__SV(ikl,isn) * dzsnSV(ikl,isn) * SnowOK
+c         dz_ave =  dz_ave +                   dzsnSV(ikl,isn) * SnowOK
+c         SnowOK =  max(zero,sign(unun,1.-dz_ave))
+c      enddo
+ 
+c         ro_ave =  ro_ave / max(dz_ave,epsi)
+c         SnowOK =  max(zero,sign(unun,600.-ro_ave))
+c         SnownH =  SnowOK + SnownH * (1. - SnowOK)
+ 
+C +--Integrated Snow/Ice Albedo: Case of Water on Bare Ice
+C +  -----------------------------------------------------
+ 
+          isn    =  max(min(isnoSV(ikl) ,ispiSV(ikl)),0)
+ 
+          albWIc =  aI1dSV-(aI1dSV-aI2dSV)
+     .           *  exp(-(rusnSV(ikl)                      !
+     .           *  (1. -SWS_SV(ikl)                       ! 0 <=> freezing
+     .           *  (1  -min(1,iabs(isn-isnoSV(ikl)))))    ! 1 <=> isn=isnoSV
+     .           /   ru_dSV)**0.50)                        !
+c         albWIc = max(aI1dSV,min(aI2dSV,albWIc+slopSV(ikl)*
+c    .             min(5.,max(1.,dx/10000.))))
+ 
+          SignRo = sign(unun,ro_Ice-5.-ro__SV(ikl,isn))    ! RoSN<920kg/m3
+          SnowOK =  max(zero,SignRo)
+ 
+          albWIc = (1. - SnowOK) * albWIc + SnowOK
+     .           * (aI2dSV + (aI3dSV -aI2dSV)
+     .           * (ro__SV(ikl,isn)-ro_Ice)/(roSdSV-ro_Ice))
+ 
+c +  rocdSV < ro < ro_ice | aI2dSV< al <aI3dSV (fct of density)
+c +           ro > ro_ice | aI1dSV< al <aI2dSV (fct of superficial water content
+ 
+ 
+C +--Integrated Snow/Ice      Albedo
+C +  -------------------------------
+ 
+          a_SII1      =     albWIc      +(albSn1-albWIc)     *SnownH
+          a_SII1      = min(a_SII1       ,albSn1)
+ 
+          a_SII2      =     albWIc      +(albSn2-albWIc)     *SnownH
+          a_SII2      = min(a_SII2       ,albSn2)
+ 
+          a_SII3      =     albWIc      +(albSn3-albWIc)     *SnownH
+          a_SII3      = min(a_SII3       ,albSn3)
+ 
+cc #AG     agesno =      min(agsnSV(ikl,isn)          ,AgeMax)
+cc #AG     a_SII1      =     a_SII1      -0.175*agesno/AgeMax
+C +...                                   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)
+!                            (Vignon, PhD Thesis, pp 150, conditions at Dome C)
+!                            -------------------------------------------------
+ 
+         
+          dalbed = 0.0
+
+          if (iflag_albzenith .GE. 0) then
+          csegal = max(czemax                   ,coszSV(ikl))
+c #cz     dalbeS =   ((bsegal+unun)/(unun+2.0*bsegal*csegal)
+c #cz.                -       unun                          )*0.32
+c #cz.              /  bsegal
+c #cz     dalbeS = max(dalbeS,zero)
+c #cz     dalbed =     dalbeS      *       min(1,isnoSV(ikl))
+ 
+          dalbeW =(0.64 - csegal  )*0.0625  ! Warren 1982, RevGeo, fig.12b
+                                            ! 0.0625 = 5% * 1/0.8,   p.81
+                                            ! 0.64   = cos(50)
+          dalbed =     dalbeW      *       min(1,isnoSV(ikl))
+
+
+! Vignon PhD thesis, Dome C conditions
+
+            if (iflag_albzenith .EQ. 1) then
+            thetazs0=-bbp/(2.0*aap)
+            alb0=(bbp**2)/4./aap-(bbp**2)/2./aap+ccp
+            thetazs=max(acos(coszSV(ikl))/pi*180.0,thetazs0) ! in degrees
+
+
+            dalbeW = aap*(thetazs**2)+bbp*thetazs+ccp-alb0       
+            dalbed =     dalbeW      *       min(1,isnoSV(ikl))
+            end if
+
+
+            end if
+ 
+C +--Elsewhere    Integrated Snow/Ice Albedo
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c #cp     ELSE
+            albSII =     So1dSV*a_SII1
+     .                 + So2dSV*a_SII2
+     .                 + So3dSV*a_SII3
+c #cp     END IF
+ 
+ 
+C +--Integrated Snow/Ice/Soil Albedo
+C +  -------------------------------
+ 
+            alb1sv(ikl) =     albssv(ikl) +(a_SII1-albssv(ikl))*SIcenH
+            alb1sv(ikl) = min(alb1sv(ikl)  ,a_SII1)
+ 
+            alb2sv(ikl) =     albssv(ikl) +(a_SII2-albssv(ikl))*SIcenH
+            alb2sv(ikl) = min(alb2sv(ikl)  ,a_SII2)
+ 
+            alb3sv(ikl) =     albssv(ikl) +(a_SII3-albssv(ikl))*SIcenH
+            alb3sv(ikl) = min(alb3sv(ikl)  ,a_SII3)
+ 
+            albisv(ikl) =     albssv(ikl) +(albSII-albssv(ikl))*SIcenH
+            albisv(ikl) = min(albisv(ikl)  ,albSII)
+ 
+ 
+C +--Integrated Snow/Ice/Soil Albedo: Clouds Correction! Greuell & all., 1994
+C +  --------------------------------------------------! Glob.&t Planet.Change
+                                                       ! (9):91-114
+            alb1sv(ikl) = alb1sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+     .                  + dalbed      *    (1.-cld_SV(ikl))
+            alb2sv(ikl) = alb2sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+     .                  + dalbed      *    (1.-cld_SV(ikl))
+            alb3sv(ikl) = alb3sv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+     .                  + dalbed      *    (1.-cld_SV(ikl))
+            albisv(ikl) = albisv(ikl) + 0.05 *(cld_SV(ikl)-0.5)*SIcenH
+     .                  + dalbed      *    (1.-cld_SV(ikl))
+ 
+C +--Integrated Snow/Ice/Soil Albedo: Minimum snow albedo = aI1dSV
+C +  -------------------------------------------------------------
+ 
+            albedo_old  = albisv(ikl)
+            albisv(ikl) = max(albisv(ikl),aI1dSV   * SIcenH
+     .                  + albssv(ikl) *(1.0        - SIcenH))
+            alb1sv(ikl) = alb1sv(ikl) - 1.0/3.0             ! 33 %
+     .                  * (albedo_old-albisv(ikl)) / So1dSV
+            alb2sv(ikl) = alb2sv(ikl) - 1.0/3.0             ! 33 %
+     .                  * (albedo_old-albisv(ikl)) / So2dSV
+            alb3sv(ikl) = alb3sv(ikl) - 1.0/3.0             ! 33 %
+     .                  * (albedo_old-albisv(ikl)) / So3dSV
+ 
+ 
+C +--Integrated Snow/Ice/Soil Albedo: Maximum albedo = 95%
+C +  -----------------------------------------------------
+ 
+            albedo_old  = albisv(ikl)
+            albisv(ikl) = min(albisv(ikl),0.95)
+            alb1sv(ikl) = alb1sv(ikl) - 1.0/3.0             ! 33 %
+     .                  * (albedo_old-albisv(ikl)) / So1dSV
+            alb2sv(ikl) = alb2sv(ikl) - 1.0/3.0             ! 33 %
+     .                  * (albedo_old-albisv(ikl)) / So2dSV
+            alb3sv(ikl) = alb3sv(ikl) - 1.0/3.0             ! 33 %
+     .                  * (albedo_old-albisv(ikl)) / So3dSV
+
+
+	!Sea Ice/snow permanent-interractive prescription from Nemo 
+	!AO_CK 20/02/2020
+
+        ! No check if coupling update since MAR and NEMO albedo are too different
+	! and since MAR albedo is computed on properties that are not in NEMO
+        ! prescription for each time step with NEMO values 
+	
+c #AO      if (LSmask(ikl) .eq. 0 .and. coupling_ao .eq. .true.) then 
+c #AO       if (AOmask(ikl) .eq. 0) then  
+c #AO       albisv(ikl) =  (1.-AOmask(ikl))* albAOsisv(ikl)
+c #AO.                    +(AOmask(ikl)*albisv(ikl))
+c #AO       alb1sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
+c #AO.                    +(AOmask(ikl)*alb1sv(ikl))
+c #AO       alb2sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
+c #AO.                    +(AOmask(ikl)*alb2sv(ikl))
+c #AO       alb3sv(ikl) =   (1.-AOmask(ikl))* albAOsisv(ikl)
+c #AO.                    +(AOmask(ikl)*alb3sv(ikl))
+c #AO       endif
+c #AO      endif
+
+ 
+            alb1sv(ikl) = min(max(zero,alb1sv(ikl)),albmax)
+            alb2sv(ikl) = min(max(zero,alb2sv(ikl)),albmax)
+            alb3sv(ikl) = min(max(zero,alb3sv(ikl)),albmax)
+ 
+        END DO
+ 
+ 
+C +--Extinction Coefficient: Exponential Factor
+C +  ==========================================
+ 
+        DO ikl=1,knonv
+          sExt_1(ikl)        = 1.
+          sExt_2(ikl)        = 1.
+          sExt_3(ikl)        = 1.
+          sEX_sv(ikl,nsno+1) = 1.
+ 
+          coalb1(ikl) = (1.          -alb1sv(ikl))*So1dSV
+          coalb2(ikl) = (1.          -alb2sv(ikl))*So2dSV
+          coalb3(ikl) = (1.          -alb3sv(ikl))*So3dSV
+          coalbm      =  coalb1(ikl) +coalb2(ikl) +coalb3(ikl)
+          coalb1(ikl) =  coalb1(ikl)              /coalbm
+          coalb2(ikl) =  coalb2(ikl)              /coalbm
+          coalb3(ikl) =  coalb3(ikl)              /coalbm
+        END DO
+ 
+cXF
+ 
+        DO   isn=nsno,1,-1
+          DO ikl=1,knonv
+            sEX_sv(ikl,isn) = 1.0
+           !sEX_sv(ikl,isn) = 0.95 ! if MAR is too warm in summer
+          END DO
+        END DO
+ 
+        DO ikl=1,knonv
+         DO isn=max(1,isnoSV(ikl)),1,-1
+ 
+          SignRo = sign(unun, rocdSV - ro__SV(ikl,isn))
+          SnowOK =  max(zero,SignRo) ! Ice Density Threshold
+ 
+          RoFrez =  1.e-3      * ro__SV(ikl,isn) * (1.0-eta_SV(ikl,isn))
+ 
+          OpSqrt = sqrt(max(epsi,SnOpSV(ikl,isn)))
+          exarg1 =      SnowOK  *1.e2 *max(sbeta1*RoFrez/OpSqrt,sbeta2)
+     .            +(1.0-SnowOK)           *sbeta5
+          exarg2 =      SnowOK  *1.e2 *max(sbeta3*RoFrez/OpSqrt,sbeta4)
+     .            +(1.0-SnowOK)           *sbeta5
+          exarg3 =      SnowOK  *1.e2     *sbeta5
+     .            +(1.0-SnowOK)           *sbeta5
+ 
+ 
+C +--Integrated Extinction of Solar Irradiance (Normalized Value)
+C +  ============================================================
+ 
+          sExt_1(ikl) = sExt_1(ikl)
+     .                          * exp(min(0.0,-exarg1 *dzsnSV(ikl,isn)))
+          sign_0      =              sign(unun,eps9   -sExt_1(ikl))
+          sExt_0      =               max(zero,sign_0)*sExt_1(ikl)
+          sExt_1(ikl) = sExt_1(ikl)                   -sExt_0
+ 
+          sExt_2(ikl) = sExt_2(ikl)
+     .                          * exp(min(0.0,-exarg2 *dzsnSV(ikl,isn)))
+          sign_0      =              sign(unun,eps9   -sExt_2(ikl))
+          sExt_0      =               max(zero,sign_0)*sExt_2(ikl)
+          sExt_2(ikl) = sExt_2(ikl)                   -sExt_0
+ 
+          sExt_3(ikl) = sExt_3(ikl)
+     .                          * exp(min(0.0,-exarg3 *dzsnSV(ikl,isn)))
+          sign_0      =              sign(unun,eps9   -sExt_3(ikl))
+          sExt_0      =               max(zero,sign_0)*sExt_3(ikl)
+          sExt_3(ikl) = sExt_3(ikl)                   -sExt_0
+ 
+          sEX_sv(ikl,isn) = coalb1(ikl) * sExt_1(ikl)
+     .                    + coalb2(ikl) * sExt_2(ikl)
+     .                    + coalb3(ikl) * sExt_3(ikl)
+        END DO
+      END DO
+ 
+      DO   isn=0,-nsol,-1
+        DO ikl=1,knonv
+          sEX_sv(ikl,isn) = 0.0
+        END DO
+      END DO
+ 
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_ts2.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_ts2.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_ts2.F	(revision 3851)
@@ -0,0 +1,477 @@
+      subroutine SISVAT_TS2                                                     
+c #ES.                     (ETSo_0,ETSo_1,ETSo_d)                               
+                                                                                
+C +------------------------------------------------------------------------+    
+C | MAR          SISVAT_TS2                            Mon 16-08-2009  MAR |    
+C |   SubRoutine SISVAT_TS2 computes the Soil/Snow temperature and fluxes  |
+C |   using the same method as in LMDZ for consistency.                    |
+C |   The corresponding LMDZ routines are soil (soil.F90) and calcul_fluxs |
+C |   (calcul_fluxs_mod.F90).                                              |   
+C +------------------------------------------------------------------------+    
+C |                                                                        |    
+C |                                                                        |    
+C |   PARAMETERS:  klonv: Total Number of columns =                        |    
+C |   ^^^^^^^^^^        = Total Number of grid boxes of surface type       |    
+C |                       (land ice for now)                               |    
+C |                                                                        |    
+C |   INPUT:   isnoSV   = total Nb of Ice/Snow Layers                      |    
+C |   ^^^^^    sol_SV   : Downward Solar Radiation                  [W/m2] |    
+C |            IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |       
+C |            VV__SV   : SBL Top    Wind Speed                      [m/s] |    
+C |            TaT_SV   : SBL Top    Temperature                       [K] |     
+C |            QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |      
+C |            dzsnSV   : Snow Layer Thickness                         [m] |        
+C |            dt__SV   : Time Step                                    [s] |    
+C |                                                                        |    
+C |            SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |    
+C |            Eso_sv   : Soil+Snow       Emissivity                   [-] |    
+C |   ?        rah_sv   : Aerodynamic Resistance for Heat            [s/m] |    
+C |                                                                        | 
+C |            dz1_SV    : "inverse" layer thickness (centered)      [1/m] |
+C |            dz2_SV    : layer thickness (layer above (?))           [m] |
+C |            AcoHSV    : coefficient for Enthalpy evolution, from atm.   |
+C |            AcoHSV    : coefficient for Enthalpy evolution, from atm.   |
+C |            AcoQSV    : coefficient for Humidity evolution, from atm.   | 
+C |            BcoQSV    : coefficient for Humidity evolution, from atm.   |
+C |            ps__SV    : surface pressure                           [Pa] |
+C |            p1l_SV    : 1st atmospheric layer pressure             [Pa] |     
+C |            cdH_SV    : drag coeff Energy (?)                           |
+C |            rsolSV    : Radiation balance surface                [W/m2] |
+C |            lambSV    : Coefficient for soil layer geometry         [-] |
+C |                                                                        |    
+C |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|    
+C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |    
+C |   ^^^^^^   rsolSV   : Radiation balance surface                 [W/m2] |     
+C |                                                                        |    
+C |   OUTPUT:  IRs_SV   : Soil      IR Radiation                    [W/m2] |    
+C |   ^^^^^^   HSs_sv   : Sensible  Heat Flux                       [W/m2] |    
+C |            HLs_sv   : Latent    Heat Flux                       [W/m2] |  
+C |            TsfnSV   : new surface temperature                      [K] |
+C |            Evp_sv   : Evaporation                              [kg/m2] |
+C |            dSdTSV   : Sensible Heat Flux temp. derivative     [W/m2/K] |
+C |            dLdTSV   : Latent Heat Flux temp. derivative       [W/m2/K] |
+C |                                                                        | 
+C |   ?        ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |    
+C |   ?        ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |    
+C |   ?        ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |    
+C |                                                                        | 
+C |________________________________________________________________________|
+
+      USE VAR_SV
+      USE VARdSV
+ 
+      USE VARySV                      
+      USE VARtSV                      
+      USE VARxSV 
+      USE VARphy
+      USE indice_sol_mod
+
+
+      IMPLICIT NONE                                                                    
+                                                                                
+                                                                                
+C +--Global Variables                                                           
+C +  ================                                                          
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+!      INCLUDE "indicesol.h"
+      INCLUDE "comsoil.h"
+!      include  "LMDZphy.inc"   
+                                                                        
+C +--OUTPUT for Stand Alone NetCDF File                                         
+C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                                         
+c #NC      real*8        SOsoKL(klonv)             ! Absorbed Solar Radiation        
+c #NC      real*8        IRsoKL(klonv)             ! Absorbed IR    Radiation        
+c #NC      real*8        HSsoKL(klonv)             ! Absorbed Sensible Heat Flux     
+c #NC      real*8        HLsoKL(klonv)             ! Absorbed Latent   Heat Flux     
+c #NC      real*8        HLs_KL(klonv)             ! Evaporation                     
+c #NC      real*8        HLv_KL(klonv)             ! Transpiration                   
+c #NC      common/DumpNC/SOsoKL,IRsoKL                                               
+c #NC     .             ,HSsoKL,HLsoKL                                               
+c #NC     .             ,HLs_KL,HLv_KL          
+
+C +--Internal Variables                                                         
+C +  ==================    
+
+      integer ig,jk,isl
+      real mu     
+      real Tsrf(klonv)               ! surface temperature as extrapolated from soil
+      real mug(klonv)                 !hj coef top layers 
+      real ztherm_i(klonv),zdz2(klonv,-nsol:nsno),z1s
+      real pfluxgrd(klonv), pcapcal(klonv), cal(klonv)
+      real beta(klonv), dif_grnd(klonv)
+      real C_coef(klonv,-nsol:nsno),D_coef(klonv,-nsol:nsno)
+
+      REAL, DIMENSION(klonv)   :: zx_mh, zx_nh, zx_oh
+      REAL, DIMENSION(klonv)   :: zx_mq, zx_nq, zx_oq
+      REAL, DIMENSION(klonv)   :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef
+      REAL, DIMENSION(klonv)   :: zx_sl, zx_k1
+      REAL, DIMENSION(klonv)   :: d_ts
+      REAL                     :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh
+      REAL                     :: qsat_new, q1_new
+C      REAL, PARAMETER          :: t_grnd = 271.35, t_coup = 273.15
+C      REAL, PARAMETER          :: max_eau_sol = 150.0
+      REAL, DIMENSION(klonv)   :: IRs__D, dIRsdT
+
+
+      REAL t_grnd                      ! not used
+      parameter(t_grnd = 271.35)       !
+      REAL t_coup                      ! distinguish evap/sublimation
+      parameter(t_coup = 273.15)       !
+      REAL max_eau_sol
+      parameter(max_eau_sol = 150.0)
+
+
+!        write(*,*)'T check'
+!     
+!        DO  ig = 1,knonv  
+!            DO  jk = 1,isnoSV(ig) !nsno       
+!              IF (TsisSV(ig,jk) <= 1.) THEN          !hj check
+!                TsisSV(ig,jk) = TsisSV(ig,isnoSV(ig))
+!              ENDIF  
+!
+!              IF (TsisSV(ig,jk) <= 1.) THEN          !hj check
+!                TsisSV(ig,jk) = 273.15
+!              ENDIF   
+!            END DO
+!        END DO     
+
+C!=======================================================================
+C! I. First part: corresponds to soil.F90 in LMDZ
+C!=======================================================================
+
+      DO ig = 1,knonv      
+        DO jk =1,isnoSV(ig)
+          dz2_SV(ig,jk)=dzsnSV(ig,jk)
+C! use arithmetic center between layers to derive dz1 for snow layers for simplicity: 
+          dz1_SV(ig,jk)=2./(dzsnSV(ig,jk)+dzsnSV(ig,jk-1)) 
+        ENDDO
+      ENDDO
+
+      DO ig = 1,knonv
+        ztherm_i(ig)   = inertie_lic
+        IF (isnoSV(ig) > 0) ztherm_i(ig)   = inertie_sno
+      ENDDO
+
+C!-----------------------------------------------------------------------
+C! 1)
+C! Calculation of Cgrf and Dgrd coefficients using soil temperature from 
+C! previous time step.
+C!
+C! These variables are recalculated on the local compressed grid instead 
+C! of saved in restart file.
+C!-----------------------------------------------------------------------
+      DO ig=1,knonv
+        DO jk=-nsol,nsno
+          zdz2(ig,jk)=dz2_SV(ig,jk)/dt__SV                                !ptimestep
+        ENDDO
+      ENDDO
+ 
+      DO ig=1,knonv
+        z1s = zdz2(ig,-nsol)+dz1_SV(ig,-nsol+1)
+        C_coef(ig,-nsol+1)=zdz2(ig,-nsol)*TsisSV(ig,-nsol)/z1s
+        D_coef(ig,-nsol+1)=dz1_SV(ig,-nsol+1)/z1s
+      ENDDO
+
+      DO ig=1,knonv
+        DO jk=-nsol+1,isnoSV(ig)-1,1
+          z1s = 1./(zdz2(ig,jk)+dz1_SV(ig,jk+1)+dz1_SV(ig,jk)           &
+     &          *(1.-D_coef(ig,jk)))
+          C_coef(ig,jk+1)=                                              &
+     &          (TsisSV(ig,jk)*zdz2(ig,jk)                              &
+     &          +dz1_SV(ig,jk)*C_coef(ig,jk)) * z1s
+          D_coef(ig,jk+1)=dz1_SV(ig,jk+1)*z1s
+        ENDDO
+      ENDDO
+
+C!-----------------------------------------------------------------------
+C! 2)
+C! Computation of the soil temperatures using the Cgrd and Dgrd
+C! coefficient computed above
+C!
+C!-----------------------------------------------------------------------
+C! Extrapolate surface Temperature                   !hj check
+      mu=1./((2.**1.5-1.)/(2.**(0.5)-1.)-1.)
+
+!     IF (knonv>0) THEN 
+!      DO ig=1,8 
+!        write(*,*)ig,'sisvat: Tsis ',TsisSV(ig,isnoSV(ig))
+!        write(*,*)'max-1            ',TsisSV(ig,isnoSV(ig)-1)
+!        write(*,*)'max-2            ',TsisSV(ig,isnoSV(ig)-2)
+!        write(*,*)'0                ',TsisSV(ig,0)
+!!        write(*,*)min(max(isnoSV(ig),0),1),max(1-isnoSV(ig),0)
+!      ENDDO
+!     END IF
+
+      DO ig=1,knonv    
+        IF (isnoSV(ig).GT.0) THEN
+          IF (isnoSV(ig).GT.1) THEN
+           mug(ig)=1./(1.+dzsnSV(ig,isnoSV(ig)-1)/dzsnSV(ig,isnoSV(ig))) !mu
+          ELSE
+           mug(ig) = 1./(1.+dzsnSV(ig,isnoSV(ig)-1)/dz_dSV(0)) !mu
+          ENDIF
+        ELSE
+          mug(ig) = lambSV
+        ENDIF
+
+        IF (mug(ig)  .LE. 0.05) THEN
+         write(*,*)'Attention mu low', mug(ig)
+        ENDIF
+        IF (mug(ig)  .GE. 0.98) THEN
+         write(*,*)'Attention mu high', mug(ig)
+        ENDIF
+
+        Tsrf(ig)=(1.5*TsisSV(ig,isnoSV(ig))-0.5*TsisSV(ig,isnoSV(ig)-1))&
+     &           *min(max(isnoSV(ig),0),1)+                             &
+     &           ((mug(ig)+1)*TsisSV(ig,0)-mug(ig)*TsisSV(ig,-1))       &
+     &           *max(1-isnoSV(ig),0)  
+      ENDDO
+
+  
+
+C! Surface temperature
+      DO ig=1,knonv
+      TsisSV(ig,isnoSV(ig))=(mug(ig)*C_coef(ig,isnoSV(ig))+Tsf_SV(ig))/ &
+     &        (mug(ig)*(1.-D_coef(ig,isnoSV(ig)))+1.)
+      ENDDO
+  
+C! Other temperatures
+      DO ig=1,knonv
+        DO jk=isnoSV(ig),-nsol+1,-1
+          TsisSV(ig,jk-1)=C_coef(ig,jk)+D_coef(ig,jk)                   &
+     &          *TsisSV(ig,jk)
+        ENDDO
+      ENDDO
+C      write(*,*)ig,'Tsis',TsisSV(ig,0)
+
+C      IF (indice == is_sic) THEN
+C        DO ig = 1,knonv
+C          TsisSV(ig,-nsol) = RTT - 1.8
+C        END DO
+C      ENDIF
+
+CC      !hj new 11 03 2010
+        DO ig=1,knonv                                                          
+          isl         = isnoSV(ig)                                             
+C          dIRsdT(ig) = Eso_sv(ig)* SteBo   * 4.                        & ! - d(IR)/d(T)   
+C     &                             * Tsf_SV(ig)                         & !T TsisSV(ig,isl)           !                
+C     &                             * Tsf_SV(ig)                         & !TsisSV(ig,isl)           !                
+C     &                             * Tsf_SV(ig) !TsisSV(ig,isl)           !                
+C          IRs__D(ig) = dIRsdT(ig)* Tsf_SV(ig) * 0.75 !TsisSV(ig,isl) * 0.75    !: 
+          dIRsdT(ig) = Eso_sv(ig)* StefBo   * 4.                        & ! - d(IR)/d(T)   
+     &                             * TsisSV(ig,isl)                     & !
+     &                             * TsisSV(ig,isl)                     & !
+     &                             * TsisSV(ig,isl)                     & !
+          IRs__D(ig) = dIRsdT(ig)* TsisSV(ig,isl) * 0.75                  !: 
+         END DO
+       !hj
+C!-----------------------------------------------------------------------
+C! 3)
+C! Calculate the Cgrd and Dgrd coefficient corresponding to actual soil 
+C! temperature
+C!-----------------------------------------------------------------------
+      DO ig=1,knonv
+        z1s = zdz2(ig,-nsol)+dz1_SV(ig,-nsol+1)
+        C_coef(ig,-nsol+1) = zdz2(ig,-nsol)*TsisSV(ig,-nsol)/z1s
+        D_coef(ig,-nsol+1) = dz1_SV(ig,-nsol+1)/z1s
+      ENDDO
+
+      DO ig=1,knonv  
+        DO jk=-nsol+1,isnoSV(ig)-1,1
+          z1s = 1./(zdz2(ig,jk)+dz1_SV(ig,jk+1)+dz1_SV(ig,jk)           &
+     &          *(1.-D_coef(ig,jk)))
+          C_coef(ig,jk+1) = (TsisSV(ig,jk)*zdz2(ig,jk)+                 &
+     &          dz1_SV(ig,jk)*C_coef(ig,jk)) * z1s
+          D_coef(ig,jk+1) = dz1_SV(ig,jk+1)*z1s
+        ENDDO
+      ENDDO
+
+C!-----------------------------------------------------------------------
+C! 4)
+C! Computation of the surface diffusive flux from ground and
+C! calorific capacity of the ground
+C!-----------------------------------------------------------------------
+      DO ig=1,knonv
+C! (pfluxgrd)
+        pfluxgrd(ig) = ztherm_i(ig)*dz1_SV(ig,isnoSV(ig))*              &
+     &      (C_coef(ig,isnoSV(ig))+(D_coef(ig,isnoSV(ig))-1.)           &
+     &      *TsisSV(ig,isnoSV(ig)))
+C! (pcapcal)
+        pcapcal(ig)  = ztherm_i(ig)*                                    &
+     &      (dz2_SV(ig,isnoSV(ig))+dt__SV*(1.-D_coef(ig,isnoSV(ig)))    &
+     &      *dz1_SV(ig,isnoSV(ig)))
+        z1s = mug(ig)*(1.-D_coef(ig,isnoSV(ig)))+1.
+        pcapcal(ig)  = pcapcal(ig)/z1s
+        pfluxgrd(ig) = ( pfluxgrd(ig)                                   &
+     &       + pcapcal(ig) * (TsisSV(ig,isnoSV(ig)) * z1s               &
+     &       - mug(ig)* C_coef(ig,isnoSV(ig))                           &
+     &       - Tsf_SV(ig))       /dt__SV )
+      ENDDO
+        
+      
+      cal(1:knonv) = RCPD / pcapcal(1:knonv)
+      rsolSV(1:knonv)  = rsolSV(1:knonv) + pfluxgrd(1:knonv)
+C!=======================================================================
+C! II. Second part: corresponds to calcul_fluxs_mod.F90 in LMDZ
+C!=======================================================================
+
+      Evp_sv = 0.
+c #NC HSsoKL=0.
+c #NC HLsoKL=0.
+      dSdTSV = 0.
+      dLdTSV = 0.
+	
+      beta(:) = 1.0
+      dif_grnd(:) = 0.0
+
+C! zx_qs = qsat en kg/kg
+C!**********************************************************************x***************
+
+      DO ig = 1,knonv
+        IF (ps__SV(ig).LT.1.) THEN
+!          write(*,*)'ig',ig,'ps',ps__SV(ig)
+          ps__SV(ig)=max(ps__SV(ig),1.e-8)
+        ENDIF
+        IF (p1l_SV(ig).LT.1.) THEN
+!          write(*,*)'ig',ig,'p1l',p1l_SV(ig)
+          p1l_SV(ig)=max(p1l_SV(ig),1.e-8)
+        ENDIF
+        IF (TaT_SV(ig).LT.180.) THEN
+!          write(*,*)'ig',ig,'TaT',TaT_SV(ig)
+          TaT_SV(ig)=max(TaT_SV(ig),180.)
+        ENDIF
+        IF (QaT_SV(ig).LT.1.e-8) THEN
+!          write(*,*)'ig',ig,'QaT',QaT_SV(ig)
+          QaT_SV(ig)=max(QaT_SV(ig),1.e-8)
+        ENDIF
+        IF (Tsf_SV(ig).LT.100.) THEN
+!          write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
+          Tsf_SV(ig)=max(Tsf_SV(ig),180.)
+        ENDIF
+        IF (Tsf_SV(ig).GT.500.) THEN
+!          write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
+          Tsf_SV(ig)=min(Tsf_SV(ig),400.)
+        ENDIF
+!         IF (Tsrf(ig).LT.1.) THEN
+!!          write(*,*)'ig',ig,'Tsrf',Tsrf(ig)  
+!           Tsrf(ig)=max(Tsrf(ig),TaT_SV(ig)-20.)
+!         ENDIF
+         IF (cdH_SV(ig).LT.1.e-10) THEN
+!           IF (ig.le.3)   write(*,*)'ig',ig,'cdH',cdH_SV(ig)
+           cdH_SV(ig)=.5
+         ENDIF
+      ENDDO  
+
+
+      DO ig = 1,knonv
+        zx_pkh(ig) = 1. ! (ps__SV(ig)/ps__SV(ig))**RKAPPA
+        IF (thermcep) THEN
+          zdelta=MAX(0.,SIGN(1.,rtt-Tsf_SV(ig)))
+          zcvm5 = R5LES*LhvH2O*(1.-zdelta) + R5IES*LhsH2O*zdelta
+          zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*QaT_SV(ig))
+          zx_qs= r2es * FOEEW(Tsf_SV(ig),zdelta)/ps__SV(ig)
+          zx_qs=MIN(0.5,zx_qs)
+          !write(*,*)'zcor',retv*zx_qs
+          zcor=1./(1.-retv*zx_qs)
+          zx_qs=zx_qs*zcor
+          zx_dq_s_dh = FOEDE(Tsf_SV(ig),zdelta,zcvm5,zx_qs,zcor)        &
+     &          /LhvH2O / zx_pkh(ig)
+        ELSE
+          IF (Tsf_SV(ig).LT.t_coup) THEN
+             zx_qs = qsats(Tsf_SV(ig)) / ps__SV(ig)
+             zx_dq_s_dh = dqsats(Tsf_SV(ig),zx_qs)/LhvH2O               &
+     &             / zx_pkh(ig)
+          ELSE
+             zx_qs = qsatl(Tsf_SV(ig)) / ps__SV(ig)
+             zx_dq_s_dh = dqsatl(Tsf_SV(ig),zx_qs)/LhvH2O               &
+     &             / zx_pkh(ig)
+          ENDIF
+        ENDIF
+        zx_dq_s_dt(ig) = RCPD * zx_pkh(ig) * zx_dq_s_dh
+        zx_qsat(ig) = zx_qs
+C        zx_coef(ig) = cdH_SV(ig) *                                     &
+C     &       (1.0+SQRT(u1lay(ig)**2+v1lay(ig)**2)) *                   &
+C     &       p1l_SV(ig)/(RD*t1lay(ig))
+        zx_coef(ig) = cdH_SV(ig) *                                      &
+     &       (1.0+VV__SV(ig)) *                                         &
+     &       p1l_SV(ig)/(RD*TaT_SV(ig))
+       
+      ENDDO
+
+
+C! === Calcul de la temperature de surface ===
+C! zx_sl = chaleur latente d'evaporation ou de sublimation
+C!****************************************************************************************
+
+      DO ig = 1,knonv
+        zx_sl(ig) = LhvH2O
+        IF (Tsf_SV(ig) .LT. RTT) zx_sl(ig) = LhsH2O
+        zx_k1(ig) = zx_coef(ig)
+      ENDDO
+    
+
+      DO ig = 1,knonv
+C! Q
+        zx_oq(ig) = 1. - (beta(ig) * zx_k1(ig) * BcoQSV(ig) * dt__SV)
+        zx_mq(ig) = beta(ig) * zx_k1(ig) *                              &
+     &       (AcoQSV(ig) - zx_qsat(ig) +                                &
+     &       zx_dq_s_dt(ig) * Tsf_SV(ig))                               &
+     &       / zx_oq(ig)
+        zx_nq(ig) = beta(ig) * zx_k1(ig) * (-1. * zx_dq_s_dt(ig))       &
+     &       / zx_oq(ig)
+       
+C! H
+        zx_oh(ig) = 1. - (zx_k1(ig) * BcoHSV(ig) * dt__SV)
+        zx_mh(ig) = zx_k1(ig) * AcoHSV(ig) / zx_oh(ig)
+        zx_nh(ig) = - (zx_k1(ig) * RCPD * zx_pkh(ig))/ zx_oh(ig)
+     
+C! surface temperature
+        TsfnSV(ig) = (Tsf_SV(ig) + cal(ig)/RCPD * zx_pkh(ig) * dt__SV * &
+     &       (rsolSV(ig) + zx_mh(ig) + zx_sl(ig) * zx_mq(ig))           & 
+     &       + dif_grnd(ig) * t_grnd * dt__SV)/                         &
+     &       ( 1. - dt__SV * cal(ig)/(RCPD * zx_pkh(ig)) *              &
+     &       (zx_nh(ig) + zx_sl(ig) * zx_nq(ig))                        &  
+     &       + dt__SV * dif_grnd(ig))
+
+!hj rajoute 22 11 2010 tuning...
+        TsfnSV(ig) = min(RTT+0.02,TsfnSV(ig))
+       
+        d_ts(ig) = TsfnSV(ig) - Tsf_SV(ig)
+
+
+C!== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
+C!== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
+        Evp_sv(ig) = - zx_mq(ig) - zx_nq(ig) * TsfnSV(ig) 
+        HLs_sv(ig) = - Evp_sv(ig) * zx_sl(ig)
+        HSs_sv(ig) = zx_mh(ig) + zx_nh(ig) * TsfnSV(ig)
+       
+C! Derives des flux dF/dTs (W m-2 K-1):
+        dSdTSV(ig) = zx_nh(ig)
+        dLdTSV(ig) = zx_sl(ig) * zx_nq(ig)
+
+
+!hj  new 11 03 2010                                      
+        isl         = isnoSV(ig)
+!        TsisSV(ig,isl) = TsfnSV(ig)                                         
+        IRs_SV(ig) = IRs__D(ig)                                         &!     
+     &                - dIRsdT(ig) * TsfnSV(ig) !TsisSV(ig,isl)?      !  
+
+! hj
+c #NC   SOsoKL(ig) = sol_SV(ig) * SoSosv(ig)              ! Absorbed Sol.    
+c #NC   IRsoKL(ig) =               IRs_SV(ig)                           & !Up Surf. IR
+c #NC&        +     tau_sv(ig)      *IRd_SV(ig)*Eso_sv(ig)              & !Down Atm IR
+c #NC&        -(1.0-tau_sv(ig)) *0.5*IRv_sv(ig)            ! Down Veg IR  
+c #NC   HLsoKL(ig) = HLs_sv(ig) 
+c #NC   HSsoKL(ig) = HSs_sv(ig) 
+c #NC   HLs_KL(ig) = Evp_sv(ig)
+
+C! Nouvelle valeure de l'humidite au dessus du sol
+        qsat_new=zx_qsat(ig) + zx_dq_s_dt(ig) * d_ts(ig)
+        q1_new = AcoQSV(ig) - BcoQSV(ig)* Evp_sv(ig)*dt__SV
+        QaT_SV(ig)=q1_new*(1.-beta(ig)) + beta(ig)*qsat_new 
+
+      ENDDO
+
+      end ! subroutine SISVAT_TS2  
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_tso.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_tso.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_tso.F	(revision 3851)
@@ -0,0 +1,618 @@
+ 
+ 
+ 
+ 
+      subroutine SISVAT_TSo
+! #e1.                     (ETSo_0,ETSo_1,ETSo_d)
+ 
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_TSo                                06-10-2020  MAR |
+C |   SubRoutine SISVAT_TSo computes the Soil/Snow Energy Balance          |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  knonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+C |                     X       Number of Mosaic Cell per grid box         |
+C |                                                                        |
+C |   INPUT:   isotSV   = 0,...,11:   Soil       Type                      |
+C |   ^^^^^               0:          Water, Solid or Liquid               |
+C |            isnoSV   = total Nb of Ice/Snow Layers                      |
+C |            dQa_SV   = Limitation of  Water Vapor  Turbulent Flux       |
+C |                                                                        |
+C |   INPUT:   sol_SV   : Downward Solar Radiation                  [W/m2] |
+C |   ^^^^^    IRd_SV   : Surface Downward  Longwave   Radiation    [W/m2] |
+C |            za__SV   : SBL Top    Height                            [m] |
+C |            VV__SV   : SBL Top    Wind Speed                      [m/s] |
+C |            TaT_SV   : SBL Top    Temperature                       [K] |
+C |            rhT_SV   : SBL Top    Air  Density                  [kg/m3] |
+C |            QaT_SV   : SBL Top    Specific  Humidity            [kg/kg] |
+C |            LSdzsv   : Vertical   Discretization Factor             [-] |
+C |                     =    1. Soil                                       |
+C |                     = 1000. Ocean                                      |
+C |            dzsnSV   : Snow Layer Thickness                         [m] |
+C |            ro__SV   : Snow/Soil  Volumic Mass                  [kg/m3] |
+C |            eta_SV   : Soil Water Content                       [m3/m3] |
+C |            dt__SV   : Time Step                                    [s] |
+C |                                                                        |
+C |            SoSosv   : Absorbed Solar Radiation by Surfac.(Normaliz)[-] |
+C |            Eso_sv   : Soil+Snow       Emissivity                   [-] |
+C |            rah_sv   : Aerodynamic Resistance for Heat            [s/m] |
+C |            Lx_H2O   : Latent Heat of Vaporization/Sublimation   [J/kg] |
+C |            sEX_sv   : Verticaly Integrated Extinction Coefficient  [-] |
+C |                                                                        |
+C |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+C |   ^^^^^^                                                               |
+C |                                                                        |
+C |   OUTPUT:  IRs_SV   : Soil      IR Radiation                    [W/m2] |
+C |   ^^^^^^   HSs_sv   : Sensible  Heat Flux                       [W/m2] |
+C |            HLs_sv   : Latent    Heat Flux                       [W/m2] |
+C |            ETSo_0   : Snow/Soil Energy Power, before Forcing    [W/m2] |
+C |            ETSo_1   : Snow/Soil Energy Power, after  Forcing    [W/m2] |
+C |            ETSo_d   : Snow/Soil Energy Power         Forcing    [W/m2] |
+C |                                                                        |
+C |   Internal Variables:                                                  |
+C |   ^^^^^^^^^^^^^^^^^^                                                   |
+C |                                                                        |
+C |   METHOD: NO   Skin Surface Temperature                                |
+C |   ^^^^^^  Semi-Implicit Crank Nicholson Scheme                         |
+C |                                                                        |
+C | # OPTIONS: #E0: Energy Budget Verification                             |
+C | # ^^^^^^^  #kd: KDsvat Option:NO Flux  Limitor     on HL               |
+C | #          #KD: KDsvat Option:Explicit Formulation of HL               |
+C | #          #NC: OUTPUT for Stand Alone NetCDF File                     |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+ 
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VARxSV
+      use VARySV
+      use VARtSV
+      use VAR0SV
+      
+
+      IMPLICIT NONE
+
+ 
+C +--OUTPUT
+C +  ------
+ 
+! #e1 real      ETSo_0(knonv)                 ! Soil/Snow Power, before Forcing
+! #e1 real      ETSo_1(knonv)                 ! Soil/Snow Power, after  Forcing
+! #e1 real      ETSo_d(knonv)                 ! Soil/Snow Power, Forcing
+ 
+ 
+C +--Internal Variables
+C +  ==================
+ 
+      integer   ikl   ,isl   ,jsl   ,ist      !
+      integer   ist__s,ist__w                 ! Soil/Water  Body Identifier
+      integer   islsgn                        ! Soil/Snow Surfac.Identifier
+      real      eps__3                        ! Arbitrary    Low Number
+      real      etaMid,psiMid                 ! Layer Interface's Humidity
+      real      mu_eta                        !     Soil thermal Conductivity
+      real      mu_exp                        ! arg Soil thermal Conductivity
+      real      mu_min                        ! Min Soil thermal Conductivity
+      real      mu_max                        ! Max Soil thermal Conductivity
+      real      mu_sno(knonv),mu_aux          !     Snow thermal Conductivity
+      real      mu__dz(knonv,-nsol:nsno+1)    ! mu_(eta,sno)   / dz
+      real      dtC_sv(knonv,-nsol:nsno)      ! dt      / C
+      real      IRs__D(knonv)                 ! UpwardIR Previous Iter.Contr.
+      real      dIRsdT(knonv)                 ! UpwardIR           T Derivat.
+      real      f_HSHL(knonv)                 ! Factor common to HS and HL
+      real      dRidTs(knonv)                 ! d(Rib)/d(Ts)
+      real      HS___D(knonv)                 ! Sensible Heat Flux Atm.Contr.
+      real      f___HL(knonv)                 !
+      real      HL___D(knonv)                 ! Latent   Heat Flux Atm.Contr.
+      REAL      TSurf0(knonv),dTSurf          ! Previous Surface Temperature
+      real      qsatsg(knonv) !,den_qs,arg_qs ! Soil   Saturat. Spec. Humidity
+      real      dqs_dT(knonv)                 ! d(qsatsg)/dTv
+      real      Psi(   knonv)                 ! 1st Soil Layer Water Potential
+      real      RHuSol(knonv)                 ! Soil Surface Relative Humidity
+      real      etaSol                        ! Soil Surface          Humidity
+      real      d__eta                        ! Soil Surface Humidity Increm.
+      real      Elem_A,Elem_C                 !   Diagonal Coefficients
+      real      Diag_A(knonv,-nsol:nsno)      ! A Diagonal
+      real      Diag_B(knonv,-nsol:nsno)      ! B Diagonal
+      real      Diag_C(knonv,-nsol:nsno)      ! C Diagonal
+      real      Term_D(knonv,-nsol:nsno)      !   Independant Term
+      real      Aux__P(knonv,-nsol:nsno)      ! P Auxiliary Variable
+      real      Aux__Q(knonv,-nsol:nsno)      ! Q Auxiliary Variable
+      real      Ts_Min,Ts_Max                 ! Temperature Limits
+! #e1 real      Exist0                        ! Existing Layer Switch
+      real      psat_wat, psat_ice, sp        ! computation of qsat
+
+      integer   nt_srf,it_srf,itEuBk          ! HL: Surface Scheme
+      parameter(nt_srf=10)                    !
+      real      agpsrf,xgpsrf,dt_srf,dt_ver   !
+      real      etaBAK(knonv)                 !
+      real      etaNEW(knonv)                 !
+      real      etEuBk(knonv)                 !
+      real      fac_dt(knonv),faceta(knonv)   !
+      real      PsiArg(knonv),SHuSol(knonv)   !
+ 
+
+ 
+C +--Internal DATA
+C +  =============
+ 
+      data      eps__3 /   1.e-3   /          ! Arbitrary    Low Number
+      data      mu_exp /  -0.4343  /          ! Soil Thermal Conductivity
+      data      mu_min /   0.172   /          ! Min Soil Thermal Conductivity
+      data      mu_max /   2.000   /          ! Max Soil Thermal Conductivity
+      data      Ts_Min / 175.      /          ! Temperature            Minimum
+      data      Ts_Max / 300.      /          ! Temperature Acceptable Maximum
+C +                                           ! including   Snow Melt  Energy
+ 
+ 
+
+C +--Heat Conduction Coefficient (zero in the Layers over the highest one)
+C +  ===========================
+C +                             ---------------- isl    eta_SV, rho C (isl)
+C +
+C +--Soil                       ++++++++++++++++        etaMid,    mu (isl)
+C +  ----
+C +                             ---------------- isl-1  eta_SV, rho C (isl-1)
+           isl=-nsol
+        DO ikl=1,knonv
+
+          mu__dz(ikl,isl) = 0.
+ 
+          dtC_sv(ikl,isl) = dtz_SV2(isl)  * dt__SV        ! dt / (dz X rho C)
+     .                   /((rocsSV(isotSV(ikl))           ! [s / (m.J/m3/K)]
+     .                     +rcwdSV*eta_SV(ikl,isl))       !
+     .                     *LSdzsv(ikl)            )      !
+        END DO
+      DO   isl=-nsol+1,0
+        DO ikl=1,knonv
+          ist    =      isotSV(ikl)                       ! Soil Type
+          ist__s =  min(ist, 1)                           ! 1 => Soil
+          ist__w =  1 - ist__s                            ! 1 => Water Body
+ 
+          etaMid = 0.5*(dz_dSV(isl-1)*eta_SV(ikl,isl-1)   ! eta at layers
+     .                 +dz_dSV(isl)  *eta_SV(ikl,isl)  )  !     interface
+     .                 /dzmiSV(isl)                       ! LSdzsv implicit !
+          etaMid =  max(etaMid,epsi)
+          psiMid =      psidSV(ist)
+     .                *(etadSV(ist)/etaMid)**bCHdSV(ist)
+          mu_eta =      3.82      *(psiMid)**mu_exp       ! Soil Thermal
+          mu_eta =  min(max(mu_eta, mu_min), mu_max)      ! Conductivity
+C +                                                       ! DR97 eq.3.31
+          mu_eta =  ist__s *mu_eta +ist__w * vK_dSV       ! Water Bodies
+C +                                                       ! Correction
+          mu__dz(ikl,isl) = mu_eta/(dzmiSV(isl)           !
+     .                             *LSdzsv(ikl))          !
+ 
+          dtC_sv(ikl,isl) = dtz_SV2(isl)* dt__SV          ! dt / (dz X rho C)
+     .                   /((rocsSV(isotSV(ikl))           !
+     .                     +rcwdSV*eta_SV(ikl,isl))       !
+     .                     *LSdzsv(ikl)            )      !
+        END DO
+      END DO
+ 
+ 
+C +--Soil/Snow Interface
+C +  -------------------
+ 
+C +--Soil Contribution
+C +  ^^^^^^^^^^^^^^^^^
+           isl=1
+        DO ikl=1,knonv
+          ist    =      isotSV(ikl)                       ! Soil Type
+          ist__s =  min(ist, 1)                           ! 1 => Soil
+          ist__w =  1 - ist__s                            ! 1 => Water Body
+          psiMid =      psidSV(ist)                       ! Snow => Saturation
+          mu_eta =      3.82      *(psiMid)**mu_exp       ! Soil Thermal
+          mu_eta =  min(max(mu_eta, mu_min), mu_max)      ! Conductivity
+C +                                                       ! DR97 eq.3.31
+          mu_eta =  ist__s *mu_eta +ist__w * vK_dSV       ! Water Bodies
+ 
+C +--Snow Contribution
+C +  ^^^^^^^^^^^^^^^^^
+          mu_sno(ikl) =  CdidSV                           !
+     .                 *(ro__SV(ikl,isl) /ro_Wat) ** 1.88 !
+          mu_sno(ikl) =          max(epsi,mu_sno(ikl))    !
+C +...    mu_sno :  Snow Heat Conductivity Coefficient [Wm/K]
+C +                 (Yen 1981, CRREL Rep., 81-10)
+ 
+C +--Combined Heat Conductivity
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          mu__dz(ikl,isl) = 2./(dzsnSV(ikl,isl  )         ! Combined Heat
+     .                         /mu_sno(ikl)               ! Conductivity
+     .                         +LSdzsv(ikl)               !
+     .                         *dz_dSV(    isl-1)/mu_eta) ! Coefficient
+ 
+C +--Inverted Heat Capacity
+C +  ^^^^^^^^^^^^^^^^^^^^^^
+          dtC_sv(ikl,isl) = dt__SV/max(epsi,              ! dt / (dz X rho C)
+     .    dzsnSV(ikl,isl) * ro__SV(ikl,isl) *Cn_dSV)      !
+        END DO
+ 
+ 
+C +--Snow
+C +  ----
+ 
+      DO ikl=1,knonv
+      DO   isl=1,min(nsno,isnoSV(ikl)+1)
+          ro__SV(ikl,isl) =                               !
+     .                   ro__SV(ikl ,isl)                 !
+     .       * max(0,min(isnoSV(ikl)-isl+1,1))            !
+
+        END DO
+      END DO
+ 
+      DO ikl=1,knonv
+      DO   isl=1,min(nsno,isnoSV(ikl)+1)
+ 
+C +--Combined Heat Conductivity
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+          mu_aux      =  CdidSV                           !
+     .                 *(ro__SV(ikl,isl) /ro_Wat) ** 1.88 !
+          mu__dz(ikl,isl) =                               !
+     .      2.                        *mu_aux*mu_sno(ikl) ! Combined Heat
+     .     /max(epsi,dzsnSV(ikl,isl  )*mu_sno(ikl)        ! Conductivity
+     .              +dzsnSV(ikl,isl-1)*mu_aux     )       ! For upper Layer
+          mu_sno(ikl)     =            mu_aux             !
+ 
+C +--Inverted Heat Capacity
+C +  ^^^^^^^^^^^^^^^^^^^^^^
+          dtC_sv(ikl,isl) = dt__SV/max(eps__3,            ! dt / (dz X rho C)
+     .    dzsnSV(ikl,isl) * ro__SV(ikl,isl) *Cn_dSV)      !
+        END DO
+      END DO
+ 
+ 
+C +--Uppermost Effective Layer: NO conduction
+C +  ----------------------------------------
+ 
+        DO ikl=1,knonv
+          mu__dz(ikl,isnoSV(ikl)+1) = 0.0
+        END DO
+ 
+ 
+C +--Energy Budget (IN)
+C +  ==================
+ 
+! #e1   DO ikl=1,knonv
+! #e1     ETSo_0(ikl) = 0.
+! #e1   END DO
+! #e1 DO   isl= -nsol,nsno
+! #e1   DO ikl=1,knonv
+! #e1     Exist0      = isl -           isnoSV(ikl)
+! #e1     Exist0      = 1.  - max(zero,min(unun,Exist0))
+! #e1     ETSo_0(ikl) = ETSo_0(ikl)
+! #e1.                +(TsisSV(ikl,isl)-TfSnow)*Exist0
+! #e1.                                 /dtC_sv(ikl,isl)
+! #e1   END DO
+! #e1 END DO
+ 
+ 
+C +--Tridiagonal Elimination: Set Up
+C +  ===============================
+ 
+C +--Soil/Snow Interior
+C +  ^^^^^^^^^^^^^^^^^^
+      DO ikl=1,knonv
+      DO   isl=-nsol+1,min(nsno-1,isnoSV(ikl)+1)
+
+          Elem_A          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl)
+          Elem_C          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl+1)
+          Diag_A(ikl,isl) = -Elem_A  *Implic
+          Diag_C(ikl,isl) = -Elem_C  *Implic
+          Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)-Diag_C(ikl,isl)
+          Term_D(ikl,isl) =  Explic *(Elem_A         *TsisSV(ikl,isl-1)
+     .                               +Elem_C         *TsisSV(ikl,isl+1))
+     .             +(1.0d+0 -Explic *(Elem_A+Elem_C))*TsisSV(ikl,isl)
+     .  + dtC_sv(ikl,isl)           * sol_SV(ikl)    *SoSosv(ikl)
+     .                                               *(sEX_sv(ikl,isl+1)
+     .                                               -sEX_sv(ikl,isl  ))
+        END DO
+      END DO
+ 
+C +--Soil  lowest Layer
+C +  ^^^^^^^^^^^^^^^^^^
+           isl= -nsol
+        DO ikl=1,knonv
+          Elem_A          =  0.
+          Elem_C          =  dtC_sv(ikl,isl)         *mu__dz(ikl,isl+1)
+          Diag_A(ikl,isl) =  0.
+          Diag_C(ikl,isl) = -Elem_C  *Implic
+          Diag_B(ikl,isl) =  1.0d+0  -Diag_A(ikl,isl)-Diag_C(ikl,isl)
+          Term_D(ikl,isl) =  Explic * Elem_C         *TsisSV(ikl,isl+1)
+     .             +(1.0d+0 -Explic * Elem_C)        *TsisSV(ikl,isl)
+     .  + dtC_sv(ikl,isl)           * sol_SV(ikl)    *SoSosv(ikl)
+     .                                              *(sEX_sv(ikl,isl+1)
+     .                                               -sEX_sv(ikl,isl  ))
+        END DO
+ 
+C +--Snow highest Layer (dummy!)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        isl=  min(isnoSV(1)+1,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
+ 
+C +--Surface: UPwardIR Heat Flux
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=1,knonv
+          isl         = isnoSV(ikl)
+          dIRsdT(ikl) = Eso_sv(ikl)* StefBo          * 4.      ! - d(IR)/d(T)
+     .                             * TsisSV(ikl,isl)           !
+     .                             * TsisSV(ikl,isl)           !
+     .                             * TsisSV(ikl,isl)           !
+          IRs__D(ikl) = dIRsdT(ikl)* TsisSV(ikl,isl) * 0.75    !
+ 
+C +--Surface: Richardson Number:   T Derivative
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c #RC     dRidTs(ikl) =-gravit      *    za__SV(ikl)
+c #RC.                /(TaT_SV(ikl) *    VV__SV(ikl)
+c #RC.                              *    VV__SV(ikl))
+ 
+C +--Surface: Turbulent Heat Flux: Factors
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          f_HSHL(ikl) = rhT_SV(ikl)  /    rah_sv(ikl)           ! to  HS, HL
+          f___HL(ikl) = f_HSHL(ikl) *    Lx_H2O(ikl)
+ 
+C +--Surface: Sensible  Heat Flux: T Derivative
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          dSdTSV(ikl) = f_HSHL(ikl) *    Cp                    !#- d(HS)/d(T)
+c #RC.         *(1.0  -(TsisSV(ikl,isl) -TaT_SV(ikl))          !#Richardson
+c #RC.         * dRidTs(ikl)*dFh_sv(ikl)/rah_sv(ikl))          ! Nb. Correct.
+          HS___D(ikl) = dSdTSV(ikl) *    TaT_SV(ikl)           !
+ 
+C +--Surface: Latent    Heat Flux: Saturation Specific Humidity
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+c         den_qs      =         TsisSV(ikl,isl)- 35.8          !
+c         arg_qs      = 17.27 *(TsisSV(ikl,isl)-273.16)        !
+c    .                                   / den_qs              !
+c         qsatsg(ikl) = .0038 *        exp(arg_qs)             !
+
+!          sp = (pst_SV(ikl) + ptopSV) * 10.
+
+          sp=ps__SV(ikl)
+          psat_ice = 6.1070 * exp(6150. *(1./273.16 -
+     .                                              1./TsisSV(ikl,isl)))
+
+          psat_wat = 6.1078 * exp (5.138*log(273.16   /TsisSV(ikl,isl)))
+     .             * exp (6827.*(1.         /273.16-1./TsisSV(ikl,isl)))
+
+          if(TsisSV(ikl,isl)<=273.16) then
+            qsatsg(ikl) = 0.622 * psat_ice / (sp - 0.378 * psat_ice)
+          else
+            qsatsg(ikl) = 0.622 * psat_wat / (sp - 0.378 * psat_wat)
+          endif
+
+c         dqs_dT(ikl) = qsatsg(ikl)* 4099.2   /(den_qs *den_qs)!
+          fac_dt(ikl) = f_HSHL(ikl)/(ro_Wat   * dz_dSV(0))     !
+        END DO
+ 
+C +--Surface: Latent    Heat Flux: Surface    Relative Humidity
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+              xgpsrf       =   1.05                            !
+              agpsrf       = dt__SV*(   1.0-xgpsrf        )    !
+     .                             /(   1.0-xgpsrf**nt_srf)    !
+              dt_srf       = agpsrf                            !
+              dt_ver       = 0.                                !
+            DO ikl=1,knonv
+              isl          =          isnoSV(ikl)              !
+              etaBAK(ikl)  = max(epsi,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
+c #??.        *max(0,sign(1.,qsatsg(ikl)-QaT_SV(ikl))))        ! NO Limitation
+                                                               ! of Downw.Flux
+            END DO                                             !
+          DO itEuBk=1,2                                        !
+            DO ikl=1,knonv
+              ist    = max(0,isotSV(ikl)-100*isnoSV(ikl))      ! 0 if    H2O
+                                                               !
+              Psi(ikl) =                                       !
+     .                psidSV(ist)                              ! DR97, Eqn 3.34
+     .              *(etadSV(ist)                              !
+     .           /max(etEuBk(ikl),epsi))                       !
+     .              **bCHdSV(ist)                              !
+              PsiArg(ikl) = 7.2E-5*Psi(ikl)                    !
+              RHuSol(ikl) =   exp(-min(0.,PsiArg(ikl)))    !
+              SHuSol(ikl) =     qsatsg(ikl)  *RHuSol(ikl)      ! DR97, Eqn 3.15
+              etEuBk(ikl) =                                    !
+     .       (etaNEW(ikl) + faceta(ikl)*(QaT_SV(ikl)           !
+     .                                  -SHuSol(ikl)           !
+     .                    *(1.          -bCHdSV(ist)           !
+     .                                  *PsiArg(ikl))       )) !
+     .      /(1.          + faceta(ikl)* SHuSol(ikl)           !
+     .                                  *bCHdSV(ist)           !
+     .                                  *PsiArg(ikl)           !
+     .                                  /etaNEW(ikl))          !
+              etEuBk(ikl) = etEuBk(ikl)          !
+c    .                                 /(Ro_Wat*dz_dSV(0))     !
+     .                    * dt_srf     /(Ro_Wat*dz_dSV(0))     !
+cXF 15/05/2017 BUG
+            END DO                                             !
+          END DO                                               !
+            DO ikl=1,knonv                                     !
+              etaNEW(ikl) =  max(etEuBk(ikl),epsi)             !
+            END DO                                             !
+              dt_srf      =      dt_srf         * xgpsrf       !
+        END DO                                                 !
+ 
+C +--Surface: Latent    Heat Flux: Soil/Water Surface Contributions
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=1,knonv                                         !
+          isl        =  isnoSV(ikl)                            !
+          ist   = max(0,isotSV(ikl)-100*isnoSV(ikl))           ! 0 if    H2O
+          ist__s= min(1,ist)                                   ! 1 if no H2O
+          ist__w=     1-ist__s                                 ! 1 if    H2O
+          d__eta     =  eta_SV(ikl,isl)-etaNEW(ikl)            !
+          ! latent heat flux computation
+          HL___D(ikl)=( ist__s *ro_Wat *dz_dSV(0)              ! Soil Contrib.
+     .                *(etaNEW(ikl)    -etaBAK(ikl)) / dt__SV  !
+     .                 +ist__w         *f_HSHL(ikl)            ! H2O  Contrib.
+     .                *(QaT_SV(ikl)    - qsatsg(ikl))        ) !
+     .                * Lx_H2O(ikl)                            ! common factor
+ 
+c #DL     RHuSol(ikl) =(QaT_SV(ikl)                            !
+c #DL.                 -HL___D(ikl)    / f___HL(ikl))          !
+c #DL.                / qsatsg(ikl)                            !
+ 
+C +--Surface: Latent    Heat Flux: T Derivative
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          dLdTSV(ikl) = 0.
+c #DL     dLdTSV(ikl) = f___HL(ikl) * RHuSol(ikl) *dqs_dT(ikl) ! - d(HL)/d(T)
+c #DL     HL___D(ikl) = HL___D(ikl)                            !
+c #DL.                 +dLdTSV(ikl) * TsisSV(ikl,isl)          !
+        END DO                                                 !
+ 
+C +--Surface: Tridiagonal Matrix Set Up
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=1,knonv
+          isl             =  isnoSV(ikl)
+          TSurf0(ikl)     =  TsisSV(ikl,isl)
+
+          Elem_A          =  dtC_sv(ikl,isl)*mu__dz(ikl,isl)
+          Elem_C          =  0.
+          Diag_A(ikl,isl) = -Elem_A *Implic
+          Diag_C(ikl,isl) =  0.
+          Diag_B(ikl,isl) =  1.0d+0 -Diag_A(ikl,isl)
+          Diag_B(ikl,isl) =  Diag_B(ikl,isl)
+     .  + dtC_sv(ikl,isl) * (dIRsdT(ikl)                       ! Upw. Sol IR
+     .                      +dSdTSV(ikl)                       ! HS/Surf.Contr.
+     .                      +dLdTSV(ikl))                      ! HL/Surf.Contr.
+
+          Term_D(ikl,isl) =  Explic *Elem_A *TsisSV(ikl,isl-1)
+     .             +(1.0d+0 -Explic *Elem_A)*TsisSV(ikl,isl)
+
+
+
+          Term_D(ikl,isl) =  Term_D(ikl,isl)
+     .  + dtC_sv(ikl,isl) * (sol_SV(ikl)    *SoSosv(ikl)       ! Absorbed
+     .                                     *(sEX_sv(ikl,isl+1) ! Solar
+     .                                      -sEX_sv(ikl,isl  ))!
+     .                              +   IRd_SV(ikl)*Eso_sv(ikl) ! Down Atm IR
+     .                                +IRs__D(ikl)             ! Upw. Sol IR
+     .                                +HS___D(ikl)             ! HS/Atmo.Contr.
+     .                                +HL___D(ikl)            )! HL/Atmo.Contr.
+     
+        END DO
+ 
+ 
+C +--Tridiagonal Elimination
+C +  =======================
+ 
+C +--Forward  Sweep
+C +  ^^^^^^^^^^^^^^
+        DO ikl=  1,knonv
+          Aux__P(ikl,-nsol) = Diag_B(ikl,-nsol)
+          Aux__Q(ikl,-nsol) =-Diag_C(ikl,-nsol)/Aux__P(ikl,-nsol)
+        END DO
+ 
+        DO ikl=      1,knonv
+
+        DO   isl=-nsol+1,min(nsno,isnoSV(ikl)+1)
+          Aux__P(ikl,isl)   = Diag_A(ikl,isl)  *Aux__Q(ikl,isl-1)
+     .                       +Diag_B(ikl,isl)
+          Aux__Q(ikl,isl)   =-Diag_C(ikl,isl)  /Aux__P(ikl,isl)
+        END DO
+        END DO
+ 
+        DO ikl=      1,knonv
+          TsisSV(ikl,-nsol) = Term_D(ikl,-nsol)/Aux__P(ikl,-nsol)
+        END DO
+ 
+        DO ikl=      1,knonv
+        DO   isl=-nsol+1,min(nsno,isnoSV(ikl)+1)
+          TsisSV(ikl,isl)   =(Term_D(ikl,isl)
+     .                       -Diag_A(ikl,isl)  *TsisSV(ikl,isl-1))
+     .                                         /Aux__P(ikl,isl)
+
+  
+        END DO
+        END DO
+ 
+C +--Backward Sweep
+C +  ^^^^^^^^^^^^^^
+        DO ikl=     1,knonv
+        DO   isl=min(nsno-1,isnoSV(ikl)+1),-nsol,-1
+           
+
+          TsisSV(ikl,isl)   = Aux__Q(ikl,isl)  *TsisSV(ikl,isl+1)
+     .                                         +TsisSV(ikl,isl)
+          if(isl==0.and.isnoSV(ikl)==0) then
+ 
+           TsisSV(ikl,isl)  = min(TaT_SV(ikl)+30,TsisSV(ikl,isl))
+           TsisSV(ikl,isl)  = max(TaT_SV(ikl)-30,TsisSV(ikl,isl))
+
+
+c #EU      TsisSV(ikl,isl)  = max(TaT_SV(ikl)-15.,TsisSV(ikl,isl))
+
+          !XF 18/11/2018 to avoid ST reaching 70�C!!
+          !It is an error compensation but does not work over tundra
+ 
+          endif
+
+   
+
+        END DO
+       
+      END DO
+ 
+C +--Temperature Limits (avoids problems in case of no Snow Layers)
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=     1,knonv
+           isl              = isnoSV(ikl)
+          dTSurf            = TsisSV(ikl,isl) -     TSurf0(ikl)
+          TsisSV(ikl,isl)   = TSurf0(ikl) + sign(1.,dTSurf) ! 180.0 dgC/hr
+     .              * min(abs(dTSurf),5.e-2*dt__SV)         ! =0.05 dgC/s
+
+
+
+        END DO
+
+        DO ikl=     1,knonv
+        DO   isl=min(nsno,isnoSV(ikl)+1),1      ,-1
+          TsisSV(ikl,isl)   = max(Ts_Min,       TsisSV(ikl,isl))
+          TsisSV(ikl,isl)   = min(Ts_Max,       TsisSV(ikl,isl))
+        END DO
+
+        END DO
+ 
+C +--Update Surface    Fluxes
+C +  ========================
+ 
+        DO ikl=      1,knonv
+          isl         = isnoSV(ikl)
+          IRs_SV(ikl) = IRs__D(ikl)                          !
+     .                - dIRsdT(ikl) * TsisSV(ikl,isl)        !
+          HSs_sv(ikl) = HS___D(ikl)                          ! Sensible Heat
+     .                - dSdTSV(ikl) * TsisSV(ikl,isl)        ! Downward > 0
+          HLs_sv(ikl) = HL___D(ikl)                          ! Latent   Heat
+     .                - dLdTSV(ikl) * TsisSV(ikl,isl)        ! Downward > 0
+        END DO
+
+ 
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_weq.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_weq.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_weq.F	(revision 3851)
@@ -0,0 +1,104 @@
+ 
+ 
+      subroutine SISVAT_wEq( labWEq ,istart)
+ 
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_wEq                                22-09-2001  MAR |
+C |   SubRoutine SISVAT_wEq computes the Snow/Ice  Water  Equivalent       |
+C |                                                                        |
+C |                                                                        |
+C |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+C |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+C |   FILE                 |      CONTENT                                  |
+C |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+C | # SISVAT_wEq.ve        | #ve: OUTPUT/Verification: Snow/Ice Water Eqv. |
+C |                        |      unit 45, SubRoutine  SISVAT_wEq **ONLY** |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+
+      use VARphy
+      use VAR_SV
+      use VARxSV
+ 
+      IMPLICIT NONE
+
+ 
+ 
+      character*6         labWEq
+      integer             istart
+ 
+      logical             logWEq
+      common/SISVAT_wEq_L/logWEq
+ 
+ 
+C +--Local  Variables
+C +  ================
+ 
+      integer  ikl   ,isn
+      real     SnoWEQ,IceWEQ
+ 
+ 
+C +--Switch Initialization
+C +  =====================
+ 
+      IF (.NOT.logWEq)                                              THEN
+               logWEq = .true.
+               open(unit=45,status='unknown',file='SISVAT_wEq.ve')
+               rewind    45
+      END IF
+ 
+ 
+C +--Snow Water Equivalent
+C +  =====================
+ 
+           ikl   = 1
+      IF          (isnoSV(ikl).gt.iiceSV(ikl))                      THEN
+ 
+          SnoWEQ = 0.
+        DO isn   = iiceSV(ikl)+1 ,isnoSV(ikl)
+          SnoWEQ = SnoWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
+        END DO
+ 
+      END IF
+ 
+ 
+C +--Ice  Water Equivalent
+C +  =====================
+ 
+      IF        (iiceSV(1).gt.0)                                    THEN
+ 
+          IceWEQ = 0.
+        DO isn   =             1 ,iiceSV(ikl)
+          IceWEQ = IceWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
+        END DO
+ 
+      END IF
+ 
+ 
+C +--OUTPUT
+C +  ======
+ 
+ !      IF (istart.eq.1)                                              THEN
+ !        write(45,45)dahost,i___SV(lwriSV(1)),j___SV(lwriSV(1)),
+ !     .              n___SV(lwriSV(1))
+ ! 45     format(a18,10('-'),'Pt.',3i4,60('-'))
+ !      END IF
+ 
+ !      write(45,450) labWEq,IceWEQ,iiceSV(ikl),SnoWEQ
+ !     .                    ,IceWEQ+SnoWEQ,isnoSV(ikl)
+ !     .                                  ,drr_SV(ikl)*dt__SV
+ !     .                                  ,dsn_SV(ikl)*dt__SV
+ !     .                                  ,BufsSV(ikl)
+ ! 450  format(a6,3x,'  I+S =',f11.4,'(',i2,') +',f11.4,' =',
+ !     .                       f11.4,'(',i2,')',
+ !     .             '  drr =', f7.4,
+ !     .             '  dsn =', f7.4,
+ !     .             '  Buf =', f7.4)
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zag.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zag.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zag.F	(revision 3851)
@@ -0,0 +1,238 @@
+ 
+ 
+      subroutine SISVAT_zAg
+     .                     (isagra,isagrb,WEagra
+     .                     ,dzagra,dzagrb,T_agra,T_agrb
+     .                     ,roagra,roagrb,etagra,etagrb
+     .                     ,G1agra,G1agrb,G2agra,G2agrb
+     .                     ,agagra,agagrb,Agreg1
+     .                     )
+ 
+C +------------------------------------------------------------------------+
+C | MAR SURFACE                                       Sat 30-Apr-2004  MAR |
+C |   SubRoutine SISVAT_zAg aggregates two contiguous snow layers          |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  knonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+C |                     X       Number of Mosaic Cell per grid box         |
+C |                                                                        |
+C |   INPUT:   isagrb   : 2nd     Layer History                            |
+C |   ^^^^^                                                                |
+C |                                                                        |
+C |   INPUT:   dzagrb   : 2nd     Layer Thickness                          |
+C |   ^^^^^    T_agrb   : 2nd     Layer Temperature                        |
+C |            roagrb   : 2nd     Layer Density                            |
+C |            etagrb   : 2nd     Layer Water Content                      |
+C |            G1agrb   : 2nd     Layer Dendricity/Spher.                  |
+C |            G2agrb   : 2nd     Layer Sphericity/Size                    |
+C |            agagrb   : 2nd     Age                                      |
+C |            Agreg1   : 1. when Agregation constrained                   |
+C |                                                                        |
+C |   INPUT /  isagra   : 1st     Layer History                            |
+C |   OUTPUT:                                                              |
+C |   ^^^^^^                                                               |
+C |                                                                        |
+C |   INPUT /  dzagra   : 1st     Layer Thickness                          |
+C |   OUTPUT:  T_agra   : 1st     Layer Temperature                        |
+C |   ^^^^^^   roagra   : 1st     Layer Density                            |
+C |            etagra   : 1st     Layer Water Content                      |
+C |            G1agra   : 1st     Layer Dendricity/Spher.                  |
+C |            G2agra   : 1st     Layer Sphericity/Size                    |
+C |            agagra   : 1st     Age                                      |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+ 
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VAR0SV
+      use VARxSV
+
+      IMPLICIT NONE
+
+ 
+C +--INPUT
+C +  -----
+ 
+      integer   isagrb(knonv)                 ! 2nd Layer History
+      real      dzagrb(knonv)                 ! 2nd Layer Thickness
+      real      T_agrb(knonv)                 ! 2nd Layer Temperature
+      real      roagrb(knonv)                 ! 2nd Layer Density
+      real      etagrb(knonv)                 ! 2nd Layer Water Content
+      real      G1agrb(knonv)                 ! 2nd Layer Dendricity/Spher.
+      real      G2agrb(knonv)                 ! 2nd Layer Sphericity/Size
+      real      agagrb(knonv)                 ! 2nd Layer Age
+ 
+ 
+C +--INPUT/OUTPUT
+C +  ------------
+ 
+      integer   isagra(knonv)                 ! 1st Layer History
+      real      WEagra(knonv)                 ! 1st Layer Height    [mm w.e.]
+      real      Agreg1(knonv)                 ! 1. ===>   Agregates
+      real      dzagra(knonv)                 ! 1st Layer Thickness
+      real      T_agra(knonv)                 ! 1st Layer Temperature
+      real      roagra(knonv)                 ! 1st Layer Density
+      real      etagra(knonv)                 ! 1st Layer Water Content
+      real      G1agra(knonv)                 ! 1st Layer Dendricity/Spher.
+      real      G2agra(knonv)                 ! 1st Layer Sphericity/Size
+      real      agagra(knonv)                 ! 1st Layer Age
+ 
+ 
+C +--Internal Variables
+C +  ==================
+ 
+      integer   ikl
+      integer   nh                            ! Averaged    Snow History
+      integer   nh__OK                        ! 1=>Conserve Snow History
+      real      rh                            !
+      real      dz                            ! Thickness
+      real      dzro_1                        ! Thickness X Density, Lay.1
+      real      dzro_2                        ! Thickness X Density, Lay.2
+      real      dzro                          ! Thickness X Density, Aver.
+      real      ro                            ! Averaged    Density
+      real      wn                            ! Averaged    Water Content
+      real      tn                            ! Averaged    Temperature
+      real      ag                            ! Averaged    Snow Age
+      real      SameOK                        ! 1. => Same Type of Grains
+      real      G1same                        ! Averaged G1,  same Grains
+      real      G2same                        ! Averaged G2,  same Grains
+      real      typ__1                        ! 1. => Lay1 Type: Dendritic
+      real      zroNEW                        ! dz X ro, if fresh Snow
+      real      G1_NEW                        ! G1,      if fresh Snow
+      real      G2_NEW                        ! G2,      if fresh Snow
+      real      zroOLD                        ! dz X ro, if old   Snow
+      real      G1_OLD                        ! G1,      if old   Snow
+      real      G2_OLD                        ! G2,      if old   Snow
+      real      SizNEW                        ! Size,    if fresh Snow
+      real      SphNEW                        ! Spheric.,if fresh Snow
+      real      SizOLD                        ! Size,    if old   Snow
+      real      SphOLD                        ! Spheric.,if old   Snow
+      real      Siz_av                        ! Averaged    Grain Size
+      real      Sph_av                        ! Averaged    Grain Spher.
+      real      Den_av                        ! Averaged    Grain Dendr.
+      real      DendOK                        ! 1. => Average is  Dendr.
+      real      G1diff                        ! Averaged G1, diff. Grains
+      real      G2diff                        ! Averaged G2, diff. Grains
+      real      G1                            ! Averaged G1
+      real      G2                            ! Averaged G2
+ 
+
+ 
+C +--Mean   Properties
+C +  =================
+ 
+C +-- 1 Densite, Contenu en Eau, Temperature /
+C +     Density, Water Content,  Temperature
+C +     ------------------------------------
+ 
+      DO ikl = 1,knonv
+          dz      =  dzagra(ikl) + dzagrb(ikl)
+          dzro_1  =  roagra(ikl) * dzagra(ikl)
+          dzro_2  =  roagrb(ikl) * dzagrb(ikl)
+          dzro    =  dzro_1      + dzro_2
+          ro      =  dzro
+     .     /max(epsi,dz)
+          wn      = (dzro_1*etagra(ikl) + dzro_2*etagrb(ikl))
+     .     /max(epsi,dzro)
+          tn      = (dzro_1*T_agra(ikl) + dzro_2*T_agrb(ikl))
+     .     /max(epsi,dzro)
+          ag      = (dzro_1*agagra(ikl) + dzro_2*agagrb(ikl))
+     .     /max(epsi,dzro)
+ 
+          rh      =  max(zero,sign(unun,zWEcSV(ikl)
+     .                                         -0.5*WEagra(ikl)))
+          nh__OK  =  rh
+          nh      =                 max(isagra(ikl),isagrb(ikl))
+c #HB.            *  nh__OK
+c #HB.          + (1-nh__OK)*       min(isagra(ikl),isagrb(ikl))
+ 
+ 
+ 
+C +-- 2 Nouveaux Types de Grains /  new Grain Types
+C +     -------------------------------------------
+ 
+C +-- 2.1. Meme  Type  de Neige  / same Grain Type
+C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          SameOK  =  max(zero,
+     .                   sign(unun, G1agra(ikl) *G1agrb(ikl)  - eps_21))
+          G1same  = (dzro_1*G1agra(ikl) + dzro_2*G1agrb(ikl))
+     .     /max(epsi,dzro)
+          G2same  = (dzro_1*G2agra(ikl) + dzro_2*G2agrb(ikl))
+     .     /max(epsi,dzro)
+ 
+C +-- 2.2. Types differents / differents Types
+C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+          typ__1  =  max(zero,sign(unun,epsi-G1agra(ikl))) ! =1.=> Dendritic
+          zroNEW  =     typ__1  *dzro_1                    ! ro of Dendr.Lay.
+     .            + (1.-typ__1) *dzro_2                    !
+          G1_NEW  =     typ__1  *G1agra(ikl)               ! G1 of Dendr.Lay.
+     .            + (1.-typ__1) *G1agrb(ikl)               !
+          G2_NEW  =     typ__1  *G2agra(ikl)               ! G2 of Dendr.Lay.
+     .            + (1.-typ__1) *G2agrb(ikl)               !
+          zroOLD  = (1.-typ__1) *dzro_1                    ! ro of Spher.Lay.
+     .            +     typ__1  *dzro_2                    !
+          G1_OLD  = (1.-typ__1) *G1agra(ikl)               ! G1 of Spher.Lay.
+     .            +     typ__1  *G1agrb(ikl)               !
+          G2_OLD  = (1.-typ__1) *G2agra(ikl)               ! G2 of Spher.Lay.
+     .            +     typ__1  *G2agrb(ikl)               !
+          SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV             ! Size  Dendr.Lay.
+     .             +(1.+G1_NEW         /G1_dSV)            !
+     .                *(G2_NEW  *DScdSV/G1_dSV             !
+     .             +(1.-G2_NEW         /G1_dSV)*DFcdSV)    !
+          SphNEW  =     G2_NEW         /G1_dSV             ! Spher.Dendr.Lay.
+          SizOLD  =     G2_OLD                             ! Size  Spher.Lay.
+          SphOLD  =     G1_OLD         /G1_dSV             ! Spher.Spher.Lay.
+          Siz_av  = (zroNEW*SizNEW+zroOLD*SizOLD)      ! Averaged Size
+     .     /max(epsi,dzro)                             !
+          Sph_av  = (zroNEW*SphNEW+zroOLD*SphOLD)      ! Averaged Sphericity
+     .     /max(epsi,dzro)                             !
+          Den_av  = (Siz_av -(    Sph_av *DScdSV       !
+     .                       +(1.-Sph_av)*DFcdSV))     !
+     .            / (DDcdSV -(    Sph_av *DScdSV       !
+     .                       +(1.-Sph_av)*DFcdSV))     !
+          DendOK  = max(zero,                          !
+     .                  sign(unun,     Sph_av *DScdSV  ! Small   Grains Contr.
+     .                            +(1.-Sph_av)*DFcdSV  ! Faceted Grains Contr.
+     .                            -    Siz_av        ))!
+C +...    REMARQUE: le  type moyen (dendritique ou non) depend
+C +       ^^^^^^^^  de la  comparaison avec le diametre optique
+C +                 d'une neige recente de   dendricite nulle
+C +...    REMARK:   the mean type  (dendritic   or not) depends
+C +       ^^^^^^    on the comparaison with the optical diameter
+C +                 of a recent snow    having zero dendricity
+ 
+          G1diff  =(   -DendOK *Den_av
+     .             +(1.-DendOK)*Sph_av) *G1_dSV
+          G2diff  =     DendOK *Sph_av  *G1_dSV
+     .             +(1.-DendOK)*Siz_av
+          G1      =     SameOK *G1same
+     .             +(1.-SameOK)*G1diff
+          G2      =     SameOK *G2same
+     .             +(1.-SameOK)*G2diff
+ 
+ 
+C +--Assignation to new Properties
+C +  =============================
+ 
+          isagra(ikl)   = Agreg1(ikl) *nh +(1.-Agreg1(ikl)) *isagra(ikl)
+          dzagra(ikl)   = Agreg1(ikl) *dz +(1.-Agreg1(ikl)) *dzagra(ikl)
+          T_agra(ikl)   = Agreg1(ikl) *tn +(1.-Agreg1(ikl)) *T_agra(ikl)
+          roagra(ikl)   = Agreg1(ikl) *ro +(1.-Agreg1(ikl)) *roagra(ikl)
+          etagra(ikl)   = Agreg1(ikl) *wn +(1.-Agreg1(ikl)) *etagra(ikl)
+          G1agra(ikl)   = Agreg1(ikl) *G1 +(1.-Agreg1(ikl)) *G1agra(ikl)
+          G2agra(ikl)   = Agreg1(ikl) *G2 +(1.-Agreg1(ikl)) *G2agra(ikl)
+          agagra(ikl)   = Agreg1(ikl) *ag +(1.-Agreg1(ikl)) *agagra(ikl)
+ 
+      END DO
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zcr.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zcr.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zcr.F	(revision 3851)
@@ -0,0 +1,175 @@
+ 
+ 
+      subroutine SISVAT_zCr
+C +
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_zCr                                12-12-2002  MAR |
+C |   SubRoutine SISVAT_zCr determines criteria for Layers Agregation      |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  klonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+C |                     X       Number of Mosaic Cell per grid box         |
+C |                                                                        |
+C |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
+C |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
+C |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+C |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+C |                                                                        |
+C |   INPUT /  ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+C |   ^^^^^^   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+C |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+C |            agsnSV   : Snow       Age                             [day] |
+C |                                                                        |
+C |   OUTPUT:  LIndsv   : Relative Index of a contiguous Layer to agregate |
+C |   ^^^^^^                                                               |
+C +------------------------------------------------------------------------+
+C +
+C +
+C +
+C +
+C +--Global Variables
+C +  ================
+C  
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VAR0SV
+      use VARxSV
+      use VARySV
+      use VARtSV
+     
+      IMPLICIT NONE
+
+C +
+C +
+C +--Internal Variables
+C +  ==================
+C +
+      integer   ikl   ,isn   ,is0   ,is1
+      integer   isno_1                        ! Switch:  ! Snow Layer over Ice
+      real      Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure
+      real      DenSph                        ! 1. when contiguous spheric
+C +                                           !     and dendritic  Grains
+      real      DendOK                        ! 1. when dendritic  Grains
+      real      dTypMx                        ! Grain Type Differ.
+      real      dTypSp                        ! Sphericity Weight
+      real      dTypRo                        ! Density    Weight
+      real      dTypDi                        ! Grain Diam.Weight
+      real      dTypHi                        ! History    Weight
+ 
+ 
+C +--DATA
+C +  ====
+ 
+      data      dTypMx / 200.0  /             ! Grain Type Weight
+      data      dTypSp /   0.5  /             ! Sphericity Weight
+      data      dTypRo /   0.5  /             ! Density    Weight
+      data      dTypDi /  10.0  /             ! Grain Diam.Weight
+      data      dTypHi / 100.0  /             ! History    Weight
+ 
+ 
+C +--Agregation Criteria
+C +  ===================
+C +
+      DO  ikl=1,knonv
+          i_thin(ikl) = min(i_thin(ikl),isnoSV(ikl))
+          isn         = max(1          ,i_thin(ikl))
+C +
+C +
+C +--Comparison with the downward Layer
+C +  ----------------------------------
+C +
+
+          is0    = max(1,        i_thin(ikl)-1 )        ! Downward Layer Index
+          DenSph = max(zero,                            ! isn/is1
+     .                 sign(unun,                       ! Dendricity/Sphericity
+     .                      epsi-G1snSV(ikl,isn)        !            Switch
+     .                          *G1snSV(ikl,is0)))      !
+          DendOK = max(zero,                            ! Dendricity Switch
+     .                 sign(unun,                       !
+     .                      epsi-G1snSV(ikl,isn)))      !
+C +          
+          Dtyp_0 =
+     .         DenSph *      dTypMx
+     .    +(1.-DenSph)
+     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
+     .                      -G1snSV(ikl,is0))           !     Contribution
+     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
+     .                      -G2snSV(ikl,is0))) *dTypSp  !     Contribution
+     .                  +abs(ro__SV(ikl,isn)            ! Density
+     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
+     .    +(1.-DenSph)                                  !
+     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
+     .                      -G1snSV(ikl,is0))           !     Contribution
+     .                  +abs(G2snSV(ikl,isn)            ! Size
+     .                      -G2snSV(ikl,is0))) *dTypDi  !     Contribution
+     .                  +abs(ro__SV(ikl,isn)            ! Density
+     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
+          Dtyp_0 =                                      !
+     .                   min(dTypMx,                    !
+     .                       Dtyp_0                     !
+     .                  +abs(istoSV(ikl,isn)            ! History
+     .                      -istoSV(ikl,is0))  *dTypHi) !     Contribution
+     .        +             (1 -abs(isn-is0))  * 1.e+6  !"Same Layer"Score
+     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
+     .                                 -is0))  * 1.e+6  ! Interface" Score
+C +
+C +
+C +--Comparison with the   upward Layer
+C +  ----------------------------------
+C +
+          is1    = min(          i_thin(ikl)+1,         ! Upward   Layer Index
+     .                 max(1,    isnoSV(ikl)  ))        !
+          DenSph = max(zero,                            ! isn/is1
+     .                 sign(unun,                       ! Dendricity/Sphericity
+     .                      epsi-G1snSV(ikl,isn)        !            Switch
+     .                          *G1snSV(ikl,is1)))      !
+          DendOK = max(zero,                            ! Dendricity Switch
+     .                 sign(unun,                       !
+     .                      epsi-G1snSV(ikl,isn)))      !
+C +
+          Dtyp_1 =
+     .         DenSph *      dTypMx
+     .    +(1.-DenSph)
+     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
+     .                      -G1snSV(ikl,is1))           !     Contribution
+     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
+     .                      -G2snSV(ikl,is1))) *dTypSp  !     Contribution
+     .                  +abs(ro__SV(ikl,isn)            ! Density
+     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
+     .    +(1.-DenSph)                                  !
+     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
+     .                      -G1snSV(ikl,is1))           !     Contribution
+     .                  +abs(G2snSV(ikl,isn)            ! Size
+     .                      -G2snSV(ikl,is1))) *dTypDi  !     Contribution
+     .                  +abs(ro__SV(ikl,isn)            ! Density
+     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
+          Dtyp_1 =                                      !
+     .                   min(dTypMx,                    !
+     .                       Dtyp_1                     !
+     .                  +abs(istoSV(ikl,isn)            ! History
+     .                      -istoSV(ikl,is1))  *dTypHi) !     Contribution
+     .        +             (1 -abs(isn-is1))  * 1.e+6  !"Same Layer"Score
+     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
+     .                                 -isn))  * 1.e+6  ! Interface" Score
+C +
+C +
+C +--Index of the Layer to agregate
+C +  ==============================
+C +
+          LIndsv(ikl) = sign(unun,Dtyp_0
+     .                           -Dtyp_1)
+          isno_1      = (1 -min (abs(isnoSV(ikl)        ! Switch = 1
+     .                              -iiceSV(ikl)-1),1)) !   if isno = iice +1
+     .                * (1 -min (abs(isnoSV(ikl)        ! Switch = 1
+     .                              -i_thin(ikl)  ),1)) !   if isno = i_ithin
+          LIndsv(ikl) = (1 -isno_1) *LIndsv(ikl)        ! Contiguous Layer is
+     .                     -isno_1                      ! downward for top L.
+          i_thin(ikl) =  max(1,   i_thin(ikl)   )
+      END DO
+C +
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zsn.F
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zsn.F	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/sisvat_zsn.F	(revision 3851)
@@ -0,0 +1,720 @@
+ 
+ 
+      subroutine SISVAT_zSn
+ 
+C +------------------------------------------------------------------------+
+C | MAR          SISVAT_zSn                                12-07-2019  MAR |
+C |   SubRoutine SISVAT_zSn manages the Snow Pack vertical Discretization  |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+C |                                                                        |
+C |   PARAMETERS:  knonv: Total Number of columns =                        |
+C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
+C |                     X       Number of Mosaic Cell per grid box         |
+C |                                                                        |
+C |   INPUT /  NLaysv   = New             Snow Layer  Switch               |
+C |   OUTPUT:  isnoSV   = total Nb of Ice/Snow Layers                      |
+C |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
+C |            iiceSV   = total Nb of Ice      Layers                      |
+C |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
+C |                                                                        |
+C |   INPUT /  TsisSV   : Soil/Ice Temperatures (layers -nsol,-nsol+1,..,0)|
+C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
+C |   ^^^^^^   ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
+C |            eta_SV   : Soil/Snow Water   Content                [m3/m3] |
+C |            dzsnSV   : Snow Layer        Thickness                  [m] |
+C |            G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
+C |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
+C |            agsnSV   : Snow       Age                             [day] |
+C |                                                                        |
+C |   METHOD:  1) Agregate the thinest Snow Layer                          |
+C |   ^^^^^^      if a new Snow Layer has been precipitated   (NLaysv = 1) |
+C |            2) Divide   a too thick Snow Layer except                   |
+C |               if the maximum Number of Layer is reached                |
+C |               in this case forces                          NLay_s = 1  |
+C |            3) Agregate the thinest Snow Layer                          |
+C |               in order to divide a too thick Snow Layer                |
+C |               at next Time Step when                       NLay_s = 1  |
+C |                                                                        |
+C +------------------------------------------------------------------------+
+ 
+ 
+ 
+ 
+C +--Global Variables
+C +  ================
+ 
+
+      use VARphy
+      use VAR_SV
+      use VARdSV
+      use VAR0SV
+      use VARxSV
+      use VARySV
+
+      IMPLICIT NONE
+
+ 
+C +--Internal Variables
+C +  ==================
+ 
+      integer   ikl   ,isn   ,i               !
+ 
+
+            
+
+ 
+ 
+      integer   NLay_s(knonv)                 ! Split Snow Layer         Switch
+      integer   isagr1(knonv)                 ! 1st     Layer History
+      integer   isagr2(knonv)                 ! 2nd     Layer History
+      integer   LstLay                        ! 0 ====> isnoSV = 1
+      integer   isno_n                        ! Snow Normal.Profile
+      integer   iice_n                        ! Ice  Normal.Profile
+      integer   iiceOK                        ! Ice         Switch
+      integer   icemix                        ! 0 ====> Agregated Snow+Ice=Snow
+C +                                           ! 1                          Ice
+      integer   isn1  (knonv)                 ! 1st layer to stagger
+      real      staggr                        !              stagger  Switch
+ 
+      real      WEagre(knonv)                 ! Snow Water Equivalent Thickness
+      real      dzthin(knonv)                 ! Thickness of the thinest layer
+      real      OKthin                        ! Swich ON  a  new thinest layer
+      real      dz_dif                        ! difference from ideal discret.
+      real      thickL                        ! Thick Layer          Indicator
+      real      OK_ICE                        ! Swich ON   uppermost Ice Layer
+ 
+      real      Agrege(knonv)                 ! 1. when Agregation constrained
+      real      dzepsi                        ! Min Single Snw Layer Thickness
+      real      dzxmin                        ! Min Acceptable Layer Thickness
+      real      dz_min                        ! Min            Layer Thickness
+      real      dz_max                        ! Max            Layer Thickness
+      real      dzagr1(knonv)                 ! 1st     Layer Thickness
+      real      dzagr2(knonv)                 ! 2nd     Layer Thickness
+      real      T_agr1(knonv)                 ! 1st     Layer Temperature
+      real      T_agr2(knonv)                 ! 2nd     Layer Temperature
+      real      roagr1(knonv)                 ! 1st     Layer Density
+      real      roagr2(knonv)                 ! 2nd     Layer Density
+      real      etagr1(knonv)                 ! 1st     Layer Water Content
+      real      etagr2(knonv)                 ! 2nd     Layer Water Content
+      real      G1agr1(knonv)                 ! 1st     Layer Dendricity/Spher.
+      real      G1agr2(knonv)                 ! 2nd     Layer Dendricity/Spher.
+      real      G2agr1(knonv)                 ! 1st     Layer Sphericity/Size
+      real      G2agr2(knonv)                 ! 2nd     Layer Sphericity/Size
+      real      agagr1(knonv)                 ! 1st     Layer Age
+      real      agagr2(knonv)                 ! 2nd     Layer Age
+
+ 
+C +--DATA
+C +  ====
+ 
+      data      icemix /   0    /             ! 0 ====> Agregated Snow+Ice=Snow
+      data      dzepsi /   0.0020/            ! Min single Layer Thickness
+      data      dzxmin /   0.0025/            ! Min accept.Layer Thickness
+c #EU data      dz_min /   0.0050/            ! Min Local  Layer Thickness < SMn
+      data      dz_min /   0.0040/            ! Min Local  Layer Thickness < SMn
+      data      dz_max /   0.0300/            ! Min Gener. Layer Thickness
+C +   CAUTION:  dz_max > dz_min*2 is required ! Otherwise re-agregation is
+C +                                           ! activated  after splitting
+ 
+
+ 
+
+ 
+C +--Constrains Agregation         of too thin  Layers
+C +  =================================================
+ 
+C +--Search the thinest  non-zero Layer
+C +  ----------------------------------
+ 
+        DO ikl=1,knonv
+          if(isnoSV(ikl)<=2)             dz_min=max(0.0050,dz_min)
+ 
+                                          dzepsi=0.0015
+          if(ro__SV(ikl,isnoSV(ikl))>920) dzepsi=0.0020
+ 
+          dzthin(ikl) = 0.                              ! Arbitrary unrealistic
+        END DO                                          !       Layer Thickness
+cXF
+      DO ikl=1,knonv
+      DO   isn=1,isnoSV(ikl)-3 ! no agregation of 3 first snowlayers
+                               ! XF 04/07/2019
+ 
+          isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
+          iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
+          iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
+! #vz     dz_ref(isn) =                                 !
+! #vz.          dz_min *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+! #vz.                 +    iiceOK *    2**iice_n)      !
+! #vz.               /max(1,isnoSV(ikl))                !
+          dz_dif      = max(zero,                       ! Actual      Profile
+     .          dz_min                                  !
+     .                 *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+     .                 +    iiceOK *2.   **iice_n)      !
+     .        - dzsnSV(ikl, isn)                    )   ! Actual      Profile
+! #vz     dzwdif(isn) =     dz_dif                      !
+          OKthin      = max(zero,                       !
+     .                      sign(unun,                  !
+     .                           dz_dif-dzthin(ikl)))   ! 1.=> New thinest Lay.
+     .                * max(0,                          ! 1 => .le. isnoSV
+     .                  min(1,                          ! 1 => isn is in the
+     .                      isnoSV(ikl)-isn +1 ))       !          Snow Pack
+     .                * min(unun,                                !
+!
+!                       1st additional Condition to accept OKthin
+     .                  max(zero,                                ! combination
+     .                      sign(unun,G1snSV(ikl,      isn  )    ! G1 with same
+     .                               *G1snSV(ikl,max(1,isn-1)))) !  sign => OK
+!
+!                       2nd additional Condition to accept OKthin
+     .                + max(zero,                                ! G1>0
+     .                      sign(unun,G1snSV(ikl,      isn   ))) !  =>OK
+!
+!                       3rd additional Condition to accept OKthin
+     .                + max(zero,                                ! dz too small
+     .                      sign(unun,dzxmin                     !  =>OK
+     .                               -dzsnSV(ikl,      isn   ))))!
+ 
+          i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) ! Update   thinest Lay.
+     .                         + OKthin   * isn         !                Index
+          dzthin(ikl) =    (1. - OKthin)  * dzthin(ikl) !
+     .                         + OKthin   * dz_dif      !
+        END DO
+      END DO
+ 
+
+ 
+      DO ikl=1,knonv
+      DO   isn=1,isnoSV(ikl)
+          OKthin =      max(zero,                       !
+     .                      sign(unun,                  !
+     .                           dz_min                 !
+     .                          -dzsnSV(ikl,isn)))      !
+     .                * max(zero,                       ! ON if dz > 0
+     .                      sign(unun,                  !
+     .                           dzsnSV(ikl,isn)-epsi)) !
+     .           *min(1,max(0,                          ! Multiple Snow    Lay.
+     .                      min (1,                     ! Switch = 1
+     .                           isnoSV(ikl)            !   if isno > iice + 1
+     .                          -iiceSV(ikl)-1))        !
+C +                                                     !
+     .             +int(max(zero,                       !
+     .                      sign(unun,                  !
+     .                           dzepsi                 ! Minimum accepted for
+     .                          -dzsnSV(ikl,isn))))     ! 1 Snow Layer over Ice
+     .             *int(max(zero,                       ! ON if dz > 0
+     .                      sign(unun,                  !
+     .                           dzsnSV(ikl,isn)-epsi)))!
+     .                 *(1 -min (abs(isnoSV(ikl)        ! Switch = 1
+     .                              -iiceSV(ikl)-1),1)) !   if isno = iice + 1
+C +                                                     !
+     .                 +max(0,                          ! Ice
+     .                      min (1,                     ! Switch
+     .                           iiceSV(ikl)+1-isn)))   !
+     .             *min(unun,                                    !
+     .                  max(zero,                                ! combination
+     .                      sign(unun,G1snSV(ikl,      isn  )    ! G1>0 + G1<0
+     .                               *G1snSV(ikl,max(1,isn-1)))) ! NO
+     .                + max(zero,                                !
+     .                      sign(unun,G1snSV(ikl,      isn   ))) !
+     .                + max(zero,                                !
+     .                      sign(unun,dzxmin                     !
+     .                               -dzsnSV(ikl,      isn   ))))!
+          i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) ! Update   thinest Lay.
+     .                         + OKthin   * isn         !                Index
+        END DO
+      END DO
+ 
+
+
+ 
+C +   ***************
+      call SISVAT_zCr
+C +   ***************
+ 
+ 
+C +--Assign the 2 Layers to agregate
+C +  -------------------------------
+ 
+        DO ikl=1,knonv
+          isn         =    i_thin(ikl)
+          if(LIndsv(ikl)>0) isn=min(nsno-1,isn) ! cXF
+          isagr1(ikl) =    istoSV(ikl,isn)
+          isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
+          dzagr1(ikl) =    dzsnSV(ikl,isn)
+          dzagr2(ikl) =    dzsnSV(ikl,isn+LIndsv(ikl))
+          T_agr1(ikl) =    TsisSV(ikl,isn)
+          T_agr2(ikl) =    TsisSV(ikl,isn+LIndsv(ikl))
+          roagr1(ikl) =    ro__SV(ikl,isn)
+          roagr2(ikl) =    ro__SV(ikl,isn+LIndsv(ikl))
+          etagr1(ikl) =    eta_SV(ikl,isn)
+          etagr2(ikl) =    eta_SV(ikl,isn+LIndsv(ikl))
+          G1agr1(ikl) =    G1snSV(ikl,isn)
+          G1agr2(ikl) =    G1snSV(ikl,isn+LIndsv(ikl))
+          G2agr1(ikl) =    G2snSV(ikl,isn)
+          G2agr2(ikl) =    G2snSV(ikl,isn+LIndsv(ikl))
+          agagr1(ikl) =    agsnSV(ikl,isn)
+          agagr2(ikl) =    agsnSV(ikl,isn+LIndsv(ikl))
+          LstLay      = min(1,max(  0,isnoSV(ikl) -1))  ! 0  if single Layer
+          isnoSV(ikl) =               isnoSV(ikl)       ! decrement   isnoSV
+     .     -(1-LstLay)* max(zero,                       ! if downmost  Layer
+     .                      sign(unun,eps_21            ! <  1.e-21 m
+     .                               -dzsnSV(ikl,1)))   !
+          isnoSV(ikl) = max(   0,     isnoSV(ikl)   )   !
+          Agrege(ikl) = max(zero,                       !
+     .                      sign(unun,dz_min            ! No Agregation
+     .                               -dzagr1(ikl)  ))   ! if too thick Layer
+     .                               *LstLay            ! if  a single Layer
+     .                * min( max(0   ,isnoSV(ikl)+1     ! if Agregation
+     .                               -i_thin(ikl)       !    with    a Layer
+     .                               -LIndsv(ikl)  ),1) !    above the Pack
+ 
+          WEagre(ikl) = 0.
+        END DO
+ 
+ 
+        DO ikl=1,knonv
+        DO   isn=1,isnoSV(ikl)
+          WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn)
+     .                                *min(1,max(0,i_thin(ikl)+1-isn))
+        ENDDO
+        ENDDO
+ 
+ 
+C +--Agregates
+C +  ---------
+ 
+C +     ***************
+        call SISVAT_zAg
+     .                 (isagr1,isagr2,WEagre
+     .                 ,dzagr1,dzagr2,T_agr1,T_agr2
+     .                 ,roagr1,roagr2,etagr1,etagr2
+     .                 ,G1agr1,G1agr2,G2agr1,G2agr2
+     .                 ,agagr1,agagr2,Agrege
+     .                 )
+C +     ***************
+ 
+ 
+C +--Rearranges the Layers
+C +  ---------------------
+ 
+C +--New (agregated) Snow layer
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=1,knonv
+          isn     =             i_thin(ikl)
+          isn     = min(isn,isn+LIndsv(ikl))
+          isnoSV(ikl) =  max(0.,isnoSV(ikl) -Agrege(ikl))
+          iiceSV(ikl) =         iiceSV(ikl)
+     .            -max(0,sign(1,iiceSV(ikl) -isn +icemix))
+     .                                      *Agrege(ikl)
+     .            *max(0,sign(1,iiceSV(ikl) -1          ))
+          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
+     .                      +   Agrege(ikl) *isagr1(ikl)
+          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+     .                      +   Agrege(ikl) *dzagr1(ikl)
+          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
+     .                      +   Agrege(ikl) *T_agr1(ikl)
+          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
+     .                      +   Agrege(ikl) *roagr1(ikl)
+          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
+     .                      +   Agrege(ikl) *etagr1(ikl)
+          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
+     .                      +   Agrege(ikl) *G1agr1(ikl)
+          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
+     .                      +   Agrege(ikl) *G2agr1(ikl)
+          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
+     .                      +   Agrege(ikl) *agagr1(ikl)
+        END DO
+ 
+C +--Above
+C +  ^^^^^
+        DO ikl=1,knonv
+          isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
+        END DO
+        DO i=  1,nsno-1
+        DO ikl=1,knonv
+            staggr        =  min(1,max(0,i +1 -isn1(ikl)   ))
+            istoSV(ikl,i) = (1.-staggr     )*istoSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*istoSV(ikl,i  )
+     .                      +   Agrege(ikl) *istoSV(ikl,i+1))
+            dzsnSV(ikl,i) = (1.-staggr     )*dzsnSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*dzsnSV(ikl,i  )
+     .                      +   Agrege(ikl) *dzsnSV(ikl,i+1))
+            TsisSV(ikl,i) = (1.-staggr     )*TsisSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*TsisSV(ikl,i  )
+     .                      +   Agrege(ikl) *TsisSV(ikl,i+1))
+            ro__SV(ikl,i) = (1.-staggr     )*ro__SV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*ro__SV(ikl,i  )
+     .                      +   Agrege(ikl) *ro__SV(ikl,i+1))
+            eta_SV(ikl,i) = (1.-staggr     )*eta_SV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*eta_SV(ikl,i  )
+     .                      +   Agrege(ikl) *eta_SV(ikl,i+1))
+            G1snSV(ikl,i) = (1.-staggr     )*G1snSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*G1snSV(ikl,i  )
+     .                      +   Agrege(ikl) *G1snSV(ikl,i+1))
+            G2snSV(ikl,i) = (1.-staggr     )*G2snSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*G2snSV(ikl,i  )
+     .                      +   Agrege(ikl) *G2snSV(ikl,i+1))
+            agsnSV(ikl,i) = (1.-staggr     )*agsnSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*agsnSV(ikl,i  )
+     .                      +   Agrege(ikl) *agsnSV(ikl,i+1))
+        END DO
+        END DO
+ 
+        DO ikl=1,knonv
+          isn             = min(isnoSV(ikl) +1,nsno)
+          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
+          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
+          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
+          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
+          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
+          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
+          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
+        END DO
+ 
+
+ 
+ 
+C +--Constrains Splitting          of too thick Layers
+C +  =================================================
+ 
+ 
+C +--Search the thickest non-zero Layer
+C +  ----------------------------------
+ 
+        DO ikl=1,knonv
+          dzthin(ikl) =   0.                            ! Arbitrary unrealistic
+        END DO
+      DO ikl=1,knonv
+        DO   isn=1,isnoSV(ikl)
+          isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
+          iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
+          iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
+          dz_dif    =(      dzsnSV(ikl,isn)             ! Actual      Profile
+     .        - dz_max *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+     .                 +    iiceOK *2.   **iice_n)  )   !
+     .                 /max(dzsnSV(ikl,isn),epsi)       !
+          OKthin      = max(zero,                       !
+     .                      sign(unun,                  !
+     .                           dz_dif-dzthin(ikl)))   ! 1.=>New thickest Lay.
+     .                * max(0,                          ! 1 =>.le. isnoSV
+     .                  min(1,                          !
+     .                      isnoSV(ikl)-isn +1 ))       !
+          i_thin(ikl) =    (1. - OKthin)  * i_thin(ikl) !  Update thickest Lay.
+     .                         + OKthin   * isn         !                Index
+          dzthin(ikl) =    (1. - OKthin)  * dzthin(ikl) !
+     .                         + OKthin   * dz_dif      !
+        END DO
+ 
+        isn=max(1,isnoSV(ikl)-3)
+        if(dzsnSV(ikl,isn)>0.30) then   ! surface layer > 30cm
+         i_thin(ikl) = isn              ! XF 04/07/2019
+         dzthin(ikl) = dzsnSV(ikl,isn)
+        endif
+ 
+        isn=max(1,isnoSV(ikl)-2)
+        if(dzsnSV(ikl,isn)>0.10) then   ! surface layer > 10cm
+         i_thin(ikl) = isn              ! XF 04/07/2019
+         dzthin(ikl) = dzsnSV(ikl,isn)
+        endif
+ 
+        isn=max(1,isnoSV(ikl)-1)
+        if(dzsnSV(ikl,isn)>0.05) then   ! surface layer > 5cm
+         i_thin(ikl) = isn              ! XF 04/07/2019
+         dzthin(ikl) = dzsnSV(ikl,isn)
+        endif
+ 
+        isn=max(1,isnoSV(ikl))
+        if(dzsnSV(ikl,isn)>0.02) then   ! surface layer > 2cm
+         i_thin(ikl) = isn              ! XF 04/07/2019
+         dzthin(ikl) = dzsnSV(ikl,isn)
+        endif
+ 
+      END DO
+ 
+      DO   ikl=1,knonv
+          ThickL      = max(zero,                       ! 1. => a too   thick
+     .                      sign(unun,dzthin(ikl)       !         Layer exists
+     .                               -epsi       ))     !
+     .        * max(0,1-max(0   ,     isnoSV(ikl)       ! No spliting allowed
+     .                               -nsno+1     ))     ! if isno > nsno - 1
+          Agrege(ikl) =               ThickL            ! 1. => effective split
+     .        * max(0,1-max(0   ,     NLaysv(ikl)       !
+     .                               +isnoSV(ikl)       !
+     .                               -nsno+1     ))     !
+          NLay_s(ikl) =               ThickL            ! Agregation
+     .        * max(0,1-max(0   ,     NLaysv(ikl)       ! to allow  Splitting
+     .                               +isnoSV(ikl)       !   at next Time Step
+     .                               -nsno       ))     !
+     .                               -Agrege(ikl)       !
+          NLay_s(ikl) = max(0   ,     NLay_s(ikl))      ! Agregation effective
+      END DO
+ 
+
+C +--Rearranges the Layers
+C +  ---------------------
+ 
+      DO isn=nsno,2,-1
+      DO ikl=1,knonv
+        IF (Agrege(ikl).gt.0..AND.i_thin(ikl).lt.isnoSV(ikl))       THEN
+          staggr          =  min(1,max(0,isn-i_thin(ikl)    -1))
+     .                    *  min(1,max(0,    isnoSV(ikl)-isn+2))
+          istoSV(ikl,isn) =        staggr  * istoSV(ikl ,isn-1)
+     .                    + (1. -  staggr) * istoSV(ikl ,isn  )
+          dzsnSV(ikl,isn) =        staggr  * dzsnSV(ikl ,isn-1)
+     .                    + (1. -  staggr) * dzsnSV(ikl ,isn  )
+          TsisSV(ikl,isn) =        staggr  * TsisSV(ikl ,isn-1)
+     .                    + (1. -  staggr) * TsisSV(ikl ,isn  )
+          ro__SV(ikl,isn) =        staggr  * ro__SV(ikl ,isn-1)
+     .                    + (1. -  staggr) * ro__SV(ikl ,isn  )
+          eta_SV(ikl,isn) =        staggr  * eta_SV(ikl ,isn-1)
+     .                    + (1. -  staggr) * eta_SV(ikl ,isn  )
+          G1snSV(ikl,isn) =        staggr  * G1snSV(ikl ,isn-1)
+     .                    + (1. -  staggr) * G1snSV(ikl ,isn  )
+          G2snSV(ikl,isn) =        staggr  * G2snSV(ikl ,isn-1)
+     .                    + (1. -  staggr) * G2snSV(ikl ,isn  )
+          agsnSV(ikl,isn) =        staggr  * agsnSV(ikl ,isn-1)
+     .                    + (1. -  staggr) * agsnSV(ikl ,isn  )
+        END IF
+      END DO
+      END DO
+ 
+      DO  ikl=1,knonv
+          isn             =     i_thin(ikl)
+          dzsnSV(ikl,isn) = 0.5*Agrege(ikl) *dzsnSV(ikl,isn)
+     .                    + (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+ 
+          isn             = min(i_thin(ikl) +1,nsno)
+          istoSV(ikl,isn) =     Agrege(ikl) *istoSV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*istoSV(ikl,isn)
+          dzsnSV(ikl,isn) =     Agrege(ikl) *dzsnSV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+          TsisSV(ikl,isn) =     Agrege(ikl) *TsisSV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*TsisSV(ikl,isn)
+          ro__SV(ikl,isn) =     Agrege(ikl) *ro__SV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*ro__SV(ikl,isn)
+          eta_SV(ikl,isn) =     Agrege(ikl) *eta_SV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*eta_SV(ikl,isn)
+          G1snSV(ikl,isn) =     Agrege(ikl) *G1snSV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*G1snSV(ikl,isn)
+          G2snSV(ikl,isn) =     Agrege(ikl) *G2snSV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*G2snSV(ikl,isn)
+          agsnSV(ikl,isn) =     Agrege(ikl) *agsnSV(ikl,isn-1)
+     .                    + (1.-Agrege(ikl))*agsnSV(ikl,isn)
+          isnoSV(ikl)     = min(Agrege(ikl) +isnoSV(ikl),real(nsno))
+          iiceSV(ikl)     =                  iiceSV(ikl)
+     .                    +     Agrege(ikl) *max(0,sign(1,iiceSV(ikl)
+     .                                                   -isn +icemix))
+     .                                      *max(0,sign(1,iiceSV(ikl)
+     .                                                   -1          ))
+      END DO
+ 
+ 
+C +--Constrains Agregation in case of too much  Layers
+C +  =================================================
+ 
+C +--Search the thinest   non-zero Layer
+C +  -----------------------------------
+
+
+ 
+        DO ikl=1,knonv
+          dzthin(ikl) =   0.                            ! Arbitrary unrealistic
+        END DO                                          !       Layer Thickness
+      DO ikl=1,knonv
+        DO isn=1,isnoSV(ikl)-3 ! no agregation of 3 first snowlayers
+                               ! XF 04/07/2019
+ 
+          isno_n    =             isnoSV(ikl)-isn+1     ! Snow Normal.Profile
+          iice_n    =             iiceSV(ikl)-isn       ! Ice  Normal.Profile
+          iiceOK    = min(1,max(0,iice_n         +1))   ! Ice         Switch
+! #vz     dz_ref(isn) =                                 !
+! #vz.          dz_min *((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+! #vz.                 +    iiceOK *    2**iice_n)      !
+! #vz.               /max(1,isnoSV(ikl))                !
+          dz_dif      =     dz_min                      ! Actual      Profile
+     .                    - dzsnSV(ikl    ,isn)         !
+     .        /max(epsi,((1-iiceOK)*isno_n*isno_n       ! Theoretical Profile
+     .                 +    iiceOK *2.   **iice_n))     !
+! #vz     dzwdif(isn) =     dz_dif                      !
+          OKthin      = max(zero,                       !
+     .                      sign(unun,                  !
+     .                           dz_dif  - dzthin(ikl)))! 1.=> New thinest Lay.
+     .                * max(0,                          ! 1 => .le. isnoSV
+     .                  min(1,                          !
+     .                      isnoSV(ikl)-isn +1 ))       !
+          i_thin(ikl) =    (1. - OKthin) * i_thin(ikl)  ! Update   thinest Lay.
+     .                         + OKthin  * isn          !                Index
+          dzthin(ikl) =    (1. - OKthin) * dzthin(ikl)  !
+     .                         + OKthin  * dz_dif       !
+
+
+        END DO
+      END DO
+ 
+ 
+
+
+
+C +--Index of the contiguous Layer to agregate
+C +  -----------------------------------------
+ 
+C +   ***************
+      call SISVAT_zCr
+C +   ***************
+ 
+ 
+C +--Assign the 2 Layers to agregate
+C +  -------------------------------
+ 
+        DO ikl=1,knonv
+          isn         =    i_thin(ikl)
+          if(LIndsv(ikl)>0) isn=min(isn, nsno-1) !cXF
+          isagr1(ikl) =    istoSV(ikl,isn)
+          isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
+          dzagr1(ikl) =    dzsnSV(ikl,isn)
+          dzagr2(ikl) =    dzsnSV(ikl,isn+LIndsv(ikl))
+          T_agr1(ikl) =    TsisSV(ikl,isn)
+          T_agr2(ikl) =    TsisSV(ikl,isn+LIndsv(ikl))
+          roagr1(ikl) =    ro__SV(ikl,isn)
+          roagr2(ikl) =    ro__SV(ikl,isn+LIndsv(ikl))
+          etagr1(ikl) =    eta_SV(ikl,isn)
+          etagr2(ikl) =    eta_SV(ikl,isn+LIndsv(ikl))
+          G1agr1(ikl) =    G1snSV(ikl,isn)
+          G1agr2(ikl) =    G1snSV(ikl,isn+LIndsv(ikl))
+          G2agr1(ikl) =    G2snSV(ikl,isn)
+          G2agr2(ikl) =    G2snSV(ikl,isn+LIndsv(ikl))
+          agagr1(ikl) =    agsnSV(ikl,isn)
+          agagr2(ikl) =    agsnSV(ikl,isn+LIndsv(ikl))
+          LstLay      = min(1,max(  0,    isnoSV(ikl)-1   ))
+          Agrege(ikl) = min(1,
+     .                  max(0,
+     .                      NLaysv(ikl)   +isnoSV(ikl)-nsno
+     .                     +NLay_s(ikl)                    )
+     .                                    *LstLay           )
+ 
+C + minimum uppermost layer thickness to guarantee a correct reproduction of the snow
+C + atmosphere coupling
+        if(dzsnSV(ikl,max(1,isnoSV(ikl)-0))>0.02 .or.   ! surface layers> 2-5-10
+     .     dzsnSV(ikl,max(1,isnoSV(ikl)-1))>0.05 .or.   ! XF 04/07/2019
+     .     dzsnSV(ikl,max(1,isnoSV(ikl)-2))>0.10 .or.
+     .     dzsnSV(ikl,max(1,isnoSV(ikl)-3))>0.30 )then
+          Agrege(ikl) = min(1,
+     .                  max(0,
+     .                      NLaysv(ikl)   +isnoSV(ikl)+1-nsno ! nsno-1 layers ma
+     .                     +NLay_s(ikl)                    )
+     .                                    *LstLay           )
+        endif
+ 
+          isnoSV(ikl) =                    isnoSV(ikl)
+     .     -(1-LstLay)*max(zero,
+     .                     sign(unun,      eps_21
+     .                                    -dzsnSV(ikl,1)   ))
+          isnoSV(ikl) =max(   0,           isnoSV(ikl)      )
+ 
+          WEagre(ikl) = 0.
+        END DO
+ 
+        DO isn=1,nsno
+        DO ikl=1,knonv
+          WEagre(ikl) = WEagre(ikl) + ro__SV(ikl,isn)*dzsnSV(ikl,isn)
+     .                                *min(1,max(0,i_thin(ikl)+1-isn))
+        ENDDO
+        ENDDO
+
+C +--Agregates
+C +  ---------
+ 
+C +     ***************
+        call SISVAT_zAg
+     .                 (isagr1,isagr2,WEagre
+     .                 ,dzagr1,dzagr2,T_agr1,T_agr2
+     .                 ,roagr1,roagr2,etagr1,etagr2
+     .                 ,G1agr1,G1agr2,G2agr1,G2agr2
+     .                 ,agagr1,agagr2,Agrege
+     .                 )
+C +     ***************
+ 
+ 
+C +--Rearranges the Layers
+C +  ---------------------
+ 
+C +--New (agregated) Snow layer
+C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+        DO ikl=1,knonv
+          isn     =             i_thin(ikl)
+          isn     = min(isn,isn+LIndsv(ikl))
+          isnoSV(ikl) =  max(0.,isnoSV(ikl) -Agrege(ikl))
+          iiceSV(ikl) =         iiceSV(ikl)
+     .            -max(0,sign(1,iiceSV(ikl) -isn +icemix))
+     .                                      *Agrege(ikl)
+     .            *max(0,sign(1,iiceSV(ikl) -1          ))
+          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
+     .                      +   Agrege(ikl) *isagr1(ikl)
+          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+     .                      +   Agrege(ikl) *dzagr1(ikl)
+          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
+     .                      +   Agrege(ikl) *T_agr1(ikl)
+          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
+     .                      +   Agrege(ikl) *roagr1(ikl)
+          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
+     .                      +   Agrege(ikl) *etagr1(ikl)
+          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
+     .                      +   Agrege(ikl) *G1agr1(ikl)
+          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
+     .                      +   Agrege(ikl) *G2agr1(ikl)
+          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
+     .                      +   Agrege(ikl) *agagr1(ikl)
+        END DO
+ 
+C +--Above
+C +  ^^^^^
+        DO ikl=1,knonv
+          isn1(ikl)=max(i_thin(ikl),i_thin(ikl)+LIndsv(ikl))
+        END DO
+        DO i=  1,nsno-1
+        DO ikl=1,knonv
+            staggr        =  min(1,max(0,i +1 -isn1(ikl)   ))
+            istoSV(ikl,i) = (1.-staggr     )*istoSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*istoSV(ikl,i  )
+     .                      +   Agrege(ikl) *istoSV(ikl,i+1))
+            dzsnSV(ikl,i) = (1.-staggr     )*dzsnSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*dzsnSV(ikl,i  )
+     .                      +   Agrege(ikl) *dzsnSV(ikl,i+1))
+            TsisSV(ikl,i) = (1.-staggr     )*TsisSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*TsisSV(ikl,i  )
+     .                      +   Agrege(ikl) *TsisSV(ikl,i+1))
+            ro__SV(ikl,i) = (1.-staggr     )*ro__SV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*ro__SV(ikl,i  )
+     .                      +   Agrege(ikl) *ro__SV(ikl,i+1))
+            eta_SV(ikl,i) = (1.-staggr     )*eta_SV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*eta_SV(ikl,i  )
+     .                      +   Agrege(ikl) *eta_SV(ikl,i+1))
+            G1snSV(ikl,i) = (1.-staggr     )*G1snSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*G1snSV(ikl,i  )
+     .                      +   Agrege(ikl) *G1snSV(ikl,i+1))
+            G2snSV(ikl,i) = (1.-staggr     )*G2snSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*G2snSV(ikl,i  )
+     .                      +   Agrege(ikl) *G2snSV(ikl,i+1))
+            agsnSV(ikl,i) = (1.-staggr     )*agsnSV(ikl,i  )
+     .            + staggr*((1.-Agrege(ikl))*agsnSV(ikl,i  )
+     .                      +   Agrege(ikl) *agsnSV(ikl,i+1))
+        END DO
+        END DO
+ 
+        DO ikl=1,knonv
+          isn             = min(isnoSV(ikl) +1,nsno)
+          istoSV(ikl,isn) = (1.-Agrege(ikl))*istoSV(ikl,isn)
+          dzsnSV(ikl,isn) = (1.-Agrege(ikl))*dzsnSV(ikl,isn)
+          TsisSV(ikl,isn) = (1.-Agrege(ikl))*TsisSV(ikl,isn)
+          ro__SV(ikl,isn) = (1.-Agrege(ikl))*ro__SV(ikl,isn)
+          eta_SV(ikl,isn) = (1.-Agrege(ikl))*eta_SV(ikl,isn)
+          G1snSV(ikl,isn) = (1.-Agrege(ikl))*G1snSV(ikl,isn)
+          G2snSV(ikl,isn) = (1.-Agrege(ikl))*G2snSV(ikl,isn)
+          agsnSV(ikl,isn) = (1.-Agrege(ikl))*agsnSV(ikl,isn)
+        END DO
+
+ 
+      return
+      end
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/surf_inlandsis_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 3851)
@@ -0,0 +1,1454 @@
+MODULE surf_inlandsis_mod
+
+  IMPLICIT NONE
+
+ 
+  CONTAINS
+
+                                       
+
+  SUBROUTINE surf_inlandsis(knon,rlon,rlat, ikl2i, itime, dtime, debut, lafin, &
+             rmu0, swdown, lwdown, albedo_old, pexner, ps, p1lay, &
+             precip_rain, precip_snow, precip_snow_adv, snow_adv, &
+             zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf, &
+             rugos, snow_cont_air, alb_soil, slope, cloudf, &
+             radsol, qsol, tsoil, snow, zfra, snowhgt, qsnow, to_ice, sissnow, agesno, & 
+             AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
+             runoff_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &      
+             tsurf_new, alb1, alb2, alb3, &
+             emis_new, z0m, z0h, qsurf)       
+                                                                             
+! +------------------------------------------------------------------------+   
+! |                                                                        |   
+! |   SubRoutine surf_inlandsis: Interfacing Lmdz AND Sisvat's Ice and Snow|
+! |                              (INLANDSIS)                               |
+! |   SISVAT (Soil/Ice Snow Vegetation Atmosphere Transfer Scheme)         |   
+! |   surface scheme of the Modele Atmospherique Regional (MAR)            |
+! |   Author: Heinz Juergen Punge, LSCE                June 2009           |
+! |     based on the MAR-SISVAT interface by Hubert Gallee                 |
+! |           Update Etienne Vignon, LMD, Novembre 2020                    |
+! |                                                                        |   
+! +------------------------------------------------------------------------+   
+! |   
+! |   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                                                                |  
+! |             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             |   
+! +------------------------------------------------------------------------+ 
+        
+    USE dimphy                                            
+    USE VAR_SV 
+    USE VARdSV 
+    USE VARxSV 
+    USE VARySV
+    USE VARtSV
+    USE VARphy
+    USE surface_data, only: iflag_tsurf_inlandsis,SnoMod,BloMod,ok_outfor                                       
+
+    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)      :: albedo_old    
+    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)      :: zsl_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)      :: cdragm, cdragh
+    REAL, DIMENSION(klon), INTENT(IN)      :: ustar   ! friction velocity
+
+! Variables exchanged between LMDZ and SISVAT
+    REAL, DIMENSION(klon), INTENT(IN)      :: radsol    ! Surface absorbed rad.
+    REAL, DIMENSION(klon), INTENT(INOUT)   :: snow      ! Tot snow mass [kg/m2]
+    REAL, DIMENSION(klon), INTENT(INOUT)   :: zfra      ! snwo surface fraction [0-1]
+    REAL, DIMENSION(klon,nsoilmx), INTENT(OUT) :: tsoil ! Soil Temperature 
+    REAL, DIMENSION(klon), INTENT(OUT)       :: qsol      ! Soil Water Content  
+    REAL, DIMENSION(klon), INTENT(INOUT)     :: z0m    ! Momentum Roughn Lgt
+    REAL, DIMENSION(klon), INTENT(INOUT)     :: z0h    ! Momentum Roughn Lgt 
+
+
+! Output Variables for LMDZ
+    REAL, DIMENSION(klon), INTENT(OUT)     :: alb1      ! Albedo SW 
+    REAL, DIMENSION(klon), INTENT(OUT)     :: alb2,alb3 ! Albedo NIR and LW
+    REAL, DIMENSION(klon), INTENT(OUT)     :: emis_new  ! Surface Emissivity
+    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 
+
+! Specific INLANDIS outputs
+
+    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)
+
+                                                                          
+
+                                                                    
+! +--Internal  Variables                                                       
+! +  ===================                                          
+
+    CHARACTER(len=20)               :: 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,dz2)
+    LOGICAL, SAVE                   :: firstcall
+!$OMP THREADPRIVATE(firstcall)                
+
+               
+                                        
+! +--Internal Variables
+! +  ==================
+
+    INTEGER                         ::  iso
+    LOGICAL                         ::  file_exists
+    CHARACTER(len=20)               ::  fichnom
+!========================================================================
+
+      PRINT*, 'je rentre dans inlandsis'
+
+      zsigma=1000.
+      dt__SV=dtime
+      
+    
+
+!     write(*,*)'Start of simulation? ',debut        !hj
+
+      IF (debut) THEN 
+        firstcall=.TRUE. 
+        INI_SV=.false.
+
+      ELSE
+        firstcall=.false.
+        INI_SV=.true.
+      END IF
+
+
+
+
+       IF (ok_outfor) THEN
+        un_outfor=51                 ! unit number for point output file
+        gp_outfor= 1        ! grid point number for point output
+        fn_outfor='outfor_SV.dat'
+       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,'nsol',nsol,'nsno',nsno
+
+
+        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
+
+        END DO
+
+
+
+
+        DO ikl=1,knon     
+
+
+! Initialise variables
+          
+          ispiSV(ikl)             = 0 
+          iiceSV(ikl)             = 0  
+          rusnSV(ikl)             = 0.   
+          toicSV(ikl)             = 0.     
+          isnoSV(ikl)             = 0.       ! # snow layers                            
+          istoSV(ikl,:)           = 0. 
+          eta_SV(ikl,:)           = 0.     
+          TsisSV(ikl,:)           = 0.
+          ro__SV(ikl,:)           = 0.        
+          G1snSV(ikl,:)           = 0.  
+          G2snSV(ikl,:)           = 0. 
+          agsnSV(ikl,:)           = 0. 
+          dzsnSV(ikl,:)           = 0. 
+          zzsnsv(ikl,:)           = 0.                                           
+          BufsSV(ikl)             = 0.    
+          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 
+          RRs_SV(ikl)             = 0.
+          DDs_SV(ikl)             = 0.
+          VVs_SV(ikl)             = 0.
+          cld_SV(ikl)             = 0.      
+          uts_SV(ikl)             = 0.     ! u*T*  arbitrary  
+          uqs_SV(ikl)             = 0.     ! u*q*    " 
+          uss_SV(ikl)             = 0.     ! u*s*    "
+          LMO_SV(ikl)             = 0.
+
+
+! Set variables 
+
+          LSmask(ikl) = 1                          ! Land/Sea   Mask    
+          isotSV(ikl) = 12                         ! Soil       Type  -> 12= ice  
+          iWaFSV(ikl) = 1                          ! Soil Drainage                                     
+          eps0SL(ikl )= 1.
+          alb0SV(ikl) = alb_soil(ikl)                 ! Soil Albedo        
+          Z0m_SV(ikl) = z0m(ikl)                      ! Moment.Roughn.L.
+          Z0h_SV(ikl) = z0h(ikl)                      ! heat Roughn.L.
+
+! + Soil Upward IR Flux, Water Fluxes, roughness length  
+          IRs_SV(ikl) =                               &
+              -eps0SL(ikl)* StefBo*(temp_air(ikl)**4)   ! Upward IR Flux    
+          Tsf_SV(ikl) = min(temp_air(ikl),TfSnow)       
+          
+! + Soil
+        DO isl =   -nsol,0    
+          TsisSV(ikl,isl) = min(tsoil(ikl,1+nsol),TfSnow-0.2)   !temp_air(ikl)  !tsoil(ikl,1-isl)   Soil Temperature
+          !TsisSV(ikl,isl) = min(temp_air(ikl),TfSnow-0.2)
+          eta_SV(ikl,isl) = epsi                        !etasoil(ikl,1-isl) Soil Water[m3/m3]
+          ro__SV(ikl,isl) = rhoIce                         !rosoil(ikl,1-isl)  volumic mass
+        END DO      
+
+
+
+!! Initialise with snow
+          !  G1snSV(ikl,0)          = 0.                   !      [-]     
+          !  G2snSV(ikl,0)          = 1.6                  ! [-] [0.0001 m] 
+          !  dzsnSV(ikl,0)          = dz_dSV(0)            !           [m] 
+
+
+          ! if (snow(ikl) .GT. 0.) then
+          !   isnoSV(ikl)             = 1       ! snow layers                            
+          !   istoSV(ikl,1:nsno)      = 0     ! 0,...,5 :   Snow     History (see istdSV data)
+          !   eta_SV(ikl,1:nsno)      = epsi     
+          !   TsisSV(ikl,1:nsno)      = tsoil(ikl,1)         
+          !   ro__SV(ikl,1:nsno)      = 350.0       
+          !   G1snSV(ikl,1:nsno)      = 0.   !      [-]  
+          !   G2snSV(ikl,1:nsno)      = 1.6   !     [-] [0.0001 m] 
+          !   agsnSV(ikl,1:nsno)      = 50.   !          [day] 
+          !   dzsnSV(ikl,1)           = snow(ikl)/max(ro__SV(ikl,1),epsi) ![m] 
+! ! ecrete si trop de neige:
+!              IF (snow(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
+!            zzsnsv(ikl,1)      =  dzsnSV(ikl,1)                    ! Total snow pack thickness
+!          endif
+
+
+! Initialise la neige avec un profil de densité prochde des conditions de Dôme C (~10m de neige avec 19 niveaux) (Etienne):
+          isnoSV(ikl)                    = 19
+          istoSV(ikl,1:isnoSV(ikl))      = 100
+          ro__SV(ikl,1:isnoSV(ikl))      = 350.      
+          eta_SV(ikl,1:isnoSV(ikl))      = epsi
+          TsisSV(ikl,1:isnoSV(ikl))      = min(tsoil(ikl,1),TfSnow-0.2)
+          G1snSV(ikl,1:isnoSV(ikl))      = 0
+          G2snSV(ikl,1:isnoSV(ikl))      = 1.6 
+          agsnSV(ikl,1:isnoSV(ikl))      = 50.    
+          dzsnSV(ikl,19)                  = 0.015
+          dzsnSV(ikl,18)                  =0.015
+          dzsnSV(ikl,17)                  =0.020
+          dzsnSV(ikl,16)                  =0.030
+          dzsnSV(ikl,15)                  =0.040
+          dzsnSV(ikl,14)                  =0.060
+          dzsnSV(ikl,13)                  =0.080
+          dzsnSV(ikl,12)                  =0.110
+          dzsnSV(ikl,11)                  =0.150
+          dzsnSV(ikl,10)                  =0.200
+          dzsnSV(ikl,9)                   =0.300
+          dzsnSV(ikl,8)                   =0.420
+          dzsnSV(ikl,7)                   =0.780
+          dzsnSV(ikl,6)                   =1.020
+          dzsnSV(ikl,5)                   =0.980
+          dzsnSV(ikl,4)                   =1.020
+          dzsnSV(ikl,3)                   =3.970
+          dzsnSV(ikl,2)                   =1.020
+          dzsnSV(ikl,1)                   =0.100
+
+
+        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                            
+
+! + SISVAT_ini (as for use with MAR, but not computing soil layers)
+! + -------------------------------------------------------------
+!        write(*,'(/a)') 'Start SISVAT initialization: SISVAT_ini' 
+        CALL SISVAT_ini(knon)
+
+
+! +--Read restart file
+! +  =================================================   
+        
+        INQUIRE(FILE="startsis.nc", EXIST=file_exists)
+        IF (file_exists) THEN
+        CALL sisvatetat0("startsis.nc",ikl2i)
+        END IF
+        
+        
+        
+! +--Output ascii file
+! +  =================================================   
+               
+        
+        
+        ! open output file 
+        IF (ok_outfor) THEN
+          open(unit=un_outfor,status='replace',file=fn_outfor)         
+          ikl=gp_outfor     ! index sur la grille land ice
+          write(un_outfor,*) fn_outfor, ikl, dt__SV   
+          write(un_outfor,*) 'nsnow - albedo - z0m - z0h , dz [m,35], temp [K,46], rho [kg/m3,46], eta [kg/kg,46] &
+           & G1 [-,35], G2 [-,35], agesnow [d,35], history [-,35]'
+
+        END IF
+ 
+      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) = zsl_height(ikl)               ! surface layer height (fisr model level) [m]
+        Ua_min      = epsi                          !
+        Ua_min      = 0.2 * sqrt(za__SV(ikl)   )    !                    
+        VV__SV(ikl) = max(Ua_min, wind_velo(ikl))   ! Wind velocity       [m/s]
+        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 
+        ps__SV(ikl) = ps(ikl)                       ! surface pressure     [Pa]
+        p1l_SV(ikl) = p1lay(ikl)                    ! lowest atm. layer press[Pa]
+
+! +--Surface properties
+! +  ^^^^^^^^^^^^^^^^^^
+
+        Z0m_SV(ikl) = z0m(ikl)                      ! Moment.Roughn.L.
+        Z0h_SV(ikl) = z0h(ikl)                      ! Moment.Roughn.L.
+
+! +--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.   
+
+! +--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/BL                                      (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)     
+        cdM_SV(ikl) = cdragm(ikl)     
+        Us_min      = 0.01
+        us__SV(ikl) = max(Us_min, ustar(ikl)) 
+        ram_sv(ikl) = 1./(cdragm(ikl)*max(VV__SV(ikl),eps6))
+        rah_sv(ikl) = 1./(cdragh(ikl)*max(VV__SV(ikl),eps6))   
+
+! +--Energy Fluxes                                          (INPUT/OUTPUT)    
+! +  ^^^^^^^^^^^^^                                           ^^^^^^^^^^^^    
+        IF (.not.firstcall) THEN  
+        Tsf_SV(ikl) = tsurf(ikl)                     !hj 12 03 2010
+        cld_SV(ikl) = cloudf(ikl)                    ! Cloudiness         
+        END IF
+ 
+
+      END DO
+
+!                            
+! +  +++  READ FORCINGS:  END  +++    
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! +--SISVAT EXECUTION                                                          
+! +  ----------------                                                          
+
+      call  INLANDSIS(SnoMod,BloMod,1) 
+
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! + 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)/LHvH2O  ! Evaporation  
+        snow(ikl)          = 0.
+        snowhgt(ikl)       = 0.
+        qsnow(ikl)         = 0.
+        qsol(ikl)          = 0. 
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! +
+! +   Check snow thickness,  substract if too thick   (commended by etienne: add if too thin) 
+
+        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)      = 0
+!         ro__SV(ikl,1)      = 350.      
+!         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)      = 0.
+!         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
+
+        ! Etienne: pourquoi ajouter toicSV ici? Pour bilan d'eau?
+        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)     =Tsrfsv(ikl)
+
+        zfra(ikl)          = max(min(isnoSV(ikl)-iiceSV(ikl),1),0)
+        qsurf(ikl)         = QaT_SV(ikl) 
+        emis_new(ikl)      = eps0SL(ikl)  
+        z0m(ikl)           = Z0m_SV(ikl) 
+        z0h(ikl)           = Z0h_SV(ikl) 
+
+      END DO  ! ikl
+      
+
+
+
+
+
+! write variables in output file
+
+      IF (ok_outfor) THEN
+        ikl=gp_outfor
+
+!        write(un_outfor,*) 'nsnow [-,1], dz [m,35], temp [K,46], rho [kg/m3,46], eta [kg/kg,46]'
+!        write(un_outfor,*) 'G1 [-,35], G2 [-,35], agesnow [d,35], history [-,35]'
+        write(un_outfor,*) '+++++++++++++++++++++++++++++++++++++++++++++++'
+        write(un_outfor,*) isnoSV(ikl), alb_SV(ikl), Z0m_SV(ikl), Z0h_SV(ikl)
+        write(un_outfor,*) dzsnSV(ikl,:)
+        write(un_outfor,*) TsisSV(ikl,:)
+        write(un_outfor,*) ro__SV(ikl,:)
+        write(un_outfor,*) eta_SV(ikl,:)
+        write(un_outfor,*) G1snSV(ikl,:)
+        write(un_outfor,*) G2snSV(ikl,:)
+        write(un_outfor,*) agsnSV(ikl,:)
+        write(un_outfor,*) istoSV(ikl,:)
+       
+      ENDIF
+
+
+
+
+! +  -----------------------------                              
+! +  END --- RETURN RESULTS    
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+      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 SUBROUTINE surf_inlandsis
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+!=======================================================================
+
+  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
+    USE VAR_SV 
+
+
+!    INCLUDE "dimsoil.h"
+
+    REAL, DIMENSION(nsoilmx), INTENT(OUT) :: dz2, dz1
+    REAL, INTENT(OUT)                     :: lambda
+
+
+!-----------------------------------------------------------------------
+!   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:             [-] |  
+!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 dimphy
+      USE VARphy                                           
+      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   ,ikl   ,isl   ,isn   ,ikh               
+      INTEGER ::  misl_2,nisl_2                                              
+      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.https://www.lequipe.fr/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)  
+        dtz_SV2(isl) =        1.            /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))                                                              
+        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 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                                                          
+ 
+                                                                             
+          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   !                         
+               
+          eta__1          = eta__1  + d__eta                              
+          eta__2          = eta__2  + d__eta                              
+        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 indice_sol_mod
+
+      IMPLICIT none
+!======================================================================
+! Auteur(s) HJ PUNGE (LSCE) date: 07/2009
+! Objet: Lecture du fichier de conditions initiales pour SISVAT
+!======================================================================
+    include "netcdf.inc"
+!    include "indicesol.h"
+
+!    include "dimsoil.h"
+    include "clesphys.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
+
+
+    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
+
+
+
+      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
+
+
+      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.   
+                                                                              
+
+            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-0.2              ! Etienne: negative temperature since soil is ice
+              ENDIF
+
+            END DO        
+            write(*,*)'Copy histo', ikl
+    
+   
+            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]         
+              agsnSV(ikl,isn) = agsn(i,isn)          !          [day]     
+            END DO  
+              rusnSV(ikl)     = rusn(i)              ! Surficial Water    
+              toicSV(ikl)     = toic(i)              ! bilan snow to ice   
+          END IF                       
+        END DO    
+
+    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 indice_sol_mod
+    USE dimphy
+
+
+    IMPLICIT none
+
+    include "netcdf.inc"
+!    include "indicesol.h" 
+!    include "dimsoil.h"
+    include "clesphys.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
+
+    INTEGER isl, ikl, i, isn, ierr
+    CHARACTER (len=2) :: str2
+    INTEGER           :: pass
+
+      isno(:)       = 0       
+      ispi(:)       = 0 
+      iice(:)       = 0                                
+      IRs(:)        = 0.
+      LMO(:)        = 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
+           
+
+      print*, 'je rentre dans restart inlandsis'     
+      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)                             
+
+
+        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)                  ! to ice 
+        alb1(i)       = alb1sv(ikl) 
+        alb2(i)       = alb2sv(ikl)
+        alb3(i)       = alb3sv(ikl)
+!        Bufs(i)       = BufsSV(ikl)      
+      END IF                     
+      END DO                                                
+
+
+      print*, 'je call open_restart'     
+
+      CALL open_restartphy(fichnom)
+
+      print*, 'je sors open_restart'     
+
+
+      DO pass = 1, 2
+        CALL put_field(pass,"longitude", &
+                    "Longitudes de la grille physique",rlon)     
+        CALL put_field(pass,"latitude","Latitudes de la grille physique",rlat)
+  
+        CALL put_field(pass,"n_snows", "number of snow/ice layers",isno)
+        CALL put_field(pass,"n_ice_top", "number of top ice layers",ispi)
+        CALL put_field(pass,"n_ice", "number of ice layers",iice)
+        CALL put_field(pass,"IR_soil", "Soil IR flux",IRs)
+        CALL put_field(pass,"LMO", "Monin-Obukhov Scale",LMO)
+        CALL put_field(pass,"surf_water", "Surficial water",rusn)
+        CALL put_field(pass,"snow_buffer", "Snow buffer layer",Bufs)
+        CALL put_field(pass,"alb_1", "albedo sw",alb1)
+        CALL put_field(pass,"alb_2", "albedo nIR",alb2)
+        CALL put_field(pass,"alb_3", "albedo fIR",alb3)
+        CALL put_field(pass,"to_ice", "Snow passed to ice",toic)
+
+
+
+        DO isn = 1,nsno
+          IF (isn.LE.99) THEN
+            WRITE(str2,'(i2.2)') isn
+            CALL put_field(pass,"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(pass,"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(pass,"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(pass,"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(pass,"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(pass,"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(pass,"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(pass,"HISTORY"//str2, &
+                           "Snow history layer No."//str2, &
+                           isto(:,isn))
+          ELSE
+            PRINT*, "Trop de couches"
+            CALL abort
+          ENDIF
+        ENDDO
+
+      CALL enddef_restartphy
+      ENDDO
+      CALL close_restartphy
+
+
+  END SUBROUTINE sisvatredem
+
+END MODULE surf_inlandsis_mod
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/oasis.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/oasis.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/oasis.F90	(revision 3851)
@@ -59,7 +59,10 @@
   INTEGER, PARAMETER :: ids_qraiic = 28
   INTEGER, PARAMETER :: ids_qsnoic = 29
-  INTEGER, PARAMETER :: maxsend    = 29  ! Maximum number of fields to send
+  INTEGER, PARAMETER :: ids_delta_sst = 30, ids_delta_sal = 31
+  
+  INTEGER, PARAMETER :: maxsend    = 31  ! Maximum number of fields to send
   
   ! Id for fields received from ocean
+
   INTEGER, PARAMETER :: idr_sisutw = 1
   INTEGER, PARAMETER :: idr_icecov = 2
@@ -70,5 +73,9 @@
   INTEGER, PARAMETER :: idr_curenz = 7
   INTEGER, PARAMETER :: idr_oceco2 = 8
-  INTEGER, PARAMETER :: maxrecv    = 8  ! Maximum number of fields to receive
+
+  INTEGER, PARAMETER :: idr_sss = 9
+  ! bulk salinity of the surface layer of the ocean, in ppt
+
+  INTEGER, PARAMETER :: maxrecv    = 9  ! Maximum number of fields to receive
   
 
@@ -110,6 +117,5 @@
     USE geometry_mod, ONLY: ind_cell_glo                    
     USE mod_phys_lmdz_mpi_data, ONLY: klon_mpi_para_nb
-    
-
+    use config_ocean_skin_m, only: activate_ocean_skin
 
 ! Local variables
@@ -183,4 +189,11 @@
     infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN'
     
+    if (activate_ocean_skin == 2) then
+       infosend(ids_delta_sst)%action = .TRUE.
+       infosend(ids_delta_sst)%name = 'CODELSST'
+       infosend(ids_delta_sal)%action = .TRUE.
+       infosend(ids_delta_sal)%name = 'CODELSSS'
+    end if
+           
     IF (version_ocean=='nemo') THEN
         infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX'
@@ -219,4 +232,9 @@
    inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW'
    inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW'
+
+   if (activate_ocean_skin >= 1) then
+      inforecv(idr_sss)%action = .TRUE.
+      inforecv(idr_sss)%name = 'SISUSALW'
+   end if
    
    IF (cpl_current ) THEN
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_cpl_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_cpl_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_cpl_mod.F90	(revision 3851)
@@ -52,8 +52,9 @@
        AcoefH, AcoefQ, BcoefH, BcoefQ, &
        AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, &
+       ps, u1, v1, gustiness, tsurf_in, &
        radsol, snow, agesno, &
        qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l)
+       tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
+       delta_sst)
 
 !
@@ -63,9 +64,10 @@
 !
     USE dimphy,           ONLY : klon
-    USE cpl_mod
     USE calcul_fluxs_mod
     USE indice_sol_mod
     USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
-    USE cpl_mod,             ONLY : gath2cpl
+    USE cpl_mod, ONLY : gath2cpl, cpl_receive_ocean_fields, &
+         cpl_send_ocean_fields
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     INCLUDE "YOMCST.h"
@@ -90,4 +92,14 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: ps
     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
+    REAL, INTENT(IN) :: tsurf_in(:) ! (klon)
+
+    real, intent(in):: delta_sal(:) ! (knon)
+    ! ocean-air interface salinity minus bulk salinity, in ppt
+
+    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
+
+    REAL, intent(in):: delta_sst(:) ! (knon)
+    ! Ocean-air interface temperature minus bulk SST, in K. Defined
+    ! only if activate_ocean_skin >= 1.
 
 ! In/Output arguments
@@ -104,4 +116,8 @@
     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
+    REAL, intent(out):: sens_prec_liq(:) ! (knon)
+
+    REAL, INTENT(OUT):: sss(:) ! (klon)
+    ! bulk salinity of the surface layer of the ocean, in ppt
   
 
@@ -116,5 +132,5 @@
     REAL, DIMENSION(klon) :: u1_lay, v1_lay
     LOGICAL               :: check=.FALSE.
-    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol    
+    REAL sens_prec_sol(knon)  
     REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
 
@@ -128,5 +144,6 @@
 !
 !****************************************************************************************
-    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
+    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
+         sss)
 
 !****************************************************************************************
@@ -138,5 +155,5 @@
     dif_grnd = 0.
     agesno(:) = 0.
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
+    lat_prec_liq = 0.; lat_prec_sol = 0.
     
 
@@ -147,10 +164,20 @@
 
     CALL calcul_fluxs(knon, is_oce, dtime, &
-         tsurf_cpl, p1lay, cal, beta, cdragh, cdragq, ps, &
+         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
+         beta, cdragh, cdragq, ps, &
          precip_rain, precip_snow, snow, qsurf,  &
          radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
+         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
+
+    if (activate_ocean_skin == 2) then
+       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
+       ! the new bulk SST tsurf_cpl:
+       tsurf_new = tsurf_cpl
+    end if
+
+    ! assertion: tsurf_new == tsurf_cpl
+    
     do j = 1, knon
       i = knindex(j)
@@ -189,9 +216,8 @@
 !****************************************************************************************
 
-    CALL cpl_send_ocean_fields(itime, knon, knindex, &
-         swnet, lwnet, fluxlat, fluxsens, &
-         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp,&
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
-    
+    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
+         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
+         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
+         lat_prec_sol, delta_sst, delta_sal)
 
   END SUBROUTINE ocean_cpl_noice
@@ -210,5 +236,5 @@
        radsol, snow, qsurf, &
        alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l)
+       tsurf_new, dflux_s, dflux_l, rhoa)
 !
 ! This subroutine treats the ocean where there is ice. The subroutine first receives 
@@ -245,4 +271,5 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
     REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
+    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 
 ! In/output arguments
@@ -272,5 +299,5 @@
     REAL, DIMENSION(klon)   :: u0, v0
     REAL, DIMENSION(klon)   :: u1_lay, v1_lay
-    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol    
+    REAL sens_prec_liq(knon), sens_prec_sol(knon)   
     REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
 
@@ -280,5 +307,5 @@
     IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon 
 
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
+    lat_prec_liq = 0.; lat_prec_sol = 0.
 
 !****************************************************************************************
@@ -313,5 +340,5 @@
          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
+         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
     do j = 1, knon
       i = knindex(j)
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_forced_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_forced_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_forced_mod.F90	(revision 3851)
@@ -19,8 +19,8 @@
        AcoefH, AcoefQ, BcoefH, BcoefQ, &
        AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, &
+       ps, u1, v1, gustiness, tsurf_in, &
        radsol, snow, agesno, & 
        qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l)
+       tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa)
 !
 ! This subroutine treats the "open ocean", all grid points that are not entierly covered
@@ -35,8 +35,9 @@
     USE indice_sol_mod
     USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     INCLUDE "YOMCST.h"
     INCLUDE "clesphys.h"
-
+    INCLUDE "flux_arp.h"
 
 ! Input arguments
@@ -53,4 +54,6 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: ps
     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
+    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
+    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 
 ! In/Output arguments
@@ -67,4 +70,5 @@
     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
+    REAL, intent(out):: sens_prec_liq(:) ! (knon)
 
 ! Local variables
@@ -76,5 +80,5 @@
     REAL, DIMENSION(klon)       :: u1_lay, v1_lay
     LOGICAL                     :: check=.FALSE.
-    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol    
+    REAL sens_prec_sol(knon) 
     REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
 
@@ -92,5 +96,10 @@
 !!jyg    if (knon.eq.1) then ! single-column model
     if (klon_glo.eq.1) then ! single-column model
-      CALL read_tsurf1d(knon,tsurf_lim) ! new
+      ! EV: now surface Tin flux_arp.h
+      !CALL read_tsurf1d(knon,tsurf_lim) ! new
+       DO i = 1, knon
+        tsurf_lim(i) = tg
+       ENDDO
+
     else ! GCM
       CALL limit_read_sst(knon,knindex,tsurf_lim)
@@ -104,10 +113,18 @@
 !****************************************************************************************
 ! Set some variables for calcul_fluxs
-    cal = 0.
-    beta = 1.
-    dif_grnd = 0.
+    !cal = 0.
+    !beta = 1.
+    !dif_grnd = 0.
+    
+    
+    ! EV: use calbeta to calculate beta
+    ! Need to initialize qsurf for calbeta but it is not modified by this routine
+    qsurf(:)=0.
+    CALL calbeta(dtime, is_oce, knon, snow, qsurf, beta, cal, dif_grnd)
+
+
     alb_neig(:) = 0.
     agesno(:) = 0.
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
+    lat_prec_liq = 0.; lat_prec_sol = 0.
 
 ! Suppose zero surface speed
@@ -119,10 +136,12 @@
 ! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
     CALL calcul_fluxs(knon, is_oce, dtime, &
-         tsurf_lim, p1lay, cal, beta, cdragh, cdragq, ps, &
+         merge(tsurf_in, tsurf_lim, activate_ocean_skin == 2), p1lay, cal, &
+         beta, cdragh, cdragq, ps, &
          precip_rain, precip_snow, snow, qsurf,  &
          radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
+         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
+    if (activate_ocean_skin == 2) tsurf_new = tsurf_lim
 
     do j = 1, knon
@@ -154,5 +173,5 @@
        radsol, snow, qsol, agesno, tsoil, &
        qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l)
+       tsurf_new, dflux_s, dflux_l, rhoa)
 !
 ! This subroutine treats the ocean where there is ice. 
@@ -168,8 +187,9 @@
     USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
 
-!    INCLUDE "indicesol.h"
+!   INCLUDE "indicesol.h"
     INCLUDE "dimsoil.h"
     INCLUDE "YOMCST.h"
     INCLUDE "clesphys.h"
+    INCLUDE "flux_arp.h"
 
 ! Input arguments
@@ -187,4 +207,5 @@
     REAL, DIMENSION(klon), INTENT(IN)    :: ps
     REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
+    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 
 ! In/Output arguments
@@ -216,5 +237,5 @@
     REAL, DIMENSION(klon)       :: u0, v0
     REAL, DIMENSION(klon)       :: u1_lay, v1_lay
-    REAL, DIMENSION(klon)       :: sens_prec_liq, sens_prec_sol    
+    REAL sens_prec_liq(knon), sens_prec_sol (knon)   
     REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol    
 
@@ -233,5 +254,5 @@
     tsurf_tmp(:) = tsurf_in(:)
 
-! calculate the parameters cal, beta, capsol and dif_grnd
+! calculate the parameters cal, beta, capsol and dif_grnd and then recalculate cal
     CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
 
@@ -249,6 +270,6 @@
     ENDIF
 
-    beta = 1.0
-    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
+!    beta = 1.0
+    lat_prec_liq = 0.; lat_prec_sol = 0.
 
 ! Suppose zero surface speed
@@ -263,5 +284,5 @@
          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
+         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
     do j = 1, knon
       i = knindex(j)
@@ -307,27 +328,26 @@
 ! 1D case
 !************************************************************************
-  SUBROUTINE read_tsurf1d(knon,sst_out)
-
+!  SUBROUTINE read_tsurf1d(knon,sst_out)
+!
 ! This subroutine specifies the surface temperature to be used in 1D simulations
-
-      USE dimphy, ONLY : klon
-
-      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
-      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
-
-       INTEGER :: i
+!
+!      USE dimphy, ONLY : klon
+!
+!      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+!      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
+!
+!       INTEGER :: i
 ! COMMON defined in lmdz1d.F:
-       real ts_cur
-       common /sst_forcing/ts_cur
-
-       DO i = 1, knon
-        sst_out(i) = ts_cur
-       ENDDO
-
-      END SUBROUTINE read_tsurf1d
-
+!       real ts_cur
+!       common /sst_forcing/ts_cur
+!
+!       DO i = 1, knon
+!        sst_out(i) = ts_cur
+!       ENDDO
+!
+!      END SUBROUTINE read_tsurf1d
+!
 !
 !************************************************************************
-!
 END MODULE ocean_forced_mod
 
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_slab_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_slab_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/ocean_slab_mod.F90	(revision 3851)
@@ -421,7 +421,11 @@
 !    
 !****************************************************************************************
-    cal(:)      = 0. ! infinite thermal inertia
-    beta(:)     = 1. ! wet surface
-    dif_grnd(:) = 0. ! no diffusion into ground
+    !cal(:)      = 0. ! infinite thermal inertia
+    !beta(:)     = 1. ! wet surface
+    !dif_grnd(:) = 0. ! no diffusion into ground
+    ! EV: use calbeta
+    CALL calbeta(dtime, is_oce, knon, snow,qsurf, beta, cal, dif_grnd)
+
+
     
 ! Suppose zero surface speed
@@ -742,6 +746,10 @@
 ! set beta, cal, compute conduction fluxes inside ice/snow 
     slab_bilg(:)=0.
-    dif_grnd(:)=0.
-    beta(:) = 1.
+    !dif_grnd(:)=0.
+    !beta(:) = 1.
+    ! EV: use calbeta to calculate beta and then recalculate properly cal
+    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, cal, dif_grnd)
+
+
     DO i=1,knon
     ki=knindex(i)
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/pbl_surface_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/pbl_surface_mod.F90	(revision 3851)
@@ -23,8 +23,12 @@
   USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
   USE coef_diff_turb_mod,  ONLY : coef_diff_turb
+  USE ioipsl_getin_p_mod,  ONLY : getin_p
+  USE cdrag_mod
+  USE stdlevvar_mod
   USE wx_pbl_mod,          ONLY : wx_pbl_init, wx_pbl_final, &
 !!                                  wx_pbl_fuse_no_dts, wx_pbl_split_no_dts, &
 !!                                  wx_pbl_fuse, wx_pbl_split
                                   wx_pbl0_fuse, wx_pbl0_split
+  use config_ocean_skin_m, only: activate_ocean_skin
 
   IMPLICIT NONE
@@ -42,4 +46,7 @@
   INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
   !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
+  integer, save :: iflag_new_t2mq2m
+  !$OMP THREADPRIVATE(iflag_new_t2mq2m)
+
 !FC
 !  integer, save :: iflag_frein
@@ -164,5 +171,5 @@
        rlon,      rlat,      rugoro,   rmu0,          &
        zsig,      lwdown_m,  pphi,     cldt,          &
-       rain_f,    snow_f,    solsw_m,  sollw_m,       &
+       rain_f,    snow_f,    solsw_m,  solswfdiff_m, sollw_m,       &
        gustiness,                                     &
        t,         q,         u,        v,             &
@@ -177,5 +184,5 @@
        alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
        alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
-       zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
+       zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout, &
        d_t,       d_q,       d_u,      d_v, d_t_diss, & 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -206,5 +213,5 @@
 !jyg<
 !!       zxfluxt,   zxfluxq,   q2m,      flux_q, tke,   &
-       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,   &
+       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,  &
 !>jyg
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -286,4 +293,5 @@
     USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm 
     USE carbon_cycle_mod,   ONLY : co2_send, nbcf_out, fields_out, yfields_out, cfname_out
+    use hbtm_mod, only: hbtm
     USE indice_sol_mod
     USE time_phylmdz_mod,   ONLY : day_ini,annee_ref,itau_phy
@@ -291,4 +299,11 @@
     USE print_control_mod,  ONLY : prt_level,lunout
     USE ioipsl_getin_p_mod, ONLY : getin_p
+    use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal
+    use phys_output_var_mod, only: dter, dser, tkt, tks, taur, sss
+#ifdef CPP_XIOS
+    USE wxios, ONLY: missing_val
+#else
+    use netcdf, only: missing_val => nf90_fill_real
+#endif
 
     IMPLICIT NONE
@@ -318,4 +333,5 @@
     REAL, DIMENSION(klon),        INTENT(IN)        :: snow_f  ! snow fall
     REAL, DIMENSION(klon),        INTENT(IN)        :: solsw_m ! net shortwave radiation at mean surface
+    REAL, DIMENSION(klon),        INTENT(IN)        :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
     REAL, DIMENSION(klon),        INTENT(IN)        :: sollw_m ! net longwave radiation at mean surface
     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t       ! temperature (K)
@@ -394,4 +410,5 @@
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
+    INTEGER, DIMENSION(klon, 6),  INTENT(OUT)       :: zn2mout    ! number of times the 2m temperature is out of the [tsol,temp]
     REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature 
@@ -453,10 +470,10 @@
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxv    ! v wind tension, mean for each grid point
-    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)     :: z0m,z0h      ! rugosity length (m)
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: agesno   ! age of snow at surface
+    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)   :: z0m,z0h      ! rugosity length (m)
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: agesno   ! age of snow at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: solsw      ! net shortwave radiation at surface 
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: evap     ! evaporation at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: evap     ! evaporation at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
@@ -537,4 +554,6 @@
     REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
     REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
+    INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
+    INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout, n2mout_x, n2mout_w
     REAL, DIMENSION(klon)              :: yustar
     REAL, DIMENSION(klon)              :: ywstar
@@ -822,4 +841,9 @@
     ! Martin
 
+    real, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, ydser, &
+         ytkt, ytks, ytaur, ysss
+    ! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, tkt, tks,
+    ! taur, sss on ocean points
+
 !****************************************************************************************
 ! End of declarations
@@ -838,4 +862,9 @@
 
     IF (first_call) THEN
+
+       iflag_new_t2mq2m=1
+       CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
+       print*,'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
+
        print*,'PBL SURFACE AVEC GUSTINESS'
        first_call=.FALSE.
@@ -843,4 +872,5 @@
        ! Initialize ok_flux_surf (for 1D model)
        if (klon_glo>1) ok_flux_surf=.FALSE.
+       if (klon_glo>1) ok_forc_tsurf=.FALSE.
 
        ! intialize beta_land
@@ -903,4 +933,5 @@
  zxfluxlat(:)=0.
  zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
+ zn2mout(:,:)=0 ;
  d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
  zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
@@ -945,4 +976,5 @@
 !!    tke(:,:,is_ave)=0.
     tke_x(:,:,is_ave)=0.
+
     wake_dltke(:,:,is_ave)=0.
 !>jyg
@@ -955,5 +987,4 @@
 !!! jyg le 10/02/2012
     rh2m_x(:) = 0. ; qsat2m_x(:) = 0. ; rh2m_w(:) = 0. ; qsat2m_w(:) = 0.
-!!!
 
 ! 2b) Initialization of all local variables that will be compressed later
@@ -965,5 +996,5 @@
     yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
 !albedo SB <<<
-    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0    
+    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0
     ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0    
     yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
@@ -976,5 +1007,6 @@
 !!    d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0 
     yqsol = 0.0    
-    ytherm = 0.0  ; ytke=0.
+
+    ytke=0.
 !FC 
     y_treedrg=0.
@@ -1183,4 +1215,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+!--OB this line is not satisfactory because alb is the direct albedo not total albedo
           solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
        ENDDO
@@ -1205,4 +1238,8 @@
 !>al1
 
+!--OB add diffuse fraction of SW down
+   DO n=1,nbcf_out
+       IF (cfname_out(n) == "swdownfdiff" ) fields_out(:,n) = solswfdiff_m(:)
+   ENDDO
 ! >> PC
    IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
@@ -1381,4 +1418,5 @@
              ytke_w(j,k)      = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
              ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
+            
 !>jyg
           ENDDO
@@ -1415,4 +1453,14 @@
           ENDDO
        ENDIF
+
+       if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
+          if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
+             ydelta_sal(:knon) = delta_sal(ni(:knon))
+             ydelta_sst(:knon) = delta_sst(ni(:knon))
+          end if
+          
+          yds_ns(:knon) = ds_ns(ni(:knon))
+          ydt_ns(:knon) = dt_ns(ni(:knon))
+       end if
        
 !****************************************************************************************
@@ -1455,4 +1503,5 @@
       ENDDO
      ENDIF
+
         IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
        ELSE  !(iflag_split .eq.0)
@@ -1538,4 +1587,5 @@
       print *,' args coef_diff_turb: ycdragh ', ycdragh
       print *,' args coef_diff_turb: ytke ', ytke
+
        ENDIF
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -1567,4 +1617,5 @@
       print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x
       print *,' args coef_diff_turb: ytke_x ', ytke_x
+
        ENDIF
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -1821,8 +1872,16 @@
 
           ! Calculate the temperature et relative humidity at 2m and the wind at 10m 
+          IF (iflag_new_t2mq2m==1) THEN
+           CALL stdlevvarn(klon, knon, is_ter, zxli, &
+               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
+               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
+               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
+               yn2mout(:, nsrf, :))
+          ELSE 
           CALL stdlevvar(klon, knon, is_ter, zxli, &
                yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
                yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
                yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+          ENDIF
           
        ENDIF
@@ -1935,5 +1994,7 @@
                yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
                ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
-               y_flux_u1, y_flux_v1)
+               y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
+               yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
+               ytkt(:knon), ytks(:knon), ytaur(:knon), ysss)
       IF (prt_level >=10) THEN
           print *,'arg de surf_ocean: ycdragh ',ycdragh
@@ -2013,7 +2074,15 @@
 !
 !****************************************************************************************
-
-!!!
-!!! jyg le 10/04/2013
+!!
+!!!
+!!! jyg le 10/04/2013 et EV 10/2020
+
+        IF (ok_forc_tsurf) THEN
+            DO j=1,knon
+                ytsurf_new(j)=tg
+                y_d_ts(j) = ytsurf_new(j) - yts(j) 
+            ENDDO
+        ENDIF ! ok_forc_tsurf
+
 !!!
         IF (ok_flux_surf) THEN
@@ -2444,4 +2513,5 @@
               tke_x(i,k,nsrf)    = ytke(j,k)
               tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
+
 !>jyg
            ENDDO
@@ -2457,6 +2527,7 @@
 !!            tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j)
             tke_x(i,k,nsrf)   = ytke_x(j,k)
-            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)
+            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)        
             wake_dltke(i,k,is_ave)   = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
+            
 
 !>jyg
@@ -2538,4 +2609,28 @@
           d_t_w(:,1), d_t_x(:,1), d_t(:,1)
        ENDIF
+
+       if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
+          delta_sal = missing_val
+          ds_ns = missing_val
+          dt_ns = missing_val
+          delta_sst = missing_val
+          dter = missing_val
+          dser = missing_val
+          tkt = missing_val
+          tks = missing_val
+          taur = missing_val
+          sss = missing_val
+          
+          delta_sal(ni(:knon)) = ydelta_sal(:knon)
+          ds_ns(ni(:knon)) = yds_ns(:knon)
+          dt_ns(ni(:knon)) = ydt_ns(:knon)
+          delta_sst(ni(:knon)) = ydelta_sst(:knon)
+          dter(ni(:knon)) = ydter(:knon)
+          dser(ni(:knon)) = ydser(:knon)
+          tkt(ni(:knon)) = ytkt(:knon)
+          tks(ni(:knon)) = ytks(:knon)
+          taur(ni(:knon)) = ytaur(:knon)
+          sss(ni(:knon)) = ysss(:knon)
+       end if
 
 !****************************************************************************************
@@ -2614,9 +2709,29 @@
 !!! jyg le 07/02/2012
        IF (iflag_split .eq.0) THEN
+        IF (iflag_new_t2mq2m==1) THEN
+         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+            uzon, vmer, tair1, qair1, zgeo1, &
+            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
+            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
+            yn2mout(:, nsrf, :))
+        ELSE
         CALL stdlevvar(klon, knon, nsrf, zxli, &
             uzon, vmer, tair1, qair1, zgeo1, &
             tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
             yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+        ENDIF
        ELSE  !(iflag_split .eq.0)
+        IF (iflag_new_t2mq2m==1) THEN
+         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
+            tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
+            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, &
+            yn2mout_x(:, nsrf, :))
+         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
+            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
+            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, &
+            yn2mout_w(:, nsrf, :))
+        ELSE
         CALL stdlevvar(klon, knon, nsrf, zxli, &
             uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
@@ -2627,4 +2742,5 @@
             tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
             yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
+        ENDIF
 !!!
        ENDIF  ! (iflag_split .eq.0)
@@ -2640,4 +2756,9 @@
           u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
           v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
+!
+          DO k = 1, 6
+           n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
+          END DO  
+!
         ENDDO
        ELSE  !(iflag_split .eq.0)
@@ -2650,4 +2771,9 @@
           u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
           v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
+!
+          DO k = 1, 6
+           n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
+          END DO  
+!
         ENDDO
         DO j=1, knon
@@ -2663,4 +2789,9 @@
           u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
           v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
+!
+          DO k = 1, 6
+           n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
+          END DO  
+!
         ENDDO
 !!!
@@ -2919,5 +3050,5 @@
 !
     zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
-    zt2m(:) = 0.0    ; zq2m(:) = 0.0 
+    zt2m(:) = 0.0    ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
     zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
     s_pblh(:) = 0.0  ; s_plcl(:) = 0.0 
@@ -2972,4 +3103,9 @@
           zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
           zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
+!
+          DO k = 1, 6
+           zn2mout(i,k)  = zn2mout(i,k)  + n2mout(i,nsrf,k)  * pctsrf(i,nsrf)
+          ENDDO  
+!
           zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
           wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
@@ -3003,4 +3139,9 @@
           zt2m(i)  = zt2m(i)  + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
           zq2m(i)  = zq2m(i)  + q2m_x(i,nsrf)  * pctsrf(i,nsrf)
+!
+          DO k = 1, 6
+           zn2mout(i,k)  = zn2mout(i,k)  + n2mout_x(i,nsrf,k)  * pctsrf(i,nsrf)
+          ENDDO
+!
           zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
           wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
@@ -3081,5 +3222,5 @@
     DO nsrf = 1, nbsrf
        DO i = 1, klon
-          zxqsurf(i) = zxqsurf(i) + qsurf(i,nsrf) * pctsrf(i,nsrf)
+          zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
           zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
        ENDDO
@@ -3142,11 +3283,13 @@
 
 !albedo SB >>>
-SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
-     evap, z0m, z0h, agesno,                                  &
-     tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke)  
-!albedo SB <<<
+  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
+       evap, z0m, z0h, agesno,                                  &
+       tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke)  
+    !albedo SB <<<
     ! Give default values where new fraction has appread
 
     USE indice_sol_mod
+    use phys_state_var_mod, only: delta_sal, ds_ns, dt_ns, delta_sst
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     INCLUDE "dimsoil.h"
@@ -3235,4 +3378,14 @@
                       alb_dif(i,k,nsrf) = 0.06
                    ENDDO
+                   if (activate_ocean_skin >= 1) then
+                      if (activate_ocean_skin == 2 &
+                           .and. type_ocean == "couple") then
+                         delta_sal(i) = 0.
+                         delta_sst(i) = 0.
+                      end if
+                      
+                      ds_ns(i) = 0.
+                      dt_ns(i) = 0.
+                   end if
                 ELSE IF (nsrf.EQ.is_sic) THEN
                    tsurf(i,nsrf) = 271.35
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyetat0.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyetat0.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyetat0.F90	(revision 3851)
@@ -15,9 +15,9 @@
        ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, radpas, radsol, rain_fall, ratqs, &
        rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
-       solsw, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
+       solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
        wake_deltat, wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
        wake_s, wake_dens, zgam, zmax0, zmea, zpic, zsig, &
        zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
-       ale_wake, ale_bl_stat
+       ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal
 !FC
   USE geometry_mod, ONLY : longitude_deg, latitude_deg
@@ -29,4 +29,10 @@
   USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, ocean_slab_init
   USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
+#ifdef CPP_XIOS
+  USE wxios, ONLY: missing_val
+#else
+  use netcdf, only: missing_val => nf90_fill_real
+#endif
+  use config_ocean_skin_m, only: activate_ocean_skin
 
   IMPLICIT none
@@ -35,5 +41,4 @@
   ! Objet: Lecture de l'etat initial pour la physique
   !======================================================================
-  include "netcdf.inc"
   include "dimsoil.h"
   include "clesphys.h"
@@ -307,11 +312,12 @@
 
   found=phyetat0_get(1,solsw,"solsw","net SW radiation surf",0.)
+  found=phyetat0_get(1,solswfdiff,"solswfdiff","fraction of SW radiation surf that is diffuse",1.)
   found=phyetat0_get(1,sollw,"sollw","net LW radiation surf",0.)
   found=phyetat0_get(1,sollwdown,"sollwdown","down LW radiation surf",0.)
   IF (.NOT. found) THEN
-     sollwdown = 0. ;  zts=0.
-     do nsrf=1,nbsrf
+     sollwdown(:) = 0. ;  zts(:)=0.
+     DO nsrf=1,nbsrf
         zts(:)=zts(:)+ftsol(:,nsrf)*pctsrf(:,nsrf)
-     enddo
+     ENDDO
      sollwdown(:)=sollw(:)+RSIGMA*zts(:)**4
   ENDIF
@@ -518,4 +524,24 @@
   ENDIF ! Slab        
 
+  if (activate_ocean_skin >= 1) then
+     if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
+        found = phyetat0_get(1, delta_sal, "delta_sal", &
+             "ocean-air interface salinity minus bulk salinity", 0.)
+        found = phyetat0_get(1, delta_sst, "delta_SST", &
+             "ocean-air interface temperature minus bulk SST", 0.)
+     end if
+     
+     found = phyetat0_get(1, ds_ns, "dS_ns", "delta salinity near surface", 0.)
+     found = phyetat0_get(1, dt_ns, "dT_ns", "delta temperature near surface", &
+          0.)
+
+     where (pctsrf(:, is_oce) == 0.)
+        ds_ns = missing_val
+        dt_ns = missing_val
+        delta_sst = missing_val
+        delta_sal = missing_val
+     end where
+  end if
+
   ! on ferme le fichier
   CALL close_startphy
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyredem.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyredem.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyredem.F90	(revision 3851)
@@ -26,6 +26,8 @@
                                 detr_therm, ale_bl, ale_bl_trig, alp_bl,     &
                                 ale_wake, ale_bl_stat,                       &
-                                du_gwd_rando, du_gwd_front, u10m, v10m,      &
-                                treedrg
+                                du_gwd_rando, du_gwd_front, u10m, v10m, &
+                                treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
+                                delta_sst
+
   USE geometry_mod, ONLY : longitude_deg, latitude_deg
   USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var
@@ -37,4 +39,5 @@
   USE ocean_slab_mod, ONLY : nslay, tslab, seaice, tice, fsic
   USE time_phylmdz_mod, ONLY: annee_ref, day_end, itau_phy, pdtphys
+  use config_ocean_skin_m, only: activate_ocean_skin  
 
   IMPLICIT none
@@ -184,4 +187,6 @@
 
     CALL put_field(pass,"solsw", "Rayonnement solaire a la surface", solsw)
+
+    CALL put_field(pass,"solswfdiff", "Fraction du rayonnement solaire a la surface qui est diffus", solswfdiff)
 
     CALL put_field(pass,"sollw", "Rayonnement IF a la surface", sollw)
@@ -340,7 +345,19 @@
          "tendency on zonal wind due to acama gravity waves", du_gwd_front)
 
+    if (activate_ocean_skin >= 1) then
+       if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
+          CALL put_field(pass, "delta_sal", &
+               "ocean-air interface salinity minus bulk salinity", delta_sal)
+          CALL put_field(pass, "delta_SST", &
+               "ocean-air interface temperature minus bulk SST", delta_sst)
+       end if
+       
+       CALL put_field(pass, "dS_ns", "delta salinity near surface", ds_ns)
+       CALL put_field(pass, "dT_ns", "delta temperature near surface", dT_ns)
+    end if
+    
     IF (pass==1) CALL enddef_restartphy
     IF (pass==2) CALL close_restartphy
-  ENDDO
+ ENDDO
   
   !$OMP BARRIER
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_local_var_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_local_var_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_local_var_mod.F90	(revision 3851)
@@ -16,7 +16,6 @@
       REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:)
       !$OMP THREADPRIVATE(u_seri, v_seri)
-      REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:), l_mix(:,:,:)
-      !$OMP THREADPRIVATE(l_mixmin, l_mix)
-
+      REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:), l_mix(:,:,:), tke_dissip(:,:,:)
+      !$OMP THREADPRIVATE(l_mixmin, l_mix, tke_dissip)
       REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
       !$OMP THREADPRIVATE(tr_seri)
@@ -301,6 +300,5 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cldh, cldl, cldm, cldq, cldt, qsat2m
 !$OMP THREADPRIVATE(cldh, cldl, cldm, cldq, cldt, qsat2m )
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cldhjn, cldljn, cldmjn,cldtjn
-!$OMP THREADPRIVATE(cldhjn, cldljn, cldmjn, cldtjn)
+!AS: cldhjn, cldljn, cldmjn,cldtjn pas utilisés en tant que variables, juste noms de diagnostics
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: JrNt
 !$OMP THREADPRIVATE(JrNt)
@@ -380,10 +378,4 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_min_mon, t2m_max_mon
 !$OMP THREADPRIVATE(t2m_min_mon, t2m_max_mon)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zq2m_cor, zt2m_cor
-!$OMP THREADPRIVATE(zq2m_cor, zt2m_cor)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zu10m_cor, zv10m_cor
-!$OMP THREADPRIVATE(zu10m_cor, zv10m_cor)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zrh2m_cor, zqsat2m_cor
-!$OMP THREADPRIVATE(zrh2m_cor, zqsat2m_cor)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: weak_inversion
 !$OMP THREADPRIVATE(weak_inversion)
@@ -446,6 +438,6 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: ref_liq_pi, ref_ice_pi
 !$OMP THREADPRIVATE(ref_liq_pi, ref_ice_pi)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zx_rh
-!$OMP THREADPRIVATE(zx_rh)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zx_rh, zx_rhl, zx_rhi
+!$OMP THREADPRIVATE(zx_rh, zx_rhl, zx_rhi)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca
 !$OMP THREADPRIVATE(prfl, psfl, fraca)
@@ -475,4 +467,7 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: p_tropopause, z_tropopause, t_tropopause
 !$OMP THREADPRIVATE(p_tropopause, z_tropopause, t_tropopause)
+
+      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zn2mout
+!$OMP THREADPRIVATE(zn2mout)
 
 #ifdef CPP_StratAer
@@ -562,6 +557,6 @@
       ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
       ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
-      ALLOCATE(l_mixmin(klon,klev+1,nbsrf), l_mix(klon,klev+1,nbsrf))
-      l_mix(:,:,:)=0. ; l_mixmin(:,:,:)=0. ! doit etre initialse car pas toujours remplis
+      ALLOCATE(l_mixmin(klon,klev+1,nbsrf), l_mix(klon,klev+1,nbsrf), tke_dissip(klon,klev+1,nbsrf))
+      l_mix(:,:,:)=0. ; l_mixmin(:,:,:)=0. ; tke_dissip(:,:,:)=0. ! doit etre initialse car pas toujours remplis
 
       ALLOCATE(tr_seri(klon,klev,nbtr))
@@ -716,5 +711,4 @@
       ALLOCATE(cdragm(klon), cdragh(klon), cldh(klon), cldl(klon))
       ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon))
-      ALLOCATE(cldhjn(klon), cldljn(klon), cldmjn(klon), cldtjn(klon))
       ALLOCATE(JrNt(klon))
       ALLOCATE(dthmin(klon), evap(klon), fder(klon), plcl(klon), plfc(klon))
@@ -760,6 +754,4 @@
       ALLOCATE(zt2m_min_mon(klon), zt2m_max_mon(klon))
       ALLOCATE(t2m_min_mon(klon), t2m_max_mon(klon))
-      ALLOCATE(zq2m_cor(klon), zt2m_cor(klon), zu10m_cor(klon), zv10m_cor(klon))
-      ALLOCATE(zrh2m_cor(klon), zqsat2m_cor(klon))
       ALLOCATE(sens(klon), flwp(klon), fiwp(klon))
       ALLOCATE(alp_bl_conv(klon), alp_bl_det(klon))
@@ -782,5 +774,5 @@
       ALLOCATE(ref_liq(klon, klev), ref_ice(klon, klev), theta(klon, klev))
       ALLOCATE(ref_liq_pi(klon, klev), ref_ice_pi(klon, klev))
-      ALLOCATE(zphi(klon, klev), zx_rh(klon, klev))
+      ALLOCATE(zphi(klon, klev), zx_rh(klon, klev), zx_rhl(klon,klev), zx_rhi(klon,klev))
       ALLOCATE(pmfd(klon, klev), pmfu(klon, klev))
 
@@ -831,4 +823,6 @@
       ALLOCATE (z_tropopause(klon))
       ALLOCATE (t_tropopause(klon))
+
+      ALLOCATE(zn2mout(klon,6))
 
 #ifdef CPP_StratAer
@@ -881,5 +875,5 @@
       DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri)
       DEALLOCATE(u_seri,v_seri)
-      DEALLOCATE(l_mixmin,l_mix)
+      DEALLOCATE(l_mixmin,l_mix, tke_dissip)
 
       DEALLOCATE(tr_seri)
@@ -1017,5 +1011,5 @@
       DEALLOCATE(cdragm, cdragh, cldh, cldl)
       DEALLOCATE(cldm, cldq, cldt, qsat2m)
-      DEALLOCATE(cldljn, cldmjn, cldhjn, cldtjn, JrNt)
+      DEALLOCATE(JrNt)
       DEALLOCATE(dthmin, evap, fder, plcl, plfc)
       DEALLOCATE(prw, prlw, prsw, zustar, zu10m, zv10m, rh2m, s_lcl)
@@ -1057,6 +1051,4 @@
       DEALLOCATE(zt2m_min_mon, zt2m_max_mon)
       DEALLOCATE(t2m_min_mon, t2m_max_mon)
-      DEALLOCATE(zq2m_cor, zt2m_cor, zu10m_cor, zv10m_cor)
-      DEALLOCATE(zrh2m_cor, zqsat2m_cor)
       DEALLOCATE(sens, flwp, fiwp)
       DEALLOCATE(alp_bl_conv,alp_bl_det)
@@ -1076,5 +1068,5 @@
       DEALLOCATE(ref_liq, ref_ice, theta)
       DEALLOCATE(ref_liq_pi, ref_ice_pi)
-      DEALLOCATE(zphi, zx_rh)
+      DEALLOCATE(zphi, zx_rh, zx_rhl, zx_rhi)
       DEALLOCATE(pmfd, pmfu)
 
@@ -1119,4 +1111,5 @@
       DEALLOCATE (z_tropopause)
       DEALLOCATE (t_tropopause)
+      DEALLOCATE(zn2mout)
 
 #ifdef CPP_StratAer
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_ctrlout_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 3851)
@@ -271,4 +271,18 @@
       ctrl_out((/ 10, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
     't2m_sic', "Temp 2m "//clnsurf(4), "K", (/ ('', i=1, 10) /)) /)
+
+  TYPE(ctrl_out), SAVE :: o_nt2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nt2mout', 'Nbt2m out of range complete computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nq2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nq2mout', 'Nbq2m out of range complete computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nu2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nu2mout', 'Nbu2m out of range complete computation', '-', (/ ('', i=1, 10) /))
+
+  TYPE(ctrl_out), SAVE :: o_nt2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nt2moutfg', 'Nbt2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nq2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nq2moutfg', 'Nbq2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_nu2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
+    'nu2moutfg', 'Nbu2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
 
   TYPE(ctrl_out), SAVE :: o_gusts = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11, 11/), &
@@ -461,5 +475,7 @@
   TYPE(ctrl_out), SAVE :: o_SWupSFCcleanclr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     'SWupSFCcleanclr', 'SWup clear sky clean (no aerosol) at surface', 'W/m2', (/ ('', i=1, 10) /))
-  TYPE(ctrl_out), SAVE :: o_SWdnSFC = ctrl_out((/ 1, 1, 10, 10, 5, 10, 11, 11, 11, 11/), &
+  TYPE(ctrl_out), SAVE :: o_fdiffSWdnSFC = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'fdiffSWdnSFC', 'Fraction of diffuse SWdn at surface', 'W/m2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_SWdnSFC = ctrl_out((/ 1, 1, 1, 10, 5, 10, 11, 11, 11, 11/), &
     'SWdnSFC', 'SWdn at surface', 'W/m2', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_SWdnSFCclr = ctrl_out((/ 1, 4, 10, 10, 5, 10, 11, 11, 11, 11/), &
@@ -694,15 +710,15 @@
     'iwp', 'Cloud ice water path', 'kg/m2', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_ue = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'ue', 'Zonal dry static energy transport', '-', (/ ('', i=1, 10) /))
+    'ue', 'Zonal dry static energy transport', 'J/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_ve = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    've', 'Merid dry static energy transport', '-', (/ ('', i=1, 10) /))
+    've', 'Merid dry static energy transport', 'J/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_uq = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'uq', 'Zonal humidity transport', '-', (/ ('', i=1, 10) /))
+    'uq', 'Zonal humidity transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_vq = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'vq', 'Merid humidity transport', '-', (/ ('', i=1, 10) /))
+    'vq', 'Merid humidity transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_uwat = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'uwat', 'Zonal total water transport', '-', (/ ('', i=1, 10) /))
+    'uwat', 'Zonal total water transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_vwat = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'vwat', 'Merid total water transport', '-', (/ ('', i=1, 10) /))
+    'vwat', 'Merid total water transport', 'kg/m/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_cape = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'cape', 'Conv avlbl pot ener', 'J/kg', (/ ('', i=1, 10) /))
@@ -1003,9 +1019,10 @@
   TYPE(ctrl_out), SAVE :: o_tke = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke ', 'TKE', 'm2/s2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_tke_dissip = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'tke_dissip ', 'TKE DISSIPATION', 'm2/s3', (/ ('', i=1, 10) /))   
   TYPE(ctrl_out), SAVE :: o_tke_max = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke_max', 'TKE max', 'm2/s2',                                  &
       (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', &
          't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
-
   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_tke_srf      = (/             &
       ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'tke_ter',       &
@@ -1048,4 +1065,5 @@
       ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'l_mix_sic',       &
       "min PBL mixing length "//clnsurf(4),"m", (/ ('', i=1, 10) /)) /)
+
 
   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_tke_max_srf  = (/                          &
@@ -1432,4 +1450,8 @@
   TYPE(ctrl_out), SAVE :: o_rhum = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'rhum', 'Relative humidity', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_rhl = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'rhl', 'Relative humidity wrt liquid', '%', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_rhi = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'rhi', 'Relative humidity wrt ice', '%', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_ozone = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'ozone', 'Ozone mole fraction', '-', (/ ('', i=1, 10) /))
@@ -1946,3 +1968,43 @@
 #endif
 
+   type(ctrl_out), save:: o_delta_sst &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'delta_SST', &
+        "ocean-air interface temperature minus bulk SST", "K", '')
+
+   type(ctrl_out), save:: o_delta_sal &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'delta_sal', &
+        "ocean-air interface salinity minus bulk salinity", "ppt", '')
+
+   type(ctrl_out), save:: o_ds_ns &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dS_ns', &
+        "subskin salinity minus foundation salinity", "ppt", '')
+
+   type(ctrl_out), save:: o_dt_ns &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dT_ns', &
+        "subskin temperature minus foundation temperature", "K", '')
+
+   type(ctrl_out), save:: o_dter &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dTer', &
+        "ocean-air interface temperature minus sub-skin temperature", "K", '')
+
+   type(ctrl_out), save:: o_dser &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'dSer', &
+        "ocean-air interface salinity minus sub-skin salinity", "ppt", '')
+
+   type(ctrl_out), save:: o_tkt &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'tkt', &
+        "thickness of thermal microlayer", "m", '')
+
+   type(ctrl_out), save:: o_tks &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'tks', &
+        "thickness of salinity microlayer", "m", '')
+
+   type(ctrl_out), save:: o_taur &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'taur', &
+        "momentum flux due to rain", "Pa", '')
+
+   type(ctrl_out), save:: o_sss &
+        = ctrl_out([1, 10, 10, 1, 10, 10, 11, 11, 11, 11], 'SSS', &
+        "bulk sea-surface salinity", "ppt", '')
+
 END MODULE phys_output_ctrlout_mod
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_mod.F90	(revision 3851)
@@ -40,5 +40,5 @@
     USE mod_phys_lmdz_para
     !Martin
-    USE surface_data, ONLY : ok_snow
+    USE surface_data, ONLY : landice_opt
     USE phys_output_ctrlout_mod
     USE mod_grid_phy_lmdz, only: klon_glo,nbp_lon,nbp_lat
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_var_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_var_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_var_mod.F90	(revision 3851)
@@ -133,4 +133,28 @@
  !$OMP THREADPRIVATE(sens_prec_liq_o, sens_prec_sol_o,lat_prec_liq_o,lat_prec_sol_o)
 
+  ! Ocean-atmosphere interface, subskin ocean and near-surface ocean:
+  
+  REAL, ALLOCATABLE, SAVE:: dter(:)
+  ! Temperature variation in the diffusive microlayer, that is
+  ! ocean-air interface temperature minus subskin temperature. In K.
+      
+  REAL, SAVE, ALLOCATABLE:: dser(:)
+  ! Temperature variation in the diffusive microlayer, that is
+  ! subskin temperature minus ocean-air interface temperature. In K.
+
+  REAL, SAVE, ALLOCATABLE:: tkt(:)
+  ! épaisseur (m) de la couche de diffusion thermique (microlayer)
+  ! cool skin thickness
+
+  REAL, SAVE, ALLOCATABLE:: tks(:)
+  ! épaisseur (m) de la couche de diffusion de masse (microlayer)
+  
+  REAL, SAVE, ALLOCATABLE:: taur(:) ! momentum flux due to rain, in Pa
+
+  REAL, SAVE, ALLOCATABLE:: sss(:)
+  ! bulk salinity of the surface layer of the ocean, in ppt
+  
+  !$OMP THREADPRIVATE(dter, dser, tkt, tks, taur, sss)
+
 CONTAINS
 
@@ -138,4 +162,5 @@
   SUBROUTINE phys_output_var_init
     use dimphy
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     IMPLICIT NONE
@@ -191,4 +216,7 @@
     IF (ok_gwd_rando) allocate(zustr_gwd_rando(klon), zvstr_gwd_rando(klon))
 
+    if (activate_ocean_skin >= 1) allocate(dter(klon), dser(klon), tkt(klon), &
+         tks(klon), taur(klon), sss(klon))
+
   END SUBROUTINE phys_output_var_init
 
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_write_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_write_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_write_mod.F90	(revision 3851)
@@ -38,4 +38,7 @@
          o_t2m, o_t2m_min, o_t2m_max, &
          o_t2m_min_mon, o_t2m_max_mon, &
+         o_nt2mout, o_nt2moutfg, &
+         o_nq2mout, o_nq2moutfg, &
+         o_nu2mout, o_nu2moutfg, &
          o_q2m, o_ustar, o_u10m, o_v10m, &
          o_wind10m, o_wind10max, o_wind100m, o_gusts, o_sicf, &
@@ -45,5 +48,5 @@
          o_snow, o_msnow, o_fsnow, o_evap, o_ep,o_epmax_diag, & ! epmax_cape
          o_tops, o_tops0, o_topl, o_topl0, &
-         o_SWupTOA, o_SWupTOAclr, o_SWupTOAcleanclr, o_SWdnTOA, &
+         o_SWupTOA, o_SWupTOAclr, o_SWupTOAcleanclr, o_SWdnTOA, o_fdiffSWdnSFC, &
          o_SWdnTOAclr, o_nettop, o_SWup200, &
          o_SWup200clr, o_SWdn200, o_SWdn200clr, &
@@ -133,8 +136,8 @@
          o_vitu, o_vitv, o_vitw, o_pres, o_paprs, &
          o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
-         o_rnebls, o_rneblsvol, o_rhum, o_ozone, o_ozone_light, &
+         o_rnebls, o_rneblsvol, o_rhum, o_rhl, o_rhi, o_ozone, o_ozone_light, &
          o_duphy, o_dtphy, o_dqphy, o_dqphy2d, o_dqlphy, o_dqlphy2d, &
          o_dqsphy, o_dqsphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
-         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, &
+         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, o_tke_dissip, &
          o_tke_max, o_kz, o_kz_max, o_clwcon, &
          o_dtdyn, o_dqdyn, o_dqdyn2d, o_dqldyn, o_dqldyn2d, & 
@@ -199,6 +202,7 @@
          o_col_O3_strato, o_col_O3_tropo,                 & 
 !--interactive CO2
-         o_flx_co2_ocean, o_flx_co2_land, o_flx_co2_ff, o_flx_co2_bb
-
+         o_flx_co2_ocean, o_flx_co2_land, o_flx_co2_ff, o_flx_co2_bb, &
+         o_delta_sst, o_delta_sal, o_ds_ns, o_dt_ns, o_dter, o_dser, o_tkt, &
+         o_tks, o_taur, o_sss
 
 #ifdef CPP_StratAer
@@ -223,5 +227,5 @@
          qsol, z0m, z0h, fevap, agesno, &
          nday_rain, rain_con, snow_con, &
-         topsw, toplw, toplw0, swup, swdn, &
+         topsw, toplw, toplw0, swup, swdn, solswfdiff, &
          topsw0, swupc0, swdnc0, swup0, swdn0, SWup200, SWup200clr, &
          SWdn200, SWdn200clr, LWup200, LWup200clr, &
@@ -245,11 +249,11 @@
          T2sumSTD, nlevSTD, du_gwd_rando, du_gwd_front, &
          ulevSTD, vlevSTD, wlevSTD, philevSTD, qlevSTD, tlevSTD, &
-         rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, &
-         vphiSTD, wTSTD, u2STD, v2STD, T2STD, missing_val_nf90
+         rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, vphiSTD, &
+         wTSTD, u2STD, v2STD, T2STD, missing_val_nf90, delta_sal, ds_ns, &
+         dt_ns, delta_sst
 
     USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
-         zt2m_cor,zq2m_cor,zu10m_cor,zv10m_cor, zrh2m_cor, zqsat2m_cor, &
-         t2m_min_mon, t2m_max_mon, evap, &
-         l_mixmin,l_mix, &
+         zn2mout, t2m_min_mon, t2m_max_mon, evap, &
+         l_mixmin,l_mix, tke_dissip, &
          zu10m, zv10m, zq2m, zustar, zxqsurf, &
          rain_lsc, rain_num, snow_lsc, bils, sens, fder, &
@@ -258,8 +262,8 @@
          sissnow, runoff, albsol3_lic, evap_pot, &
          t2m, fluxt, fluxlat, fsollw, fsolsw, &
-         wfbils, wfbilo, wfevap, wfrain, wfsnow, & 
+         wfbils, wfbilo, wfevap, wfrain, wfsnow, &
          cdragm, cdragh, cldl, cldm, &
-         cldh, cldt, JrNt, cldljn, cldmjn, cldhjn, &
-         cldtjn, cldq, flwp, fiwp, ue, ve, uq, vq, &
+         cldh, cldt, JrNt,   & ! only output names: cldljn,cldmjn,cldhjn,cldtjn
+         cldq, flwp, fiwp, ue, ve, uq, vq, &
          uwat, vwat, &
          plcl, plfc, wbeff, convoccur, upwd, dnwd, dnwd0, prw, prlw, prsw, &
@@ -297,5 +301,5 @@
          ql_seri, qs_seri, tr_seri, &
          zphi, u_seri, v_seri, omega, cldfra, &
-         rneb, rnebjn, rneblsvol, zx_rh, d_t_dyn,  & 
+         rneb, rnebjn, rneblsvol, zx_rh, zx_rhl, zx_rhi, d_t_dyn,  & 
          d_q_dyn,  d_ql_dyn, d_qs_dyn, &
          d_q_dyn2d,  d_ql_dyn2d, d_qs_dyn2d, &
@@ -353,5 +357,5 @@
          alt_tropo, &
 !Ionela
-         ok_4xCO2atm
+         ok_4xCO2atm, dter, dser, tkt, tks, taur, sss
 
     USE ocean_slab_mod, ONLY: nslay, tslab, slab_bilg, tice, seaice, &
@@ -361,5 +365,5 @@
     USE infotrac_phy, ONLY: nqtot, nqo, type_trac, tname, niadv
     USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
-    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, ok_snow
+    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, landice_opt
     USE aero_mod, ONLY: naero_tot, id_STRAT_phy
     USE ioipsl, ONLY: histend, histsync
@@ -380,4 +384,5 @@
 #endif
     USE tracinca_mod, ONLY: config_inca
+    use config_ocean_skin_m, only: activate_ocean_skin
 
     USE vertical_layers_mod, ONLY: presnivs
@@ -458,4 +463,8 @@
 #ifdef CPP_XIOS
     CALL wxios_set_context
+#endif
+
+#ifndef CPP_XIOS
+    missing_val=missing_val_nf90
 #endif
 
@@ -676,7 +685,7 @@
        CALL histwrite_phy(o_slp, slp)
        CALL histwrite_phy(o_tsol, zxtsol)
-       CALL histwrite_phy(o_t2m, zt2m_cor)
-       CALL histwrite_phy(o_t2m_min, zt2m_cor)
-       CALL histwrite_phy(o_t2m_max, zt2m_cor)
+       CALL histwrite_phy(o_t2m, zt2m)
+       CALL histwrite_phy(o_t2m_min, zt2m)
+       CALL histwrite_phy(o_t2m_max, zt2m)
        CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon)
        CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon)
@@ -684,5 +693,47 @@
        IF (vars_defined) THEN
           DO i=1, klon
-             zx_tmp_fi2d(i)=SQRT(zu10m_cor(i)*zu10m_cor(i)+zv10m_cor(i)*zv10m_cor(i))
+             zx_tmp_fi2d(i)=real(zn2mout(i,1))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nt2mout, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,2))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nt2moutfg, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,3))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nq2mout, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,4))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nq2moutfg, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,5))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nu2mout, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=real(zn2mout(i,6))
+          ENDDO
+       ENDIF
+       CALL histwrite_phy(o_nu2moutfg, zx_tmp_fi2d)
+
+       IF (vars_defined) THEN
+          DO i=1, klon
+             zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
           ENDDO
        ENDIF
@@ -691,5 +742,5 @@
        IF (vars_defined) THEN
           DO i=1, klon
-             zx_tmp_fi2d(i)=SQRT(zu10m_cor(i)*zu10m_cor(i)+zv10m_cor(i)*zv10m_cor(i))
+             zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
           ENDDO
        ENDIF
@@ -699,5 +750,4 @@
 
        IF (vars_defined) THEN
-          missing_val=missing_val_nf90
           DO k = 1, kmax_100m                                      !--we could stop much lower
             zrho(:) = pplay(:,k)/t_seri(:,k)/RD                    ! air density in kg/m3
@@ -771,8 +821,9 @@
        ENDIF
        CALL histwrite_phy(o_sicf, zx_tmp_fi2d)
-       CALL histwrite_phy(o_q2m, zq2m_cor)
-       CALL histwrite_phy(o_ustar, zustar)
-       CALL histwrite_phy(o_u10m, zu10m_cor)
-       CALL histwrite_phy(o_v10m, zv10m_cor)
+       CALL histwrite_phy(o_q2m, zq2m)
+       IF (vars_defined) zx_tmp_fi2d = zustar
+       CALL histwrite_phy(o_ustar, zx_tmp_fi2d)
+       CALL histwrite_phy(o_u10m, zu10m)
+       CALL histwrite_phy(o_v10m, zv10m)
 
        IF (vars_defined) THEN
@@ -935,4 +986,6 @@
        ENDIF
        CALL histwrite_phy(o_SWdnSFCcleanclr, zx_tmp_fi2d)
+
+       CALL histwrite_phy(o_fdiffSWdnSFC, solswfdiff)
 
        IF (vars_defined) THEN
@@ -996,5 +1049,5 @@
        CALL histwrite_phy(o_tauy, zx_tmp_fi2d)
 
-       IF (ok_snow) THEN
+       IF (landice_opt .GE. 1) THEN
           CALL histwrite_phy(o_snowsrf, snow_o)
           CALL histwrite_phy(o_qsnow, qsnow)
@@ -1054,4 +1107,6 @@
              CALL histwrite_phy(o_l_mixmin(nsrf),  l_mixmin(:,1:klev,nsrf))
              CALL histwrite_phy(o_tke_max_srf(nsrf),  pbl_tke(:,1:klev,nsrf))
+
+                         
           ENDIF
 !jyg<
@@ -1064,6 +1119,20 @@
 !            ENDIF
 
-
        ENDDO
+       
+                
+        IF (iflag_pbl > 1) THEN
+          zx_tmp_fi3d=0.
+          IF (vars_defined) THEN
+             DO nsrf=1,nbsrf
+                DO k=1,klev
+                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
+                        +pctsrf(:,nsrf)*tke_dissip(:,k,nsrf)
+                ENDDO
+             ENDDO
+          ENDIF
+          
+          CALL histwrite_phy(o_tke_dissip, zx_tmp_fi3d)    
+       ENDIF
 
        IF (vars_defined) zx_tmp_fi2d(1 : klon) = sens_prec_liq_o(1 : klon, 1)
@@ -1189,5 +1258,4 @@
        ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
        ! Champs interpolles sur des niveaux de pression
-       missing_val=missing_val_nf90
        DO iff=1, nfiles
           ll=0
@@ -1412,5 +1480,5 @@
 !       CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d)
 
-       CALL histwrite_phy(o_qsat2m, zqsat2m_cor)
+       CALL histwrite_phy(o_qsat2m, qsat2m)
        CALL histwrite_phy(o_tpot, tpot)
        CALL histwrite_phy(o_tpote, tpote)
@@ -1691,4 +1759,11 @@
        CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d)
        CALL histwrite_phy(o_rhum, zx_rh)
+       IF (iflag_ice_thermo .GT. 0) THEN
+          IF (vars_defined) zx_tmp_fi3d = zx_rhl * 100.
+          CALL histwrite_phy(o_rhl, zx_tmp_fi3d)
+          IF (vars_defined) zx_tmp_fi3d = zx_rhi * 100.
+          CALL histwrite_phy(o_rhi, zx_tmp_fi3d)
+       ENDIF
+
        
        IF (vars_defined) zx_tmp_fi3d = wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd
@@ -1749,6 +1824,6 @@
           ENDIF
           CALL histwrite_phy(o_tke, zx_tmp_fi3d)
-
-          CALL histwrite_phy(o_tke_max, zx_tmp_fi3d)
+          CALL histwrite_phy(o_tke_max, zx_tmp_fi3d)  
+
        ENDIF
 
@@ -2168,5 +2243,4 @@
        ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
        ! Champs interpolles sur des niveaux de pression
-       missing_val=missing_val_nf90
        DO iff=7, nfiles-1 !--OB: here we deal with files 7,8,9
 
@@ -2359,4 +2433,17 @@
        ENDIF   !(iflag_phytrac==1)
 
+       if (activate_ocean_skin >= 1) then
+          CALL histwrite_phy(o_delta_sst, delta_sst)
+          CALL histwrite_phy(o_delta_sal, delta_sal)
+          CALL histwrite_phy(o_ds_ns, ds_ns)
+          CALL histwrite_phy(o_dt_ns, dt_ns)
+          CALL histwrite_phy(o_dter, dter)
+          CALL histwrite_phy(o_dser, dser)
+          CALL histwrite_phy(o_tkt, tkt)
+          CALL histwrite_phy(o_tks, tks)
+          CALL histwrite_phy(o_taur, taur)
+          CALL histwrite_phy(o_sss, sss)
+       end if
+
        IF (.NOT.vars_defined) THEN
           !$OMP MASTER
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_state_var_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_state_var_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_state_var_mod.F90	(revision 3851)
@@ -47,5 +47,5 @@
 !albedo SB >>>
       REAL, ALLOCATABLE, SAVE :: falb_dif(:,:,:), falb_dir(:,:,:)
-      real, allocatable, save :: chl_con(:)
+      REAL, ALLOCATABLE, SAVE :: chl_con(:)
 !$OMP THREADPRIVATE(falb_dir,falb_dif,chl_con)
 !albedo SB <<<
@@ -54,6 +54,6 @@
       REAL, ALLOCATABLE, SAVE :: rain_fall(:), snow_fall(:)
 !$OMP THREADPRIVATE( rain_fall, snow_fall)
-      REAL, ALLOCATABLE, SAVE :: solsw(:), sollw(:)
-!$OMP THREADPRIVATE(solsw, sollw)
+      REAL, ALLOCATABLE, SAVE :: solsw(:), solswfdiff(:), sollw(:)
+!$OMP THREADPRIVATE(solsw, solswfdiff, sollw)
       REAL, ALLOCATABLE, SAVE :: radsol(:)
 !$OMP THREADPRIVATE(radsol)
@@ -358,6 +358,6 @@
       REAL,ALLOCATABLE,SAVE :: albplap(:)
 !$OMP THREADPRIVATE(albplap)
-      REAL,ALLOCATABLE,SAVE :: solswp(:), sollwp(:)
-!$OMP THREADPRIVATE(solswp, sollwp)
+      REAL,ALLOCATABLE,SAVE :: solswp(:), solswfdiffp(:), sollwp(:)
+!$OMP THREADPRIVATE(solswp, solswfdiffp, sollwp)
       REAL,ALLOCATABLE,SAVE :: sollwdownp(:)
 !$OMP THREADPRIVATE(sollwdownp)
@@ -430,5 +430,26 @@
 !$OMP THREADPRIVATE(is_initialized)    
 
-CONTAINS
+      ! Ocean-atmosphere interface:
+
+      REAL, ALLOCATABLE, SAVE:: ds_ns(:) ! (klon)
+      ! "delta salinity near surface". Salinity variation in the
+      ! near-surface turbulent layer. That is subskin salinity minus
+      ! foundation salinity. In ppt.
+
+      REAL, ALLOCATABLE, SAVE:: dt_ns(:) ! (klon)
+      ! "delta temperature near surface". Temperature variation in the
+      ! near-surface turbulent layer. That is subskin temperature
+      ! minus foundation temperature. (Can be negative.) In K.
+      
+      REAL, ALLOCATABLE, SAVE:: delta_sst(:) ! (klon)
+      ! Ocean-air interface temperature minus bulk SST, in
+      ! K. Allocated and defined only if activate_ocean_skin >= 1.
+
+      REAL, ALLOCATABLE, SAVE:: delta_sal(:) ! (klon)
+      ! Ocean-air interface salinity minus bulk salinity, in ppt
+      
+      !$OMP THREADPRIVATE(delta_sal, ds_ns, dt_ns, delta_sst)
+
+    CONTAINS
 
 !======================================================================
@@ -438,4 +459,5 @@
 USE infotrac_phy, ONLY : nbtr
 USE indice_sol_mod
+use config_ocean_skin_m, only: activate_ocean_skin
 IMPLICIT NONE
 
@@ -450,4 +472,5 @@
 include "clesphys.h"
 
+      print*, 'is_initialized', is_initialized
       IF (is_initialized) RETURN
       is_initialized=.TRUE.
@@ -461,10 +484,12 @@
       ALLOCATE(falb2(klon,nbsrf))
 !albedo SB >>> 
+      print*, 'allocate falb'
       ALLOCATE(falb_dir(klon,nsw,nbsrf),falb_dif(klon,nsw,nbsrf))
+      print*, 'allocate falb good', falb_dir(1,1,1)
       ALLOCATE(chl_con(klon))
 !albedo SB <<<
       ALLOCATE(rain_fall(klon))
       ALLOCATE(snow_fall(klon))
-      ALLOCATE(solsw(klon), sollw(klon))
+      ALLOCATE(solsw(klon), solswfdiff(klon), sollw(klon))
       sollw=0.0
       ALLOCATE(radsol(klon))
@@ -597,5 +622,5 @@
       ALLOCATE(radsolp(klon), topswp(klon), toplwp(klon))
       ALLOCATE(albplap(klon))
-      ALLOCATE(solswp(klon), sollwp(klon))
+      ALLOCATE(solswp(klon), solswfdiffp(klon), sollwp(klon))
       ALLOCATE(gustiness(klon))
       ALLOCATE(sollwdownp(klon))
@@ -628,5 +653,5 @@
 !!! fin nrlmd le 10/04/2012
       IF (ok_gwd_rando) THEN
-        allocate(du_gwd_rando(klon, klev))
+        ALLOCATE(du_gwd_rando(klon, klev))
         du_gwd_rando(:,:)=0.
       ENDIF
@@ -635,138 +660,148 @@
         du_gwd_front(:,:) = 0 !ym missing init   
       ENDIF
-END SUBROUTINE phys_state_var_init
+      if (activate_ocean_skin >= 1) ALLOCATE(delta_sal(klon), ds_ns(klon), &
+           dt_ns(klon), delta_sst(klon))
+
+    END SUBROUTINE phys_state_var_init
 
 !======================================================================
-SUBROUTINE phys_state_var_end
+    SUBROUTINE phys_state_var_end
+      ! Useful only for lmdz1d.
 !USE dimphy
 USE indice_sol_mod
+use config_ocean_skin_m, only: activate_ocean_skin
 IMPLICIT NONE
 include "clesphys.h"
 
-      deallocate(pctsrf, ftsol, falb1, falb2)
-      deallocate(qsol,fevap,z0m,z0h,agesno)
+      DEALLOCATE(pctsrf, ftsol, falb1, falb2)
+      DEALLOCATE(qsol,fevap,z0m,z0h,agesno)
 !FC
-      deallocate(treedrg)
-      deallocate(rain_fall, snow_fall, solsw, sollw, radsol, swradcorr)
-      deallocate(zmea, zstd, zsig, zgam)
-      deallocate(zthe, zpic, zval)
-      deallocate(rugoro, t_ancien, q_ancien, clwcon, rnebcon)
-      deallocate(qs_ancien, ql_ancien)
-      deallocate(prw_ancien, prlw_ancien, prsw_ancien)
-      deallocate(qtc_cv,sigt_cv)
-      deallocate(u_ancien, v_ancien)
-      deallocate(tr_ancien)                           !RomP
-      deallocate(ratqs, pbl_tke,coefh,coefm)
+      DEALLOCATE(treedrg)
+      DEALLOCATE(rain_fall, snow_fall, solsw, solswfdiff, sollw, radsol, swradcorr)
+      DEALLOCATE(zmea, zstd, zsig, zgam)
+      DEALLOCATE(zthe, zpic, zval)
+      DEALLOCATE(rugoro, t_ancien, q_ancien, clwcon, rnebcon)
+      DEALLOCATE(qs_ancien, ql_ancien)
+      DEALLOCATE(prw_ancien, prlw_ancien, prsw_ancien)
+      DEALLOCATE(qtc_cv,sigt_cv)
+      DEALLOCATE(u_ancien, v_ancien)
+      DEALLOCATE(tr_ancien)                           !RomP
+      DEALLOCATE(ratqs, pbl_tke,coefh,coefm)
 !nrlmd<
-      deallocate(delta_tsurf)
+      DEALLOCATE(delta_tsurf)
 !>nrlmd
-      deallocate(zmax0, f0)
-      deallocate(sig1, w01)
-      deallocate(entr_therm, fm_therm)
-      deallocate(detr_therm)
-      deallocate(clwcon0th, rnebcon0th)
+      DEALLOCATE(zmax0, f0)
+      DEALLOCATE(sig1, w01)
+      DEALLOCATE(entr_therm, fm_therm)
+      DEALLOCATE(detr_therm)
+      DEALLOCATE(clwcon0th, rnebcon0th)
 ! radiation outputs
-      deallocate(swdnc0, swdn0, swdn)
-      deallocate(swupc0, swup0, swup)
-      deallocate(lwdnc0, lwdn0, lwdn)
-      deallocate(lwupc0, lwup0, lwup)
-      deallocate(SWdn200clr, SWdn200)
-      deallocate(SWup200clr, SWup200)
-      deallocate(LWdn200clr, LWdn200)
-      deallocate(LWup200clr, LWup200)
-      deallocate(LWdnTOA, LWdnTOAclr)
+      DEALLOCATE(swdnc0, swdn0, swdn)
+      DEALLOCATE(swupc0, swup0, swup)
+      DEALLOCATE(lwdnc0, lwdn0, lwdn)
+      DEALLOCATE(lwupc0, lwup0, lwup)
+      DEALLOCATE(SWdn200clr, SWdn200)
+      DEALLOCATE(SWup200clr, SWup200)
+      DEALLOCATE(LWdn200clr, LWdn200)
+      DEALLOCATE(LWup200clr, LWup200)
+      DEALLOCATE(LWdnTOA, LWdnTOAclr)
 ! pressure level
-      deallocate(tsumSTD)
-      deallocate(usumSTD, vsumSTD)
-      deallocate(wsumSTD, phisumSTD)
-      deallocate(tnondef)
-      deallocate(qsumSTD, rhsumSTD)
-      deallocate(uvsumSTD)
-      deallocate(vqsumSTD)
-      deallocate(vTsumSTD)
-      deallocate(wqsumSTD)
-      deallocate(vphisumSTD)
-      deallocate(wTsumSTD)
-      deallocate(u2sumSTD)
-      deallocate(v2sumSTD)
-      deallocate(T2sumSTD)
-      deallocate(O3sumSTD)
-      deallocate(O3daysumSTD)
+      DEALLOCATE(tsumSTD)
+      DEALLOCATE(usumSTD, vsumSTD)
+      DEALLOCATE(wsumSTD, phisumSTD)
+      DEALLOCATE(tnondef)
+      DEALLOCATE(qsumSTD, rhsumSTD)
+      DEALLOCATE(uvsumSTD)
+      DEALLOCATE(vqsumSTD)
+      DEALLOCATE(vTsumSTD)
+      DEALLOCATE(wqsumSTD)
+      DEALLOCATE(vphisumSTD)
+      DEALLOCATE(wTsumSTD)
+      DEALLOCATE(u2sumSTD)
+      DEALLOCATE(v2sumSTD)
+      DEALLOCATE(T2sumSTD)
+      DEALLOCATE(O3sumSTD)
+      DEALLOCATE(O3daysumSTD)
 !IM beg
-      deallocate(wlevSTD,ulevSTD,vlevSTD,tlevSTD,qlevSTD,rhlevSTD,philevSTD)
-      deallocate(uvSTD,vqSTD,vTSTD,wqSTD,vphiSTD,wTSTD,u2STD,v2STD,T2STD,O3STD,O3daySTD)
+      DEALLOCATE(wlevSTD,ulevSTD,vlevSTD,tlevSTD,qlevSTD,rhlevSTD,philevSTD)
+      DEALLOCATE(uvSTD,vqSTD,vTSTD,wqSTD,vphiSTD,wTSTD,u2STD,v2STD,T2STD,O3STD,O3daySTD)
 !IM end
-      deallocate(seed_old)
-      deallocate(zuthe, zvthe)
-      deallocate(alb_neig)
-      deallocate(ema_cbmf)
-      deallocate(ema_pcb, ema_pct)
-      deallocate(Mipsh, Ma, qcondc)
-      deallocate(wd, sigd)
-      deallocate(cin, ALE, ALP)
-      deallocate(ftd, fqd)
-      deallocate(Ale_bl, Alp_bl)
-      deallocate(ale_wake)
-      deallocate(ale_bl_stat)
-      deallocate(lalim_conv, wght_th)
-      deallocate(wake_deltat, wake_deltaq)
-      deallocate(wake_s, awake_dens, wake_dens)
-      deallocate(wake_Cstar, wake_pe, wake_fip)
+      DEALLOCATE(seed_old)
+      DEALLOCATE(zuthe, zvthe)
+      DEALLOCATE(alb_neig)
+      DEALLOCATE(ema_cbmf)
+      DEALLOCATE(ema_pcb, ema_pct)
+      DEALLOCATE(Mipsh, Ma, qcondc)
+      DEALLOCATE(wd, sigd)
+      DEALLOCATE(cin, ALE, ALP)
+      DEALLOCATE(ftd, fqd)
+      DEALLOCATE(Ale_bl, Alp_bl)
+      DEALLOCATE(ale_wake)
+      DEALLOCATE(ale_bl_stat)
+      DEALLOCATE(lalim_conv, wght_th)
+      DEALLOCATE(wake_deltat, wake_deltaq)
+      DEALLOCATE(wake_s, awake_dens, wake_dens)
+      DEALLOCATE(wake_Cstar, wake_pe, wake_fip)
 !jyg<
-      deallocate(wake_delta_pbl_TKE)
+      DEALLOCATE(wake_delta_pbl_TKE)
 !>jyg
-      deallocate(pfrac_impa, pfrac_nucl)
-      deallocate(pfrac_1nucl)
-      deallocate(total_rain, nday_rain)
-      deallocate(paire_ter)
-      deallocate(albsol1, albsol2)
+      DEALLOCATE(pfrac_impa, pfrac_nucl)
+      DEALLOCATE(pfrac_1nucl)
+      DEALLOCATE(total_rain, nday_rain)
+      DEALLOCATE(paire_ter)
+      DEALLOCATE(albsol1, albsol2)
 !albedo SB >>>
-      deallocate(albsol_dir,albsol_dif,falb_dir,falb_dif,chl_con)
+      DEALLOCATE(albsol_dir,albsol_dif,falb_dir,falb_dif,chl_con)
 !albedo SB <<<
-      deallocate(wo)
-      deallocate(clwcon0,rnebcon0)
-      deallocate(heat, heat0) 
-      deallocate(cool, cool0)
-      deallocate(heat_volc, cool_volc) 
-      deallocate(topsw, toplw)
-      deallocate(sollwdown, sollwdownclr)
-      deallocate(gustiness)
-      deallocate(toplwdown, toplwdownclr)
-      deallocate(topsw0,toplw0,solsw0,sollw0)
-      deallocate(albpla)
+      DEALLOCATE(wo)
+      DEALLOCATE(clwcon0,rnebcon0)
+      DEALLOCATE(heat, heat0) 
+      DEALLOCATE(cool, cool0)
+      DEALLOCATE(heat_volc, cool_volc) 
+      DEALLOCATE(topsw, toplw)
+      DEALLOCATE(sollwdown, sollwdownclr)
+      DEALLOCATE(gustiness)
+      DEALLOCATE(toplwdown, toplwdownclr)
+      DEALLOCATE(topsw0,toplw0,solsw0,sollw0)
+      DEALLOCATE(albpla)
 !IM ajout variables CFMIP2/CMIP5
-      deallocate(heatp, coolp)
-      deallocate(heat0p, cool0p)
-      deallocate(radsolp, topswp, toplwp)
-      deallocate(albplap)
-      deallocate(solswp, sollwp)
-      deallocate(sollwdownp)
-      deallocate(topsw0p,toplw0p)
-      deallocate(solsw0p,sollw0p)
-      deallocate(lwdnc0p, lwdn0p, lwdnp)
-      deallocate(lwupc0p, lwup0p, lwupp)
-      deallocate(swdnc0p, swdn0p, swdnp)
-      deallocate(swupc0p, swup0p, swupp)
-      deallocate(cape)
-      deallocate(pbase,bbase)
-      deallocate(zqasc)
-      deallocate(ibas_con, itop_con)
-      deallocate(rain_con, snow_con)
-      deallocate(rlonPOS)
-      deallocate(newsst)
-      deallocate(ustar,u10m, v10m,wstar)
-      deallocate(topswad, solswad)
-      deallocate(topswai, solswai)
-      deallocate(tau_aero,piz_aero,cg_aero)
-      deallocate(tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
-      deallocate(tau_aero_lw_rrtm,piz_aero_lw_rrtm,cg_aero_lw_rrtm)
-      deallocate(ccm)
-      if (ok_gwd_rando) deallocate(du_gwd_rando)
-      if (.not. ok_hines .and. ok_gwd_rando) deallocate(du_gwd_front)
+      DEALLOCATE(heatp, coolp)
+      DEALLOCATE(heat0p, cool0p)
+      DEALLOCATE(radsolp, topswp, toplwp)
+      DEALLOCATE(albplap)
+      DEALLOCATE(solswp, solswfdiffp, sollwp)
+      DEALLOCATE(sollwdownp)
+      DEALLOCATE(topsw0p,toplw0p)
+      DEALLOCATE(solsw0p,sollw0p)
+      DEALLOCATE(lwdnc0p, lwdn0p, lwdnp)
+      DEALLOCATE(lwupc0p, lwup0p, lwupp)
+      DEALLOCATE(swdnc0p, swdn0p, swdnp)
+      DEALLOCATE(swupc0p, swup0p, swupp)
+      DEALLOCATE(cape)
+      DEALLOCATE(pbase,bbase)
+      DEALLOCATE(zqasc)
+      DEALLOCATE(ibas_con, itop_con)
+      DEALLOCATE(rain_con, snow_con)
+      DEALLOCATE(rlonPOS)
+      DEALLOCATE(newsst)
+      DEALLOCATE(ustar,u10m, v10m,wstar)
+      DEALLOCATE(topswad, solswad)
+      DEALLOCATE(topswai, solswai)
+      DEALLOCATE(tau_aero,piz_aero,cg_aero)
+      DEALLOCATE(tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
+      DEALLOCATE(tau_aero_lw_rrtm,piz_aero_lw_rrtm,cg_aero_lw_rrtm)
+      DEALLOCATE(ccm)
+      if (ok_gwd_rando) DEALLOCATE(du_gwd_rando)
+      if (.not. ok_hines .and. ok_gwd_rando) DEALLOCATE(du_gwd_front)
        
 !!! nrlmd le 10/04/2012
-      deallocate(ale_bl_trig)
+      DEALLOCATE(ale_bl_trig)
 !!! fin nrlmd le 10/04/2012
+
+      if (activate_ocean_skin >= 1) deALLOCATE(delta_sal, ds_ns, dt_ns, &
+           delta_sst)
+
       is_initialized=.FALSE.
+      
 END SUBROUTINE phys_state_var_end
 
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/physiq_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/physiq_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/physiq_mod.F90	(revision 3851)
@@ -16,31 +16,109 @@
        d_u, d_v, d_t, d_qx, d_ps)
 
+! For clarity, the "USE" section is now arranged in alphabetical order,
+! with a separate section for CPP keys
+! PLEASE try to follow this rule 
+
+    USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
+    USE aero_mod
+    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
+  &      fl_ebil, fl_cor_ebil
     USE assert_m, only: assert
+    USE change_srf_frac_mod
+    USE conf_phys_m, only: conf_phys
+    USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
+    USE CFMIP_point_locations   ! IM stations CFMIP
+    USE cmp_seri_mod
+    USE dimphy
+    USE etat0_limit_unstruct_mod
+    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
+    USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
+    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
     USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
          histwrite, ju2ymds, ymds2ju, getin
-    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
+    USE ioipsl_getin_p_mod, ONLY : getin_p
+    USE indice_sol_mod
+    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac
+    USE iophy
+    USE limit_read_mod, ONLY : init_limit_read
+    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
+    USE mod_phys_lmdz_mpi_data, only: is_mpi_root
+    USE mod_phys_lmdz_para
+    USE netcdf95, only: nf95_close
+    USE netcdf, only: nf90_fill_real     ! IM for NMC files
+    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
+    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
+    USE pbl_surface_mod, ONLY : pbl_surface
+    USE phyaqua_mod, only: zenang_an
+    USE phystokenc_mod, ONLY: offline, phystokenc
     USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
          year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour
+!!  USE phys_local_var_mod, ONLY : a long list of variables
+!!              ==> see below, after "CPP Keys" section
+    USE phys_state_var_mod ! Variables sauvegardees de la physique
+    USE phys_output_mod
+    USE phys_output_ctrlout_mod
+    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
+    USE readaerosol_mod, ONLY : init_aero_fromfile
+    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
+    USE radlwsw_m, only: radlwsw
+    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
+    USE regr_pr_time_av_m, only: regr_pr_time_av
+    USE surface_data,     ONLY : type_ocean, ok_veget, landice_opt
+    USE time_phylmdz_mod, only: annee_ref, current_time, day_ini, day_ref, &
+          day_step_phy, itau_phy, pdtphys, raz_date, start_time, update_time
+    USE tracinca_mod, ONLY: config_inca
+    USE tropopause_m,     ONLY: dyn_tropopause
+    USE vampir
+    USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
     USE write_field_phy
-    USE dimphy
-    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
-    USE mod_phys_lmdz_para
-    USE iophy
-    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
-    USE phystokenc_mod, ONLY: offline, phystokenc
-    USE time_phylmdz_mod, only: raz_date, day_step_phy, update_time,current_time
-    USE vampir
-    USE pbl_surface_mod, ONLY : pbl_surface
-    USE change_srf_frac_mod
-    USE surface_data,     ONLY : type_ocean, ok_veget, ok_snow
-    USE tropopause_m,     ONLY: dyn_tropopause
+
+    !USE cmp_seri_mod
+!    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
+!  &      fl_ebil, fl_cor_ebil
+
+!!!!!!!!!!!!!!!!!! "USE" section for CPP keys !!!!!!!!!!!!!!!!!!!!!!!!
+!
+!
 #ifdef CPP_Dust
-    USE phytracr_spl_mod, ONLY: phytracr_spl
+    USE phytracr_spl_mod, ONLY: phytracr_spl, phytracr_spl_out_init
+    USE phys_output_write_spl_mod
+#else
+    USE phytrac_mod, ONLY : phytrac_init, phytrac
+    USE phys_output_write_mod
 #endif
+
+
+#ifdef REPROBUS
+    USE CHEM_REP, ONLY : Init_chem_rep_xjour, &
+         d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, &
+         ztrop, gravit,itroprep, Z1,Z2,fac,B
+#endif
+
+
+#ifdef CPP_RRTM
+    USE YOERAD, ONLY : NRADLP
+    USE YOESW, ONLY : RSUN
+#endif
+
+
 #ifdef CPP_StratAer
     USE strataer_mod, ONLY: strataer_init
 #endif
-    USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
+
+
+#ifdef CPP_XIOS
+    USE xios, ONLY: xios_update_calendar, xios_context_finalize, &
+            xios_get_field_attr, xios_field_is_active
+    USE wxios, ONLY: missing_val, missing_val_omp
+#endif
+#ifndef CPP_XIOS
+    USE paramLMDZ_phy_mod
+#endif
+!
+!
+!!!!!!!!!!!!!!!!!!  END "USE" for CPP keys !!!!!!!!!!!!!!!!!!!!!!
+
+USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
        ! [Variables internes non sauvegardees de la physique]
        ! Variables locales pour effectuer les appels en serie
@@ -119,7 +197,5 @@
        cdragm, cdragh,                   &
        zustar, zu10m, zv10m, rh2m, qsat2m, &
-       zq2m, zt2m, weak_inversion, &
-       zq2m_cor,zt2m_cor,zu10m_cor,zv10m_cor, & ! pour corriger d'un bug
-       zrh2m_cor,zqsat2m_cor, &
+       zq2m, zt2m, zn2mout, weak_inversion, &
        zt2m_min_mon, zt2m_max_mon,   &         ! pour calcul_divers.h
        t2m_min_mon, t2m_max_mon,  &            ! pour calcul_divers.h
@@ -195,5 +271,5 @@
        ref_liq, ref_ice, theta,  &
        ref_liq_pi, ref_ice_pi,  &
-       zphi, zx_rh,  &
+       zphi, zx_rh, zx_rhl, zx_rhi,  &
        pmfd, pmfu,  &
        !
@@ -216,69 +292,5 @@
        zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic
        !
-    USE phys_state_var_mod ! Variables sauvegardees de la physique
-#ifdef CPP_Dust
-    USE phys_output_write_spl_mod
-#else
-    USE phys_output_var_mod ! Variables pour les ecritures des sorties
-#endif
-
-    USE phys_output_write_mod
-    USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
-    USE phys_output_mod
-    USE phys_output_ctrlout_mod
-    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
-    USE regr_pr_time_av_m, only: regr_pr_time_av
-    USE netcdf95, only: nf95_close
-    !IM for NMC files
-    USE netcdf, only: nf90_fill_real
-    USE mod_phys_lmdz_mpi_data, only: is_mpi_root
-    USE aero_mod
-    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
-    USE conf_phys_m, only: conf_phys
-    USE radlwsw_m, only: radlwsw
-    USE phyaqua_mod, only: zenang_an
-    USE time_phylmdz_mod, only: day_step_phy, annee_ref, day_ref, itau_phy, &
-         start_time, pdtphys, day_ini
-    USE tracinca_mod, ONLY: config_inca
-#ifdef CPP_XIOS
-    USE wxios, ONLY: missing_val, missing_val_omp
-    USE xios, ONLY: xios_get_field_attr, xios_field_is_active
-#endif
-#ifdef REPROBUS
-    USE CHEM_REP, ONLY : Init_chem_rep_xjour, &
-         d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, &
-         ztrop, gravit,itroprep, Z1,Z2,fac,B
-#endif
-    USE indice_sol_mod
-    USE phytrac_mod, ONLY : phytrac_init, phytrac
-    USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
-
-#ifdef CPP_RRTM
-    USE YOERAD, ONLY : NRADLP
-    USE YOESW, ONLY : RSUN
-#endif
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-
-#ifndef CPP_XIOS
-    USE paramLMDZ_phy_mod
-#endif
-
-    USE cmp_seri_mod
-    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
-  &      fl_ebil, fl_cor_ebil
-
-    !IM stations CFMIP
-    USE CFMIP_point_locations
-    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
-    USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
-    USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
-    USE etat0_limit_unstruct_mod
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_update_calendar, xios_context_finalize
-#endif
-    USE limit_read_mod, ONLY : init_limit_read
-    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
-    USE readaerosol_mod, ONLY : init_aero_fromfile
-    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
+
 
     IMPLICIT NONE
@@ -603,9 +615,4 @@
     !$OMP THREADPRIVATE(iflag_alp_wk_cond)
 
-    INTEGER,  SAVE               :: iflag_bug_t2m_ipslcm61=1 !
-    !$OMP THREADPRIVATE(iflag_bug_t2m_ipslcm61)
-    INTEGER,  SAVE               :: iflag_bug_t2m_stab_ipslcm61=-1 !
-    !$OMP THREADPRIVATE(iflag_bug_t2m_stab_ipslcm61)
-
     REAL t_w(klon,klev),q_w(klon,klev) ! temperature and moisture profiles in the wake region
     REAL t_x(klon,klev),q_x(klon,klev) ! temperature and moisture profiles in the off-wake region
@@ -1315,9 +1322,4 @@
        WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl
 
-       iflag_bug_t2m_ipslcm61 = 1
-       CALL getin_p('iflag_bug_t2m_ipslcm61', iflag_bug_t2m_ipslcm61)
-       iflag_bug_t2m_stab_ipslcm61 = -1
-       CALL getin_p('iflag_bug_t2m_stab_ipslcm61', iflag_bug_t2m_stab_ipslcm61)
-
        CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond) 
        CALL getin_p('random_notrig_max',random_notrig_max)
@@ -1347,4 +1349,10 @@
        iflag_phytrac = 1 ! by default we do want to call phytrac
        CALL getin_p('iflag_phytrac',iflag_phytrac)
+#ifdef CPP_Dust
+       IF (iflag_phytrac.EQ.0) THEN 
+         WRITE(lunout,*) 'In order to run with SPLA, iflag_phytrac will be forced to 1'
+         iflag_phytrac = 1
+       ENDIF
+#endif	
        nvm_lmdz = 13
        CALL getin_p('NVM',nvm_lmdz)
@@ -1515,4 +1523,6 @@
        ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        CALL init_iophy_new(latitude_deg,longitude_deg)
+       CALL create_etat0_limit_unstruct
+       CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
 
           !===================================================================
@@ -1609,9 +1619,9 @@
 #ifdef CPP_COSP
       IF (ok_cosp) THEN
-           DO k = 1, klev
-             DO i = 1, klon
-               phicosp(i,k) = pphi(i,k) + pphis(i)
-             ENDDO
-           ENDDO
+!           DO k = 1, klev
+!             DO i = 1, klon
+!               phicosp(i,k) = pphi(i,k) + pphis(i)
+!             ENDDO
+!           ENDDO
         CALL phys_cosp(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
@@ -1631,9 +1641,9 @@
 #ifdef CPP_COSP2
         IF (ok_cosp) THEN
-           DO k = 1, klev
-             DO i = 1, klon
-               phicosp(i,k) = pphi(i,k) + pphis(i)
-             ENDDO
-           ENDDO
+!           DO k = 1, klev
+!             DO i = 1, klon
+!               phicosp(i,k) = pphi(i,k) + pphis(i)
+!             ENDDO
+!           ENDDO
           CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
@@ -1681,9 +1691,21 @@
 
        CALL iniradia(klon,klev,paprs(1,1:klev+1))
-       ! Initialisation des champs dans phytrac qui sont utilisés par phys_output_write
+
+       ! Initialisation des champs dans phytrac* qui sont utilisés par phys_output_write*
+#ifdef CPP_Dust
+       ! Quand on utilise SPLA, on force iflag_phytrac=1
+       CALL phytracr_spl_out_init()
+       CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,                  &
+                                pplay, lmax_th, aerosol_couple,                 &
+                                ok_ade, ok_aie, ivap, ok_sync,                  &
+                                ptconv, read_climoz, clevSTD,                   &
+                                ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse,      &
+                                flag_aerosol, flag_aerosol_strat, ok_cdnc)
+#else
+       ! phys_output_write écrit des variables traceurs seulement si iflag_phytrac == 1 
+       ! donc seulement dans ce cas on doit appeler phytrac_init()
        IF (iflag_phytrac == 1 ) THEN
           CALL phytrac_init()
-        ENDIF
-
+       ENDIF
        CALL phys_output_write(itap, pdtphys, paprs, pphis,                    &
                               pplay, lmax_th, aerosol_couple,                 &
@@ -1692,4 +1714,6 @@
                               ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
                               flag_aerosol, flag_aerosol_strat, ok_cdnc)
+#endif
+
 
 #ifdef CPP_XIOS
@@ -1697,6 +1721,4 @@
 #endif
        IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
-       CALL create_etat0_limit_unstruct
-       CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
 
 !jyg<
@@ -2514,5 +2536,5 @@
             longitude_deg, latitude_deg, rugoro,  zrmu0,      &
             zsig,      sollwdown, pphi,    cldt,      &
-            rain_fall, snow_fall, solsw,   sollw,     &
+            rain_fall, snow_fall, solsw,   solswfdiff, sollw,     &
             gustiness,                                &
             t_seri,    q_seri,    u_seri,  v_seri,    &
@@ -2529,5 +2551,5 @@
                                 !albedo SB <<<
             albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
-            zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
+            zxtsol,    zxfluxlat, zt2m,    qsat2m,  zn2mout, &
             d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
                                 !nrlmd<
@@ -2576,21 +2598,4 @@
 !>jyg
        ENDIF
-
-!add limitation for t,q at and wind at 10m
-        if ( iflag_bug_t2m_ipslcm61 == 0 ) THEN
-          CALL borne_var_surf( klon,klev,nbsrf,                 &
-            iflag_bug_t2m_stab_ipslcm61,                        &
-            t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),    &
-            ftsol,zxqsurf,pctsrf,paprs,                         &
-            t2m, q2m, u10m, v10m,                               &
-            zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor,           &
-            zrh2m_cor, zqsat2m_cor)
-        ELSE
-          zt2m_cor(:)=zt2m(:)
-          zq2m_cor(:)=zq2m(:)
-          zu10m_cor(:)=zu10m(:)
-          zv10m_cor(:)=zv10m(:)
-          zqsat2m_cor=999.999
-        ENDIF
 
        !---------------------------------------------------------------------
@@ -3704,4 +3709,8 @@
           ENDIF
           zx_rh(i,k) = q_seri(i,k)/zx_qs
+            IF (iflag_ice_thermo .GT. 0) THEN
+          zx_rhl(i,k) = q_seri(i,k)/(qsatl(zx_t)/pplay(i,k))
+          zx_rhi(i,k) = q_seri(i,k)/(qsats(zx_t)/pplay(i,k))
+            ENDIF
           zqsat(i,k)=zx_qs
        ENDDO
@@ -4143,5 +4152,5 @@
                heat,heat0,cool,cool0,albpla, &
                heat_volc,cool_volc, &
-               topsw,toplw,solsw,sollw, &
+               topsw,toplw,solsw,solswfdiff,sollw, &
                sollwdown, &
                topsw0,toplw0,solsw0,sollw0, &
@@ -4230,5 +4239,5 @@
                      heatp,heat0p,coolp,cool0p,albplap, &
                      heat_volc,cool_volc, &
-                     topswp,toplwp,solswp,sollwp, &
+                     topswp,toplwp,solswp,solswfdiffp,sollwp, &
                      sollwdownp, &
                      topsw0p,toplw0p,solsw0p,sollw0p, &
@@ -4700,8 +4709,14 @@
 #ifdef CPP_COSPV2
        IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+!        IF (MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
           IF (prt_level .GE.10) THEN
              print*,'freq_cosp',freq_cosp
           ENDIF
+           DO k = 1, klev
+             DO i = 1, klon
+               phicosp(i,k) = pphi(i,k) + pphis(i)
+             ENDDO
+           ENDDO
           mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
                  print*,'Dans physiq.F avant appel '
@@ -4769,8 +4784,7 @@
     ENDIF
 
-    IF (iflag_phytrac == 1 ) THEN
-
 #ifdef CPP_Dust
-      CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &  ! I
+    !  Avec SPLA, iflag_phytrac est forcé =1 
+    CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &  ! I
                       pdtphys,ftsol,                                   &  ! I
                       t,q_seri,paprs,pplay,RHcl,                  &  ! I
@@ -4788,6 +4802,6 @@
 
 #else
-
-    CALL phytrac ( &
+    IF (iflag_phytrac == 1 ) THEN
+      CALL phytrac ( &
          itap,     days_elapsed+1,    jH_cur,   debut, &
          lafin,    phys_tstep,     u, v,     t, &
@@ -4826,7 +4840,8 @@
 
 #endif
+    ENDIF    ! (iflag_phytrac=1)
 
 #endif
-    ENDIF    ! (iflag_phytrac=1)
+    !ENDIF    ! (iflag_phytrac=1)
 
     IF (offline) THEN
@@ -5128,5 +5143,5 @@
   CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,  &
        pplay, lmax_th, aerosol_couple,                 &
-       ok_ade, ok_aie, ivap, ok_sync,         &
+       ok_ade, ok_aie, ivap, ok_sync,                  &
        ptconv, read_climoz, clevSTD,                   &
        ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse,      &
@@ -5147,5 +5162,5 @@
 #endif
 
-! On remet des variables a .false. apres un premier appel
+! Pour XIOS : On remet des variables a .false. apres un premier appel
     IF (debut) THEN
 #ifdef CPP_XIOS
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/radlwsw_m.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/radlwsw_m.F90	(revision 3851)
@@ -26,5 +26,5 @@
    heat,heat0,cool,cool0,albpla,&
    heat_volc, cool_volc,&
-   topsw,toplw,solsw,sollw,&
+   topsw,toplw,solsw,solswfdiff,sollw,&
    sollwdown,&
    topsw0,toplw0,solsw0,sollw0,&
@@ -117,4 +117,5 @@
   ! toplw----output-R- ray. IR montant au sommet de l'atmosphere
   ! solsw----output-R- flux solaire net a la surface
+  ! solswfdiff----output-R- fraction de rayonnement diffus pour le flux solaire descendant a la surface
   ! sollw----output-R- ray. IR montant a la surface
   ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
@@ -188,5 +189,5 @@
   REAL,    INTENT(in)  :: tsol(KLON)
   REAL,    INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW)
-  real, intent(in) :: SFRWL(6)
+  REAL,    INTENT(in) :: SFRWL(6)
 !albedo SB <<<
   REAL,    INTENT(in)  :: t(KLON,KLEV), q(KLON,KLEV)
@@ -235,5 +236,5 @@
   REAL,    INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL
   REAL,    INTENT(out) :: topsw(KLON), toplw(KLON)
-  REAL,    INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON)
+  REAL,    INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON)
   REAL,    INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
   REAL,    INTENT(out) :: sollwdown(KLON)
@@ -286,5 +287,5 @@
   REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev)
 
-  real(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
+  REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
   ! "POZON(:, :, 1)" is for the average day-night field, 
   ! "POZON(:, :, 2)" is for daylight time.
@@ -302,5 +303,5 @@
   REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL
   REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon)
-  REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
+  REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon)
   REAL(KIND=8) zsollwdown(kdlon)
   REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon)
@@ -329,74 +330,76 @@
 !MPL input supplementaires pour RECMWFL
 ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
-      REAL(KIND=8) GEMU(klon)
+  REAL(KIND=8) GEMU(klon)
 !MPL input RECMWFL: 
 ! Tableaux aux niveaux inverses pour respecter convention Arpege
-      REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted)
-      REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted)
+  REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted)
+  REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted)
 !--OB
-      REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted)
-      REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted)
+  REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted)
+  REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted)
 !--end OB
-      REAL(KIND=8) paprs_i(klon,klev+1)
-      REAL(KIND=8) pplay_i(klon,klev)
-      REAL(KIND=8) cldfra_i(klon,klev)
-      REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone 
+  REAL(KIND=8) paprs_i(klon,klev+1)
+  REAL(KIND=8) pplay_i(klon,klev)
+  REAL(KIND=8) cldfra_i(klon,klev)
+  REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone 
   ! "POZON(:, :, 1)" is for the average day-night field, 
   ! "POZON(:, :, 2)" is for daylight time.
 !!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6      
-      REAL(KIND=8) PAER_i(kdlon,kflev,6)
-      REAL(KIND=8) PDP_i(klon,klev)
-      REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev)
-      REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev)
+  REAL(KIND=8) PAER_i(kdlon,kflev,6)
+  REAL(KIND=8) PDP_i(klon,klev)
+  REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev)
+  REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev)
 !MPL output RECMWFL:
-      REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1)       
-      REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1)      
-      REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1)    
-      REAL(KIND=8) ZTH   (klon,klev+1),ZTH_i   (klon,klev+1)   
-      REAL(KIND=8) ZCTRSO(klon,2)       
-      REAL(KIND=8) ZCEMTR(klon,2)     
-      REAL(KIND=8) ZTRSOD(klon)        
-      REAL(KIND=8) ZLWFC (klon,2)      
-      REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1)    
-      REAL(KIND=8) ZSWFC (klon,2)      
-      REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
-      REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1)
-      REAL(KIND=8) PPIZA_TOT(klon,klev,NSW)
-      REAL(KIND=8) PCGA_TOT(klon,klev,NSW)
-      REAL(KIND=8) PTAU_TOT(klon,klev,NSW)
-      REAL(KIND=8) PPIZA_NAT(klon,klev,NSW)
-      REAL(KIND=8) PCGA_NAT(klon,klev,NSW)
-      REAL(KIND=8) PTAU_NAT(klon,klev,NSW)
+  REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1)       
+  REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1)      
+  REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1)    
+  REAL(KIND=8) ZTH   (klon,klev+1),ZTH_i   (klon,klev+1)   
+  REAL(KIND=8) ZCTRSO(klon,2)       
+  REAL(KIND=8) ZCEMTR(klon,2)     
+  REAL(KIND=8) ZTRSOD(klon)        
+  REAL(KIND=8) ZLWFC (klon,2)      
+  REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1)    
+  REAL(KIND=8) ZSWFC (klon,2)      
+  REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
+  REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1)
+  REAL(KIND=8) PPIZA_TOT(klon,klev,NSW)
+  REAL(KIND=8) PCGA_TOT(klon,klev,NSW)
+  REAL(KIND=8) PTAU_TOT(klon,klev,NSW)
+  REAL(KIND=8) PPIZA_NAT(klon,klev,NSW)
+  REAL(KIND=8) PCGA_NAT(klon,klev,NSW)
+  REAL(KIND=8) PTAU_NAT(klon,klev,NSW)
 #ifdef CPP_RRTM
-      REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW)
-      REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW)
+  REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW)
+  REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW)
 #endif
-      REAL(KIND=8) PSFSWDIR(klon,NSW)
-      REAL(KIND=8) PSFSWDIF(klon,NSW)
-      REAL(KIND=8) PFSDNN(klon)
-      REAL(KIND=8) PFSDNV(klon)
+  REAL(KIND=8) PSFSWDIR(klon,NSW)
+  REAL(KIND=8) PSFSWDIF(klon,NSW)
+  REAL(KIND=8) PFSDNN(klon)
+  REAL(KIND=8) PFSDNV(klon)
 !MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC,
 !MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja
 !MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0,
 !MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0
-      REAL(KIND=8) ZFLUX_i (klon,2,klev+1)
-      REAL(KIND=8) ZFLUC_i (klon,2,klev+1)
-      REAL(KIND=8) ZFSDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFCDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFCCDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFSUP_i (klon,klev+1)
-      REAL(KIND=8) ZFCUP_i (klon,klev+1)
-      REAL(KIND=8) ZFCCUP_i (klon,klev+1)
-      REAL(KIND=8) ZFLCCDWN_i (klon,klev+1)
-      REAL(KIND=8) ZFLCCUP_i (klon,klev+1)
+  REAL(KIND=8) ZFLUX_i (klon,2,klev+1)
+  REAL(KIND=8) ZFLUC_i (klon,2,klev+1)
+  REAL(KIND=8) ZFSDWN_i (klon,klev+1)
+  REAL(KIND=8) ZFCDWN_i (klon,klev+1)
+  REAL(KIND=8) ZFCCDWN_i (klon,klev+1)
+  REAL(KIND=8) ZFSUP_i (klon,klev+1)
+  REAL(KIND=8) ZFCUP_i (klon,klev+1)
+  REAL(KIND=8) ZFCCUP_i (klon,klev+1)
+  REAL(KIND=8) ZFLCCDWN_i (klon,klev+1)
+  REAL(KIND=8) ZFLCCUP_i (klon,klev+1)
 ! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412)
 !      REAL(KIND=8) RSUN(3,2)
 !      REAL(KIND=8) SUN(3)
 !      REAL(KIND=8) SUN_FRACT(2)
-  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
+  REAL, PARAMETER:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
   CHARACTER (LEN=80) :: abort_message
   CHARACTER (LEN=80) :: modname='radlwsw_m'
 
-  call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
+  REAL zdir, zdif
+
+  CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
   ! initialisation
   ist=1
@@ -414,13 +417,12 @@
   zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
 
-
-   ZTOPSWADAERO(:)  = 0. !ym missing init
-   ZSOLSWADAERO(:)  = 0. !ym missing init
-   ZTOPSWAD0AERO(:) = 0. !ym missing init
-   ZSOLSWAD0AERO(:) = 0. !ym missing init
-   ZTOPSWAIAERO(:)  = 0. !ym missing init 
-   ZSOLSWAIAERO(:)  = 0. !ym missing init  
-   ZTOPSWCF_AERO(:,:)= 0.!ym missing init  
-   ZSOLSWCF_AERO(:,:) =0. !ym missing init  
+  ZTOPSWADAERO(:)  = 0. !ym missing init
+  ZSOLSWADAERO(:)  = 0. !ym missing init
+  ZTOPSWAD0AERO(:) = 0. !ym missing init
+  ZSOLSWAD0AERO(:) = 0. !ym missing init
+  ZTOPSWAIAERO(:)  = 0. !ym missing init 
+  ZSOLSWAIAERO(:)  = 0. !ym missing init  
+  ZTOPSWCF_AERO(:,:)= 0.!ym missing init  
+  ZSOLSWCF_AERO(:,:) =0. !ym missing init  
 
   !
@@ -454,9 +456,9 @@
 #ifdef REPROBUS
     IF (iflag_rrtm==0) THEN
-      if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
+      IF (ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
       print*,'Constante solaire: ',PSCT*zdist*zdist
-    END IF
+    ENDIF
 #endif
-  END IF
+  ENDIF
 
   DO j = 1, nb_gr
@@ -541,6 +543,5 @@
        CALL RAD_INTERACTIF(POZON,iof)
 #endif
-    END IF
-
+    ENDIF
     !
     DO k = 1, kflev+1
@@ -568,9 +569,9 @@
       ENDDO
     ENDDO
-
 !
 !===== iflag_rrtm ================================================
 !      
     IF (iflag_rrtm == 0) THEN       !!!! remettre 0 juste pour tester l'ancien rayt via rrtm
+!
 !--- Mise a zero des tableaux output du rayonnement LW-AR4 ----------              
       DO k = 1, kflev+1
@@ -651,4 +652,9 @@
       zsolswaiaero(i)=0.
       ENDDO
+
+      !--fraction of diffuse radiation in surface SW downward radiation
+      !--not computed with old radiation scheme
+      zsolswfdiff(:) = -999.999
+
 !     print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract
        ! daylight ozone, if we have it, for short wave
@@ -676,5 +682,4 @@
        DO i=1,kdlon
        DO k=1,kflev+1
-!        print *,'iof i k klon klev=',iof,i,k,klon,klev
          lwdn0 ( iof+i,k)   = ZFLDN0 ( i,k)
          lwdn  ( iof+i,k)   = ZFLDN  ( i,k)
@@ -687,10 +692,5 @@
        ENDDO  
        ENDDO  
-!          print*,'SW_AR4 ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
-!          print*,'SW_AR4 swdn0  1 , klev:',swdn0(1:klon,1),swdn0(1:klon,klev)
-!          print*,'SW_AR4 ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
-!          print*,'SW_AR4 swup0  1 , klev:',swup0(1:klon,1),swup0(1:klon,klev)
-!          print*,'SW_AR4 ZFSDN  1 , klev:',ZFSDN(1:klon,1) ,ZFSDN(1:klon,klev)
-!          print*,'SW_AR4 ZFSUP  1 , klev:',ZFSUP(1:klon,1) ,ZFSUP(1:klon,klev)
+!
     ELSE  
 #ifdef CPP_RRTM
@@ -700,22 +700,22 @@
       DO k = 1, kflev+1
       DO i = 1, kdlon
-      ZEMTD_i(i,k)=0.
-      ZEMTU_i(i,k)=0.
-      ZTRSO_i(i,k)=0.
-      ZTH_i(i,k)=0.
-      ZLWFT_i(i,k)=0.
-      ZSWFT_i(i,k)=0.
-      ZFLUX_i(i,1,k)=0.
-      ZFLUX_i(i,2,k)=0.
-      ZFLUC_i(i,1,k)=0.
-      ZFLUC_i(i,2,k)=0.
-      ZFSDWN_i(i,k)=0.
-      ZFCDWN_i(i,k)=0.
-      ZFCCDWN_i(i,k)=0.
-      ZFSUP_i(i,k)=0.
-      ZFCUP_i(i,k)=0.
-      ZFCCUP_i(i,k)=0.
-      ZFLCCDWN_i(i,k)=0.
-      ZFLCCUP_i(i,k)=0.
+        ZEMTD_i(i,k)=0.
+        ZEMTU_i(i,k)=0.
+        ZTRSO_i(i,k)=0.
+        ZTH_i(i,k)=0.
+        ZLWFT_i(i,k)=0.
+        ZSWFT_i(i,k)=0.
+        ZFLUX_i(i,1,k)=0.
+        ZFLUX_i(i,2,k)=0.
+        ZFLUC_i(i,1,k)=0.
+        ZFLUC_i(i,2,k)=0.
+        ZFSDWN_i(i,k)=0.
+        ZFCDWN_i(i,k)=0.
+        ZFCCDWN_i(i,k)=0.
+        ZFSUP_i(i,k)=0.
+        ZFCUP_i(i,k)=0.
+        ZFCCUP_i(i,k)=0.
+        ZFLCCDWN_i(i,k)=0.
+        ZFLCCUP_i(i,k)=0.
       ENDDO
       ENDDO
@@ -771,6 +771,6 @@
       PFSDNV(i)=0.
       DO kk = 1, NSW
-      PSFSWDIR(i,kk)=0.
-      PSFSWDIF(i,kk)=0.
+        PSFSWDIR(i,kk)=0.
+        PSFSWDIF(i,kk)=0.
       ENDDO
       ENDDO
@@ -779,5 +779,5 @@
 ! On met les donnees dans l'ordre des niveaux arpege
          paprs_i(:,1)=paprs(:,klev+1)
-         do k=1,klev
+         DO k=1,klev
             paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k)
             pplay_i(1:klon,k)   =pplay(1:klon,klev+1-k)
@@ -794,14 +794,14 @@
             ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k)
             ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k)
-         enddo
-         do k=1,kflev
+         ENDDO
+         DO k=1,kflev
            POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:)
 !!!            POZON_i(1:klon,k)=POZON(1:klon,k)	    !!! on laisse 1=sol et klev=top 
 !          print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k)
 !!!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6      
-            do i=1,6
+            DO i=1,6
             PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i)
-            enddo
-         enddo
+            ENDDO
+         ENDDO
 !       print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0
 
@@ -832,5 +832,5 @@
 !    s   'RECMWF ')
 !
-      if(lldebug) then
+      IF (lldebug) THEN
         CALL writefield_phy('paprs_i',paprs_i,klev+1)
         CALL writefield_phy('pplay_i',pplay_i,klev)
@@ -846,5 +846,5 @@
         CALL writefield_phy('palbd_new',PALBD_NEW,NSW)
         CALL writefield_phy('palbp_new',PALBP_NEW,NSW)
-      endif
+      ENDIF
 
 ! Nouvel appel a RECMWF (celui du cy32t0)
@@ -876,5 +876,5 @@
             
 !        print *,'RADLWSW: apres RECMWF'
-      if(lldebug) then
+      IF (lldebug) THEN
         CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1)
         CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1)
@@ -901,5 +901,5 @@
         CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1)
         CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1)
-      endif
+      ENDIF
 ! --------- output RECMWFL
 !  ZEMTD        (KPROMA,KLEV+1)  ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
@@ -952,5 +952,5 @@
          ZFLDNC0(i,k+1)= ZFLCCDWN_i(i,k+1)
          ZFLUPC0(i,k+1)= ZFLCCUP_i(i,k+1)
-         IF(ok_volcan) THEN
+         IF (ok_volcan) THEN
             ZSWADAERO(i,k+1)=ZSWADAERO(i,k+1)*fract(i) !--NL
          ENDIF
@@ -992,4 +992,16 @@
 ! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de
 ! LW_LMDAR4 et SW_LMDAR4
+
+      !--fraction of diffuse radiation in surface SW downward radiation
+      DO i = 1, kdlon
+       IF (fract(i).GT.0.0) THEN
+         zdir=SUM(PSFSWDIR(i,:))
+         zdif=SUM(PSFSWDIF(i,:))
+         zsolswfdiff(i) = zdif/(zdir+zdif)
+       ELSE  !--night
+         zsolswfdiff(i) = 1.0
+       ENDIF
+      ENDDO 
+!
       DO i = 1, kdlon
          zsolsw(i)    = ZSWFT(i,1)
@@ -1009,5 +1021,5 @@
          ztoplw0(i)   = ZLWFT0_i(i,klev+1)*(-1)
 !         
-           IF (fract(i) == 0.) THEN
+         IF (fract(i) == 0.) THEN
 !!!!! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0
 ! pas plus que dans le sw_AR4
@@ -1030,11 +1042,11 @@
 ! ZLWFT(klon,k),ZSWFT
 
-      do k=1,kflev
-         do i=1,kdlon
+      DO k=1,kflev
+         DO i=1,kdlon
            zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k)
            zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k)
            zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
            zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
-           IF(ok_volcan) THEN
+           IF (ok_volcan) THEN
               zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL
               zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL
@@ -1043,6 +1055,6 @@
 !	   ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k)
 !	   ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k)	   
-         enddo
-      enddo
+         ENDDO
+      ENDDO
 #else
     abort_message="You should compile with -rrtm if running with iflag_rrtm=1"
@@ -1056,4 +1068,5 @@
       toplw(iof+i) = ztoplw(i)
       solsw(iof+i) = zsolsw(i)
+      solswfdiff(iof+i) = zsolswfdiff(i)
       sollw(iof+i) = zsollw(i)
       sollwdown(iof+i) = zsollwdown(i)
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenc.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenc.F90	(revision 3725)
+++ 	(revision )
@@ -1,96 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE screenc(klon, knon, nsrf, zxli, &
-                         speed, temp, q_zref, zref, &
-                         ts, qsurf, z0m, z0h, psol, &
-                         ustar, testar, qstar, okri, ri1, &
-                         pref, delu, delte, delq)
-      IMPLICIT NONE
-!-----------------------------------------------------------------------
-! 
-! Objet : calcul "correcteur" des anomalies du vent, de la temperature 
-!         potentielle et de l'humidite relative au niveau de reference zref et 
-!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
-!         a partir des equations de Louis.
-!
-! Reference : Hess, Colman et McAvaney (1995)
-!
-! I. Musat, 01.07.2002
-!-----------------------------------------------------------------------
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
-! speed---input-R- module du vent au 1er niveau du modele
-! temp----input-R- temperature de l'air au 1er niveau du modele
-! q_zref--input-R- humidite relative au 1er niveau du modele
-! zref----input-R- altitude de reference
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! z0m, z0h---input-R- rugosite
-! psol----input-R- pression au sol
-! ustar---input-R- facteur d'echelle pour le vent
-! testar--input-R- facteur d'echelle pour la temperature potentielle
-! qstar---input-R- facteur d'echelle pour l'humidite relative
-! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce 
-!                  et zref par rapport au Ri entre la sfce et la 1ere couche
-! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche 
-!
-! pref----input-R- pression au niveau de reference
-! delu----input-R- anomalie du vent par rapport au 1er niveau
-! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
-! delq----input-R- anomalie de l'humidite relative par rapport a la surface
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli, okri 
-      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
-      REAL, intent(in) :: zref
-      REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol
-      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1         
-!
-      REAL, dimension(klon), intent(out) :: pref, delu, delte, delq 
-!-----------------------------------------------------------------------
-      include "YOMCST.h"
-      include "flux_arp.h"
-!
-! Variables locales  
-      INTEGER :: i 
-      REAL, dimension(klon) :: cdram, cdrah, cdran, zri1, gref,ycdragm
-!
-!------------------------------------------------------------------------- 
-      DO i=1, knon
-        gref(i) = zref*RG
-      ENDDO 
-!
-! Richardson at reference level 
-!
-!      CALL coefcdrag (klon, knon, nsrf, zxli, &
-!                    speed, temp, q_zref, gref, &
-!                    psol, ts, qsurf, rugos, &
-!                    okri, ri1, &
-!                    cdram, cdrah, cdran, zri1, &
-!                    pref)
-! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
-      CALL cdrag (knon, nsrf, &
-                    speed, temp, q_zref, gref, &
-                    psol, ts, qsurf, z0m, z0h, &
-                    cdram, cdrah, zri1, pref)
-      DO i = 1, knon
-        IF(ok_prescr_ust) THEN
-! La aussi il faut forcer avec ust (FC + MPL 20160210)
-        ycdragm(i) = ust*ust/(1.+speed(i))/speed(i)
-        cdram=ycdragm
-        delu(i) = ust/sqrt(cdram(i))
-        ELSE
-        delu(i) = ustar(i)/sqrt(cdram(i))
-        ENDIF
-        delte(i)= (testar(i)* sqrt(cdram(i)))/ &
-                   cdrah(i)
-        delq(i)= (qstar(i)* sqrt(cdram(i)))/ &
-                  cdrah(i)
-      ENDDO 
-!
-      RETURN 
-      END SUBROUTINE screenc
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenc_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenc_mod.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenc_mod.F90	(revision 3851)
@@ -0,0 +1,193 @@
+!
+MODULE screenc_mod
+!
+! This module contains some procedures for calculation of the correction
+! of temperature, specific humidity and wind at a reference level
+!
+  USE cdrag_mod
+  IMPLICIT NONE
+
+CONTAINS
+!
+!****************************************************************************************
+!
+!r original routine svn3623
+!
+      SUBROUTINE screenc(klon, knon, nsrf, zxli, &
+                         speed, temp, q_zref, zref, &
+                         ts, qsurf, z0m, z0h, psol, &
+                         ustar, testar, qstar, okri, ri1, &
+                         pref, delu, delte, delq)
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+! 
+! Objet : calcul "correcteur" des anomalies du vent, de la temperature 
+!         potentielle et de l'humidite relative au niveau de reference zref et 
+!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
+!         a partir des equations de Louis.
+!
+! Reference : Hess, Colman et McAvaney (1995)
+!
+! I. Musat, 01.07.2002
+!-----------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+! speed---input-R- module du vent au 1er niveau du modele
+! temp----input-R- temperature de l'air au 1er niveau du modele
+! q_zref--input-R- humidite relative au 1er niveau du modele
+! zref----input-R- altitude de reference
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! z0m, z0h---input-R- rugosite
+! psol----input-R- pression au sol
+! ustar---input-R- facteur d'echelle pour le vent
+! testar--input-R- facteur d'echelle pour la temperature potentielle
+! qstar---input-R- facteur d'echelle pour l'humidite relative
+! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce 
+!                  et zref par rapport au Ri entre la sfce et la 1ere couche
+! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche 
+!
+! pref----input-R- pression au niveau de reference
+! delu----input-R- anomalie du vent par rapport au 1er niveau
+! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli, okri 
+      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
+      REAL, intent(in) :: zref
+      REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol
+      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1         
+!
+      REAL, dimension(klon), intent(out) :: pref, delu, delte, delq 
+!-----------------------------------------------------------------------
+      include "YOMCST.h"
+      include "flux_arp.h"
+!
+! Variables locales  
+      INTEGER :: i 
+      REAL, dimension(klon) :: cdram, cdrah, cdran, zri1, gref,ycdragm
+!
+!------------------------------------------------------------------------- 
+      DO i=1, knon
+        gref(i) = zref*RG
+      ENDDO 
+!
+! Richardson at reference level 
+!
+!      CALL coefcdrag (klon, knon, nsrf, zxli, &
+!                    speed, temp, q_zref, gref, &
+!                    psol, ts, qsurf, rugos, &
+!                    okri, ri1, &
+!                    cdram, cdrah, cdran, zri1, &
+!                    pref)
+! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
+      CALL cdrag (knon, nsrf, &
+                    speed, temp, q_zref, gref, &
+                    psol, ts, qsurf, z0m, z0h, &
+                    cdram, cdrah, zri1, pref)
+      DO i = 1, knon
+        IF(ok_prescr_ust) THEN
+! La aussi il faut forcer avec ust (FC + MPL 20160210)
+        ycdragm(i) = ust*ust/(1.+speed(i))/speed(i)
+        cdram=ycdragm
+        delu(i) = ust/sqrt(cdram(i))
+        ELSE
+        delu(i) = ustar(i)/sqrt(cdram(i))
+        ENDIF
+        delte(i)= (testar(i)* sqrt(cdram(i)))/ &
+                   cdrah(i)
+        delq(i)= (qstar(i)* sqrt(cdram(i)))/ &
+                  cdrah(i)
+      ENDDO 
+!
+      RETURN 
+      END SUBROUTINE screenc
+!
+      SUBROUTINE screencn(klon, knon, nsrf, zxli, &
+                         speed, temp, q_zref, zref, &
+                         ts, qsurf, z0m, z0h, psol, &
+                         cdrm, cdrh,  okri, &
+                         ri1, iri1, &
+                         pref, delm, delh, zri1)
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+! 
+! Objet : calcul "correcteur" des anomalies du vent, de la temperature 
+!         potentielle et de l'humidite relative au niveau de reference zref et 
+!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
+!         a partir des equations de Louis.
+!
+! Reference : Hess, Colman et McAvaney (1995)
+!
+! I. Musat, 01.07.2002
+!-----------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+! speed---input-R- module du vent au 1er niveau du modele
+! temp----input-R- temperature de l'air au 1er niveau du modele
+! q_zref--input-R- humidite relative au 1er niveau du modele
+! zref----input-R- altitude de reference
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! z0m, z0h---input-R- rugosite
+! psol----input-R- pression au sol
+! ustar---input-R- facteur d'echelle pour le vent
+! testar--input-R- facteur d'echelle pour la temperature potentielle
+! qstar---input-R- facteur d'echelle pour l'humidite relative
+! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce 
+!                  et zref par rapport au Ri entre la sfce et la 1ere couche
+! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche 
+!
+! pref----input-R- pression au niveau de reference
+! delu----input-R- anomalie du vent par rapport au 1er niveau
+! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli, okri 
+      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
+      REAL, intent(in) :: zref
+      REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol
+      REAL, dimension(klon), intent(in) :: cdrm, cdrh, ri1         
+      INTEGER, INTENT(IN)  :: iri1 ! Richardson de la 1ere couche
+!
+      REAL, dimension(klon), intent(out) :: pref, delm, delh, zri1
+!171220     REAL, dimension(klon) :: cdram, cdrah, zri1 
+      REAL, dimension(klon) :: cdram, cdrah
+!-----------------------------------------------------------------------
+      include "YOMCST.h"
+      include "flux_arp.h"
+!
+! Variables locales  
+      INTEGER :: i 
+      REAL, dimension(klon) :: cdran, gref,ycdragm
+!
+!------------------------------------------------------------------------- 
+      DO i=1, knon
+        gref(i) = zref*RG
+      ENDDO 
+!
+! Richardson at reference level 
+!
+      CALL cdragn_ri1 (knon, nsrf, &
+                    speed, temp, q_zref, gref, &
+                    psol, ts, qsurf, z0m, z0h, &
+                    ri1, iri1, &
+                    cdram, cdrah, zri1, pref)
+      DO i = 1, knon
+        delm(i) = sqrt(cdrm(i))/sqrt(cdram(i))
+!verifier que temp est un temperat potentielle.
+        delh(i)= (cdrh(i)* sqrt(cdram(i)))/ &
+                   (cdrah(i)*sqrt(cdrm(i)))
+      ENDDO 
+!
+      RETURN 
+      END SUBROUTINE screencn
+END MODULE screenc_mod
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenp.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenp.F90	(revision 3725)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE screenp(klon, knon, nsrf, &
-     &                   speed, tair, qair, &
-     &                   ts, qsurf, rugos, lmon, &
-     &                   ustar, testar, qstar, zref, &
-     &                   delu, delte, delq) 
-      IMPLICIT none
-!-------------------------------------------------------------------------
-!
-! Objet : calcul "predicteur" des anomalies du vent, de la temperature 
-!         potentielle et de l'humidite relative au niveau de reference zref et 
-!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
-!         a partir des relations de Dyer-Businger.
-!
-! Reference : Hess, Colman et McAvaney (1995)
-!
-! I. Musat, 01.07.2002
-!-------------------------------------------------------------------------
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! speed---input-R- module du vent au 1er niveau du modele
-! tair----input-R- temperature de l'air au 1er niveau du modele
-! qair----input-R- humidite relative au 1er niveau du modele
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! rugos---input-R- rugosite
-! lmon----input-R- longueur de Monin-Obukov
-! ustar---input-R- facteur d'echelle pour le vent
-! testar--input-R- facteur d'echelle pour la temperature potentielle
-! qstar---input-R- facteur d'echelle pour l'humidite relative
-! zref----input-R- altitude de reference
-!
-! delu----input-R- anomalie du vent par rapport au 1er niveau
-! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
-! delq----input-R- anomalie de l'humidite relative par rapport a la surface
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      REAL, dimension(klon), intent(in) :: speed, tair, qair
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
-      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
-      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
-      REAL, intent(in) :: zref
-!
-      REAL, dimension(klon), intent(out) :: delu, delte, delq
-!
-!-------------------------------------------------------------------------
-! Variables locales et constantes :
-      REAL, PARAMETER :: RKAR=0.40
-      INTEGER :: i
-      REAL :: xtmp, xtmp0
-!-------------------------------------------------------------------------
-      DO i = 1, knon
-!
-        IF (lmon(i).GE.0.) THEN
-!
-! STABLE CASE
-!
-          IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0                        &
-     &                      .AND. rugos(i).LE.1.0) THEN
-            delu(i) = (ustar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) + &
-                      min(5.d0, 5.0 *(zref - rugos(i))/lmon(i)))
-            delte(i) = (testar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) + &
-                       min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
-            delq(i) = (qstar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) + &
-                      min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
-          ELSE
-            delu(i)  = 0.1 * speed(i)
-            delte(i) = 0.1 * (tair(i) - ts(i) )
-            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-          ENDIF
-        ELSE  
-!
-! UNSTABLE CASE
-!
-          IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN
-            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
-            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
-            delu(i) = (ustar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) & 
-                      - 2.*log(0.5*(1. + xtmp)) &
-                      + 2.*log(0.5*(1. + xtmp0)) &
-                      - log(0.5*(1. + xtmp*xtmp)) &
-                      + log(0.5*(1. + xtmp0*xtmp0)) &
-                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
-            delte(i) = (testar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) &
-                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
-                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
-            delq(i)  = (qstar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) &
-                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
-                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
-          ELSE
-            delu(i)  = 0.5 * speed(i)
-            delte(i) = 0.5 * (tair(i) - ts(i) )
-            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-          ENDIF
-        ENDIF
-!
-      ENDDO
-      RETURN
-      END SUBROUTINE screenp
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenp_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenp_mod.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/screenp_mod.F90	(revision 3851)
@@ -0,0 +1,185 @@
+!
+MODULE screenp_mod
+!
+! This module contains some procedures for calculation of the first
+! guess of temperature, specific humidity and wind at a reference level
+! coefficients for turbulent diffusion at surface
+!
+  IMPLICIT NONE
+
+CONTAINS
+!
+!****************************************************************************************
+!
+!r original routine
+!
+      SUBROUTINE screenp(klon, knon, nsrf, &
+     &                   speed, tair, qair, &
+     &                   ts, qsurf, rugos, lmon, &
+     &                   ustar, testar, qstar, zref, &
+     &                   delu, delte, delq) 
+      IMPLICIT none
+!-------------------------------------------------------------------------
+!
+! Objet : calcul "predicteur" des anomalies du vent, de la temperature 
+!         potentielle et de l'humidite relative au niveau de reference zref et 
+!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
+!         a partir des relations de Dyer-Businger.
+!
+! Reference : Hess, Colman et McAvaney (1995)
+!
+! I. Musat, 01.07.2002
+!-------------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+! speed---input-R- module du vent au 1er niveau du modele
+! tair----input-R- temperature de l'air au 1er niveau du modele
+! qair----input-R- humidite relative au 1er niveau du modele
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! rugos---input-R- rugosite
+! lmon----input-R- longueur de Monin-Obukov
+! ustar---input-R- facteur d'echelle pour le vent
+! testar--input-R- facteur d'echelle pour la temperature potentielle
+! qstar---input-R- facteur d'echelle pour l'humidite relative
+! zref----input-R- altitude de reference
+!
+! delu----input-R- anomalie du vent par rapport au 1er niveau
+! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      REAL, dimension(klon), intent(in) :: speed, tair, qair
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
+      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
+      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
+      REAL, intent(in) :: zref
+!
+      REAL, dimension(klon), intent(out) :: delu, delte, delq
+!
+!-------------------------------------------------------------------------
+! Variables locales et constantes :
+      REAL, PARAMETER :: RKAR=0.40
+      INTEGER :: i
+      REAL :: xtmp, xtmp0
+!-------------------------------------------------------------------------
+      DO i = 1, knon
+!
+        IF (lmon(i).GE.0.) THEN
+!
+! STABLE CASE
+!
+          IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0                        &
+     &                      .AND. rugos(i).LE.1.0) THEN
+            delu(i) = (ustar(i)/RKAR)* &
+                      (log(zref/(rugos(i))+1.) + &
+                      min(5.d0, 5.0 *(zref - rugos(i))/lmon(i)))
+            delte(i) = (testar(i)/RKAR)* &
+                       (log(zref/(rugos(i))+1.) + &
+                       min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
+            delq(i) = (qstar(i)/RKAR)* &
+                      (log(zref/(rugos(i))+1.) + &
+                      min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
+          ELSE
+            delu(i)  = 0.1 * speed(i)
+            delte(i) = 0.1 * (tair(i) - ts(i) )
+            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
+          ENDIF
+        ELSE  
+!
+! UNSTABLE CASE
+!
+          IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN
+            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
+            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
+            delu(i) = (ustar(i)/RKAR)* &
+                      (log(zref/(rugos(i))+1.) & 
+                      - 2.*log(0.5*(1. + xtmp)) &
+                      + 2.*log(0.5*(1. + xtmp0)) &
+                      - log(0.5*(1. + xtmp*xtmp)) &
+                      + log(0.5*(1. + xtmp0*xtmp0)) &
+                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
+            delte(i) = (testar(i)/RKAR)* &
+                       (log(zref/(rugos(i))+1.) &
+                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
+                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
+            delq(i)  = (qstar(i)/RKAR)* &
+                       (log(zref/(rugos(i))+1.) &
+                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
+                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
+          ELSE
+            delu(i)  = 0.5 * speed(i)
+            delte(i) = 0.5 * (tair(i) - ts(i) )
+            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
+          ENDIF
+        ENDIF
+!
+      ENDDO
+      RETURN
+      END SUBROUTINE screenp
+!
+      SUBROUTINE screenpn(klon, knon, nsrf, &
+     &                   speed, tair, qair, &
+     &                   ts, qsurf, rugos, zri1, &
+     &                   zref, &
+     &                   delu, delte, delq) 
+      IMPLICIT none
+!-------------------------------------------------------------------------
+!
+! Objet : calcul "predicteur" des anomalies du vent, de la temperature 
+!         potentielle et de l'humidite relative au niveau de reference zref et 
+!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
+!         a partir des relations de Dyer-Businger.
+!
+! Reference : Hess, Colman et McAvaney (1995)
+!
+! I. Musat, 01.07.2002
+!-------------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+! speed---input-R- module du vent au 1er niveau du modele
+! tair----input-R- temperature de l'air au 1er niveau du modele
+! qair----input-R- humidite relative au 1er niveau du modele
+! ts------input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! rugos---input-R- rugosite
+! zref----input-R- altitude de reference
+!
+! delu----input-R- anomalie du vent par rapport au 1er niveau
+! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      REAL, dimension(klon), intent(in) :: speed, tair, qair
+      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
+      REAL, dimension(klon), intent(in) :: zri1
+      REAL, intent(in) :: zref
+!
+      REAL, dimension(klon), intent(out) :: delu, delte, delq
+!
+!-------------------------------------------------------------------------
+! Variables locales et constantes :
+      REAL, PARAMETER :: RKAR=0.40
+      INTEGER :: i
+      REAL :: xtmp, xtmp0
+!-------------------------------------------------------------------------
+      DO i = 1, knon
+!
+       IF (zri1(i).GE.0.) THEN
+          delu(i)  = 0.1 * speed(i)
+          delte(i) = 0.1 * (tair(i) - ts(i) )
+          delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
+       ELSE
+          delu(i)  = 0.5 * speed(i)
+          delte(i) = 0.5 * (tair(i) - ts(i) )
+          delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
+       ENDIF
+!
+      ENDDO
+      RETURN
+      END SUBROUTINE screenpn
+END MODULE screenp_mod 
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/stdlevvar.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/stdlevvar.F90	(revision 3725)
+++ 	(revision )
@@ -1,294 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
-                           u1, v1, t1, q1, z1, &
-                           ts1, qsurf, z0m, z0h, psol, pat1, &
-                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar)
-      IMPLICIT NONE
-!-------------------------------------------------------------------------
-!
-! Objet : calcul de la temperature et l'humidite relative a 2m et du 
-!         module du vent a 10m a partir des relations de Dyer-Businger et
-!         des equations de Louis.
-!
-! Reference : Hess, Colman et McAvaney (1995)        
-!
-! I. Musat, 01.07.2002
-!
-!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
-!
-!-------------------------------------------------------------------------
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
-! u1------input-R- vent zonal au 1er niveau du modele
-! v1------input-R- vent meridien au 1er niveau du modele
-! t1------input-R- temperature de l'air au 1er niveau du modele
-! q1------input-R- humidite relative au 1er niveau du modele
-! z1------input-R- geopotentiel au 1er niveau du modele
-! ts1-----input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! z0m, z0h---input-R- rugosite
-! psol----input-R- pression au sol
-! pat1----input-R- pression au 1er niveau du modele
-!
-! t_2m---output-R- temperature de l'air a 2m
-! q_2m---output-R- humidite relative a 2m
-! u_10m--output-R- vitesse du vent a 10m
-!AM
-! t_10m--output-R- temperature de l'air a 10m
-! q_10m--output-R- humidite specifique a 10m
-! ustar--output-R- u*
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli
-      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
-      REAL, dimension(klon), intent(in) :: qsurf, z0m, z0h
-      REAL, dimension(klon), intent(in) :: psol, pat1
-!
-      REAL, dimension(klon), intent(out) :: t_2m, q_2m, ustar
-      REAL, dimension(klon), intent(out) :: u_10m, t_10m, q_10m
-!-------------------------------------------------------------------------
-      include "flux_arp.h"
-      include "YOMCST.h"
-!IM PLUS
-      include "YOETHF.h"
-!
-! Quelques constantes et options:
-!
-! RKAR : constante de von Karman
-      REAL, PARAMETER :: RKAR=0.40
-! niter : nombre iterations calcul "corrector"
-!     INTEGER, parameter :: niter=6, ncon=niter-1
-      INTEGER, parameter :: niter=2, ncon=niter-1
-!
-! Variables locales
-      INTEGER :: i, n
-      REAL :: zref
-      REAL, dimension(klon) :: speed
-! tpot : temperature potentielle
-      REAL, dimension(klon) :: tpot
-      REAL, dimension(klon) :: zri1, cdran
-      REAL, dimension(klon) :: cdram, cdrah
-! ri1 : nb. de Richardson entre la surface --> la 1ere couche
-      REAL, dimension(klon) :: ri1 
-      REAL, dimension(klon) :: testar, qstar
-      REAL, dimension(klon) :: zdte, zdq   
-! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
-      DOUBLE PRECISION, dimension(klon) :: lmon
-      DOUBLE PRECISION, parameter :: eps=1.0D-20
-      REAL, dimension(klon) :: delu, delte, delq
-      REAL, dimension(klon) :: u_zref, te_zref, q_zref  
-      REAL, dimension(klon) :: temp, pref
-      LOGICAL :: okri
-      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
-!convertgence
-      REAL, dimension(klon) :: te_zref_con, q_zref_con
-      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
-      REAL, dimension(klon) :: ok_pred, ok_corr
-!     REAL, dimension(klon) :: conv_te, conv_q
-!------------------------------------------------------------------------- 
-      DO i=1, knon
-       speed(i)=SQRT(u1(i)**2+v1(i)**2)
-       ri1(i) = 0.0
-      ENDDO
-!
-      okri=.FALSE.
-!      CALL coefcdrag(klon, knon, nsrf, zxli, &
-! &                   speed, t1, q1, z1, psol, &
-! &                   ts1, qsurf, rugos, okri, ri1,  &         
-! &                   cdram, cdrah, cdran, zri1, pref)            
-! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
-
-      CALL cdrag(knon, nsrf, &
- &                   speed, t1, q1, z1, &
- &                   psol, ts1, qsurf, z0m, z0h, &
- &                   cdram, cdrah, zri1, pref)
-
-! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
-     IF (ok_prescr_ust) then
-      DO i = 1, knon
-       print *,'cdram avant=',cdram(i)
-       cdram(i) = ust*ust/speed(i)/speed(i)
-       print *,'cdram ust speed apres=',cdram(i),ust,speed
-      ENDDO
-     ENDIF
-!
-!---------Star variables----------------------------------------------------
-!
-      DO i = 1, knon
-        ri1(i) = zri1(i)
-        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
-        ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
-        zdte(i) = tpot(i) - ts1(i)
-        zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
-!
-!
-!IM BUG BUG BUG       zdte(i) = max(zdte(i),1.e-10)
-        zdte(i) = sign(max(abs(zdte(i)),1.e-10),zdte(i))
-!
-        testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
-        qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
-        lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
- &                (RKAR * RG * testar(i))
-      ENDDO
-!
-!----------First aproximation of variables at zref --------------------------
-      zref = 2.0
-      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
- &                 ts1, qsurf, z0m, lmon, &
- &                 ustar, testar, qstar, zref, &
- &                 delu, delte, delq)
-!
-      DO i = 1, knon
-        u_zref(i) = delu(i)
-        q_zref(i) = max(qsurf(i),0.0) + delq(i)
-        te_zref(i) = ts1(i) + delte(i)
-        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
-        q_zref_p(i) = q_zref(i)
-!       te_zref_p(i) = te_zref(i)
-        temp_p(i) = temp(i)
-      ENDDO
-!
-! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
-!
-      DO n = 1, niter
-!
-        okri=.TRUE.
-        CALL screenc(klon, knon, nsrf, zxli, &
- &                   u_zref, temp, q_zref, zref, &
- &                   ts1, qsurf, z0m, z0h, psol, &           
- &                   ustar, testar, qstar, okri, ri1, &
- &                   pref, delu, delte, delq) 
-!
-        DO i = 1, knon
-          u_zref(i) = delu(i)
-          q_zref(i) = delq(i) + max(qsurf(i),0.0)
-          te_zref(i) = delte(i) + ts1(i) 
-!
-! return to normal temperature
-!
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                 (1 + RVTMP2 * max(q_zref(i),0.0))
-!
-!IM +++
-!         IF(temp(i).GT.350.) THEN
-!           WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
-!         ENDIF
-!IM ---
-!
-        IF(n.EQ.ncon) THEN
-          te_zref_con(i) = te_zref(i)
-          q_zref_con(i) = q_zref(i)
-        ENDIF 
-!
-        ENDDO 
-!
-      ENDDO 
-!
-! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
-!
-!       DO i = 1, knon
-!         conv_te(i) = (te_zref(i) - te_zref_con(i))/te_zref_con(i)
-!         conv_q(i) = (q_zref(i) - q_zref_con(i))/q_zref_con(i)
-!IM +++
-!         IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
-!           PRINT*,'DIV','i=',i,te_zref_con(i),te_zref(i),conv_te(i), &
-!           q_zref_con(i),q_zref(i),conv_q(i)
-!         ENDIF
-!IM ---
-!       ENDDO
-!
-      DO i = 1, knon
-        q_zref_c(i) = q_zref(i)
-        temp_c(i) = temp(i)
-!
-!       IF(zri1(i).LT.0.) THEN
-!         IF(nsrf.EQ.1) THEN
-!           ok_pred(i)=1.
-!           ok_corr(i)=0.
-!         ELSE
-!           ok_pred(i)=0.
-!           ok_corr(i)=1.
-!         ENDIF
-!       ELSE
-!         ok_pred(i)=0.
-!         ok_corr(i)=1.
-!       ENDIF
-!
-        ok_pred(i)=0.
-        ok_corr(i)=1.
-!
-        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
-        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
-!IM +++
-!       IF(n.EQ.niter) THEN
-!       IF(t_2m(i).LT.t1(i).AND.t_2m(i).LT.ts1(i)) THEN
-!         PRINT*,' BAD t2m LT ',i,nsrf,t_2m(i),t1(i),ts1(i) 
-!       ELSEIF(t_2m(i).GT.t1(i).AND.t_2m(i).GT.ts1(i)) THEN
-!         PRINT*,' BAD t2m GT ',i,nsrf,t_2m(i),t1(i),ts1(i) 
-!       ENDIF
-!       ENDIF
-!IM ---
-      ENDDO
-!
-!
-!----------First aproximation of variables at zref --------------------------
-!
-      zref = 10.0
-      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
- &                 ts1, qsurf, z0m, lmon, &
- &                 ustar, testar, qstar, zref, &
- &                 delu, delte, delq)
-!
-      DO i = 1, knon
-        u_zref(i) = delu(i)
-        q_zref(i) = max(qsurf(i),0.0) + delq(i)
-        te_zref(i) = ts1(i) + delte(i)
-        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
-!       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                 (1 + RVTMP2 * max(q_zref(i),0.0))
-        u_zref_p(i) = u_zref(i)
-      ENDDO
-!
-! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995 
-!
-      DO n = 1, niter
-!
-        okri=.TRUE.
-        CALL screenc(klon, knon, nsrf, zxli, &
- &                   u_zref, temp, q_zref, zref, &
- &                   ts1, qsurf, z0m, z0h, psol, &
- &                   ustar, testar, qstar, okri, ri1, &
- &                   pref, delu, delte, delq)
-!
-        DO i = 1, knon
-          u_zref(i) = delu(i)
-          q_zref(i) = delq(i) + max(qsurf(i),0.0)
-          te_zref(i) = delte(i) + ts1(i)
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                   (1 + RVTMP2 * max(q_zref(i),0.0))
-        ENDDO 
-!
-      ENDDO
-!
-      DO i = 1, knon
-        u_zref_c(i) = u_zref(i)
-!
-        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
-!
-!AM
-        q_zref_c(i) = q_zref(i)
-        temp_c(i) = temp(i)
-        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
-        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
-!MA
-      ENDDO
-! 
-      RETURN
-      END subroutine stdlevvar
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/stdlevvar_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/stdlevvar_mod.F90	(revision 3851)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/stdlevvar_mod.F90	(revision 3851)
@@ -0,0 +1,743 @@
+!
+MODULE stdlevvar_mod
+!
+! This module contains main procedures for calculation
+! of temperature, specific humidity and wind at a reference level
+!
+  USE cdrag_mod
+  USE screenp_mod
+  USE screenc_mod
+  IMPLICIT NONE
+
+CONTAINS
+!
+!****************************************************************************************
+!
+!r original routine svn3623
+!
+      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
+                           u1, v1, t1, q1, z1, &
+                           ts1, qsurf, z0m, z0h, psol, pat1, &
+                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar)
+      IMPLICIT NONE
+!-------------------------------------------------------------------------
+!
+! Objet : calcul de la temperature et l'humidite relative a 2m et du 
+!         module du vent a 10m a partir des relations de Dyer-Businger et
+!         des equations de Louis.
+!
+! Reference : Hess, Colman et McAvaney (1995)        
+!
+! I. Musat, 01.07.2002
+!
+!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
+!
+!-------------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+! u1------input-R- vent zonal au 1er niveau du modele
+! v1------input-R- vent meridien au 1er niveau du modele
+! t1------input-R- temperature de l'air au 1er niveau du modele
+! q1------input-R- humidite relative au 1er niveau du modele
+! z1------input-R- geopotentiel au 1er niveau du modele
+! ts1-----input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! z0m, z0h---input-R- rugosite
+! psol----input-R- pression au sol
+! pat1----input-R- pression au 1er niveau du modele
+!
+! t_2m---output-R- temperature de l'air a 2m
+! q_2m---output-R- humidite relative a 2m
+! u_10m--output-R- vitesse du vent a 10m
+!AM
+! t_10m--output-R- temperature de l'air a 10m
+! q_10m--output-R- humidite specifique a 10m
+! ustar--output-R- u*
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli
+      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
+      REAL, dimension(klon), intent(in) :: qsurf, z0m, z0h
+      REAL, dimension(klon), intent(in) :: psol, pat1
+!
+      REAL, dimension(klon), intent(out) :: t_2m, q_2m, ustar
+      REAL, dimension(klon), intent(out) :: u_10m, t_10m, q_10m
+!-------------------------------------------------------------------------
+      include "flux_arp.h"
+      include "YOMCST.h"
+!IM PLUS
+      include "YOETHF.h"
+!
+! Quelques constantes et options:
+!
+! RKAR : constante de von Karman
+      REAL, PARAMETER :: RKAR=0.40
+! niter : nombre iterations calcul "corrector"
+!     INTEGER, parameter :: niter=6, ncon=niter-1
+      INTEGER, parameter :: niter=2, ncon=niter-1
+!
+! Variables locales
+      INTEGER :: i, n
+      REAL :: zref
+      REAL, dimension(klon) :: speed
+! tpot : temperature potentielle
+      REAL, dimension(klon) :: tpot
+      REAL, dimension(klon) :: zri1, cdran
+      REAL, dimension(klon) :: cdram, cdrah
+! ri1 : nb. de Richardson entre la surface --> la 1ere couche
+      REAL, dimension(klon) :: ri1 
+      REAL, dimension(klon) :: testar, qstar
+      REAL, dimension(klon) :: zdte, zdq   
+! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
+      DOUBLE PRECISION, dimension(klon) :: lmon
+      DOUBLE PRECISION, parameter :: eps=1.0D-20
+      REAL, dimension(klon) :: delu, delte, delq
+      REAL, dimension(klon) :: u_zref, te_zref, q_zref  
+      REAL, dimension(klon) :: temp, pref
+      LOGICAL :: okri
+      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
+!convertgence
+      REAL, dimension(klon) :: te_zref_con, q_zref_con
+      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
+      REAL, dimension(klon) :: ok_pred, ok_corr
+!     REAL, dimension(klon) :: conv_te, conv_q
+!------------------------------------------------------------------------- 
+      DO i=1, knon
+       speed(i)=SQRT(u1(i)**2+v1(i)**2)
+       ri1(i) = 0.0
+      ENDDO
+!
+      okri=.FALSE.
+!      CALL coefcdrag(klon, knon, nsrf, zxli, &
+! &                   speed, t1, q1, z1, psol, &
+! &                   ts1, qsurf, rugos, okri, ri1,  &         
+! &                   cdram, cdrah, cdran, zri1, pref)            
+! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
+
+      CALL cdrag(knon, nsrf, &
+ &                   speed, t1, q1, z1, &
+ &                   psol, ts1, qsurf, z0m, z0h, &
+ &                   cdram, cdrah, zri1, pref)
+
+! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
+     IF (ok_prescr_ust) then
+      DO i = 1, knon
+       print *,'cdram avant=',cdram(i)
+       cdram(i) = ust*ust/speed(i)/speed(i)
+       print *,'cdram ust speed apres=',cdram(i),ust,speed
+      ENDDO
+     ENDIF
+!
+!---------Star variables----------------------------------------------------
+!
+      DO i = 1, knon
+        ri1(i) = zri1(i)
+        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
+        ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
+        zdte(i) = tpot(i) - ts1(i)
+        zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
+!
+!
+!IM BUG BUG BUG       zdte(i) = max(zdte(i),1.e-10)
+        zdte(i) = sign(max(abs(zdte(i)),1.e-10),zdte(i))
+!
+        testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
+        qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
+        lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
+ &                (RKAR * RG * testar(i))
+      ENDDO
+!
+!----------First aproximation of variables at zref --------------------------
+      zref = 2.0
+      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
+ &                 ts1, qsurf, z0m, lmon, &
+ &                 ustar, testar, qstar, zref, &
+ &                 delu, delte, delq)
+!
+      DO i = 1, knon
+        u_zref(i) = delu(i)
+        q_zref(i) = max(qsurf(i),0.0) + delq(i)
+        te_zref(i) = ts1(i) + delte(i)
+        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
+        q_zref_p(i) = q_zref(i)
+!       te_zref_p(i) = te_zref(i)
+        temp_p(i) = temp(i)
+      ENDDO
+!
+! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
+!
+      DO n = 1, niter
+!
+        okri=.TRUE.
+        CALL screenc(klon, knon, nsrf, zxli, &
+ &                   u_zref, temp, q_zref, zref, &
+ &                   ts1, qsurf, z0m, z0h, psol, &           
+ &                   ustar, testar, qstar, okri, ri1, &
+ &                   pref, delu, delte, delq) 
+!
+        DO i = 1, knon
+          u_zref(i) = delu(i)
+          q_zref(i) = delq(i) + max(qsurf(i),0.0)
+          te_zref(i) = delte(i) + ts1(i) 
+!
+! return to normal temperature
+!
+          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+!                 (1 + RVTMP2 * max(q_zref(i),0.0))
+!
+!IM +++
+!         IF(temp(i).GT.350.) THEN
+!           WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
+!         ENDIF
+!IM ---
+!
+        IF(n.EQ.ncon) THEN
+          te_zref_con(i) = te_zref(i)
+          q_zref_con(i) = q_zref(i)
+        ENDIF 
+!
+        ENDDO 
+!
+      ENDDO 
+!
+! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
+!
+!       DO i = 1, knon
+!         conv_te(i) = (te_zref(i) - te_zref_con(i))/te_zref_con(i)
+!         conv_q(i) = (q_zref(i) - q_zref_con(i))/q_zref_con(i)
+!IM +++
+!         IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
+!           PRINT*,'DIV','i=',i,te_zref_con(i),te_zref(i),conv_te(i), &
+!           q_zref_con(i),q_zref(i),conv_q(i)
+!         ENDIF
+!IM ---
+!       ENDDO
+!
+      DO i = 1, knon
+        q_zref_c(i) = q_zref(i)
+        temp_c(i) = temp(i)
+!
+!       IF(zri1(i).LT.0.) THEN
+!         IF(nsrf.EQ.1) THEN
+!           ok_pred(i)=1.
+!           ok_corr(i)=0.
+!         ELSE
+!           ok_pred(i)=0.
+!           ok_corr(i)=1.
+!         ENDIF
+!       ELSE
+!         ok_pred(i)=0.
+!         ok_corr(i)=1.
+!       ENDIF
+!
+        ok_pred(i)=0.
+        ok_corr(i)=1.
+!
+        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+!IM +++
+!       IF(n.EQ.niter) THEN
+!       IF(t_2m(i).LT.t1(i).AND.t_2m(i).LT.ts1(i)) THEN
+!         PRINT*,' BAD t2m LT ',i,nsrf,t_2m(i),t1(i),ts1(i) 
+!       ELSEIF(t_2m(i).GT.t1(i).AND.t_2m(i).GT.ts1(i)) THEN
+!         PRINT*,' BAD t2m GT ',i,nsrf,t_2m(i),t1(i),ts1(i) 
+!       ENDIF
+!       ENDIF
+!IM ---
+      ENDDO
+!
+!
+!----------First aproximation of variables at zref --------------------------
+!
+      zref = 10.0
+      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
+ &                 ts1, qsurf, z0m, lmon, &
+ &                 ustar, testar, qstar, zref, &
+ &                 delu, delte, delq)
+!
+      DO i = 1, knon
+        u_zref(i) = delu(i)
+        q_zref(i) = max(qsurf(i),0.0) + delq(i)
+        te_zref(i) = ts1(i) + delte(i)
+        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
+!       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+!                 (1 + RVTMP2 * max(q_zref(i),0.0))
+        u_zref_p(i) = u_zref(i)
+      ENDDO
+!
+! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995 
+!
+      DO n = 1, niter
+!
+        okri=.TRUE.
+        CALL screenc(klon, knon, nsrf, zxli, &
+ &                   u_zref, temp, q_zref, zref, &
+ &                   ts1, qsurf, z0m, z0h, psol, &
+ &                   ustar, testar, qstar, okri, ri1, &
+ &                   pref, delu, delte, delq)
+!
+        DO i = 1, knon
+          u_zref(i) = delu(i)
+          q_zref(i) = delq(i) + max(qsurf(i),0.0)
+          te_zref(i) = delte(i) + ts1(i)
+          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
+!                   (1 + RVTMP2 * max(q_zref(i),0.0))
+        ENDDO 
+!
+      ENDDO
+!
+      DO i = 1, knon
+        u_zref_c(i) = u_zref(i)
+!
+        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
+!
+!AM
+        q_zref_c(i) = q_zref(i)
+        temp_c(i) = temp(i)
+        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+!MA
+      ENDDO
+! 
+      RETURN
+      END subroutine stdlevvar
+!
+      SUBROUTINE stdlevvarn(klon, knon, nsrf, zxli, &
+                           u1, v1, t1, q1, z1, &
+                           ts1, qsurf, z0m, z0h, psol, pat1, &
+                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar, &
+                           n2mout)
+!
+      USE ioipsl_getin_p_mod, ONLY : getin_p
+      IMPLICIT NONE
+!-------------------------------------------------------------------------
+!
+! Objet : calcul de la temperature et l'humidite relative a 2m et du 
+!         module du vent a 10m a partir des relations de Dyer-Businger et
+!         des equations de Louis.
+!
+! Reference : Hess, Colman et McAvaney (1995)        
+!
+! I. Musat, 01.07.2002
+!
+!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
+!
+!-------------------------------------------------------------------------
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
+! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
+! u1------input-R- vent zonal au 1er niveau du modele
+! v1------input-R- vent meridien au 1er niveau du modele
+! t1------input-R- temperature de l'air au 1er niveau du modele
+! q1------input-R- humidite relative au 1er niveau du modele
+! z1------input-R- geopotentiel au 1er niveau du modele
+! ts1-----input-R- temperature de l'air a la surface
+! qsurf---input-R- humidite relative a la surface
+! z0m, z0h---input-R- rugosite
+! psol----input-R- pression au sol
+! pat1----input-R- pression au 1er niveau du modele
+!
+! t_2m---output-R- temperature de l'air a 2m
+! q_2m---output-R- humidite relative a 2m
+! u_2m--output-R- vitesse du vent a 2m
+! u_10m--output-R- vitesse du vent a 10m
+! ustar--output-R- u*
+!AM
+! t_10m--output-R- temperature de l'air a 10m
+! q_10m--output-R- humidite specifique a 10m
+!
+      INTEGER, intent(in) :: klon, knon, nsrf
+      LOGICAL, intent(in) :: zxli
+      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
+      REAL, dimension(klon), intent(in) :: qsurf, z0m, z0h
+      REAL, dimension(klon), intent(in) :: psol, pat1
+!
+      REAL, dimension(klon), intent(out) :: t_2m, q_2m, ustar
+      REAL, dimension(klon), intent(out) :: u_10m, t_10m, q_10m
+      INTEGER, dimension(klon, 6), intent(out) :: n2mout
+!
+      REAL, dimension(klon) :: u_2m
+      REAL, dimension(klon) :: cdrm2m, cdrh2m, ri2m
+      REAL, dimension(klon) :: cdram, cdrah, zri1
+      REAL, dimension(klon) :: cdmn1, cdhn1, fm1, fh1
+      REAL, dimension(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
+      REAL, dimension(klon) :: ri2m_new
+!-------------------------------------------------------------------------
+      include "flux_arp.h"
+      include "YOMCST.h"
+!IM PLUS
+      include "YOETHF.h"
+!
+! Quelques constantes et options:
+!
+! RKAR : constante de von Karman
+      REAL, PARAMETER :: RKAR=0.40
+! niter : nombre iterations calcul "corrector"
+!     INTEGER, parameter :: niter=6, ncon=niter-1
+!IM 071020     INTEGER, parameter :: niter=2, ncon=niter-1
+      INTEGER, parameter :: niter=2, ncon=niter
+!     INTEGER, parameter :: niter=6, ncon=niter
+!
+! Variables locales
+      INTEGER :: i, n
+      REAL :: zref
+      REAL, dimension(klon) :: speed
+! tpot : temperature potentielle
+      REAL, dimension(klon) :: tpot
+      REAL, dimension(klon) :: cdran
+! ri1 : nb. de Richardson entre la surface --> la 1ere couche
+      REAL, dimension(klon) :: ri1 
+      DOUBLE PRECISION, parameter :: eps=1.0D-20
+      REAL, dimension(klon) :: delu, delte, delq
+      REAL, dimension(klon) :: delh, delm
+      REAL, dimension(klon) :: delh_new, delm_new
+      REAL, dimension(klon) :: u_zref, te_zref, q_zref  
+      REAL, dimension(klon) :: u_zref_pnew, te_zref_pnew, q_zref_pnew
+      REAL, dimension(klon) :: temp, pref
+      REAL, dimension(klon) :: temp_new, pref_new
+      LOGICAL :: okri
+      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
+      REAL, dimension(klon) :: u_zref_p_new, te_zref_p_new, temp_p_new, q_zref_p_new
+!convergence
+      REAL, dimension(klon) :: te_zref_con, q_zref_con
+      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
+      REAL, dimension(klon) :: ok_pred, ok_corr
+!
+      REAL, dimension(klon) :: cdrm10m, cdrh10m, ri10m
+      REAL, dimension(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
+      REAL, dimension(klon) :: cdn2m, cdn1
+      REAL :: CEPDUE,zdu2 
+      INTEGER :: nzref, nz1
+      LOGICAL, dimension(klon) :: ok_t2m_toosmall, ok_t2m_toobig
+      LOGICAL, dimension(klon) :: ok_q2m_toosmall, ok_q2m_toobig
+      LOGICAL, dimension(klon) :: ok_u2m_toobig
+      LOGICAL, dimension(klon) :: ok_t10m_toosmall, ok_t10m_toobig
+      LOGICAL, dimension(klon) :: ok_q10m_toosmall, ok_q10m_toobig
+      LOGICAL, dimension(klon) :: ok_u10m_toobig
+      INTEGER, dimension(klon, 6) :: n10mout
+
+!------------------------------------------------------------------------- 
+      CEPDUE=0.1
+!
+! n2mout : compteur des pas de temps ou t2m,q2m ou u2m sont en dehors des intervalles
+!          [tsurf, temp], [qsurf, q1] ou [0, speed]
+! n10mout : compteur des pas de temps ou t10m,q10m ou u10m sont en dehors des intervalles
+!          [tsurf, temp], [qsurf, q1] ou [0, speed]
+!
+      n2mout(:,:)=0
+      n10mout(:,:)=0
+      
+      DO i=1, knon
+       speed(i)=MAX(SQRT(u1(i)**2+v1(i)**2),CEPDUE)
+       ri1(i) = 0.0
+      ENDDO
+!
+      okri=.FALSE.
+      CALL cdrag(knon, nsrf, &
+ &                   speed, t1, q1, z1, &
+ &                   psol, ts1, qsurf, z0m, z0h, &
+ &                   cdram, cdrah, zri1, pref)
+
+!
+      DO i = 1, knon
+        ri1(i) = zri1(i)
+        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
+        zdu2 = MAX(CEPDUE*CEPDUE, speed(i)**2)
+        ustar(i) = sqrt(cdram(i) * zdu2)
+!
+      ENDDO
+!
+!----------First aproximation of variables at zref --------------------------
+      zref = 2.0
+!
+! calcul first-guess en utilisant dans les calculs à 2m
+! le Richardson de la premiere couche atmospherique 
+!
+       CALL screencn(klon, knon, nsrf, zxli, &
+ &                   speed, tpot, q1, zref, &
+ &                   ts1, qsurf, z0m, z0h, psol, &           
+ &                   cdram, cdrah,  okri, &
+ &                   ri1, 1, &
+ &                   pref_new, delm_new, delh_new, ri2m)
+!
+       DO i = 1, knon
+         u_zref(i) = delm_new(i)*speed(i)
+         u_zref_p(i) = u_zref(i)
+         q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
+         &           max(qsurf(i),0.0)*(1-delh_new(i))
+         q_zref_p(i) = q_zref(i)
+         te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
+         te_zref_p(i) = te_zref(i)
+!
+! return to normal temperature
+         temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
+         temp_p(i) = temp(i)
+!
+! compteurs ici
+!
+         ok_t2m_toosmall(i)=te_zref(i).LT.tpot(i).AND. &
+         & te_zref(i).LT.ts1(i)
+         ok_t2m_toobig(i)=te_zref(i).GT.tpot(i).AND. &
+         & te_zref(i).GT.ts1(i)
+         ok_q2m_toosmall(i)=q_zref(i).LT.q1(i).AND. &
+         & q_zref(i).LT.qsurf(i)
+         ok_q2m_toobig(i)=q_zref(i).GT.q1(i).AND. &
+         & q_zref(i).GT.qsurf(i)
+         ok_u2m_toobig(i)=u_zref(i).GT.speed(i)
+!
+         IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
+             n2mout(i,1)=n2mout(i,1)+1
+         ENDIF
+         IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
+             n2mout(i,3)=n2mout(i,3)+1
+         ENDIF
+         IF(ok_u2m_toobig(i)) THEN
+             n2mout(i,5)=n2mout(i,5)+1
+         ENDIF
+!
+         IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
+          & ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
+          & ok_u2m_toobig(i)) THEN 
+             delm_new(i)=min(max(delm_new(i),0.),1.)
+             delh_new(i)=min(max(delh_new(i),0.),1.)
+             u_zref(i) = delm_new(i)*speed(i)
+             u_zref_p(i) = u_zref(i)
+             q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
+         &               max(qsurf(i),0.0)*(1-delh_new(i))
+             q_zref_p(i) = q_zref(i)
+             te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
+             te_zref_p(i) = te_zref(i)
+!
+! return to normal temperature
+             temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
+             temp_p(i) = temp(i)
+         ENDIF 
+!
+       ENDDO
+!
+! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
+!
+      DO n = 1, niter
+!
+        okri=.TRUE.
+        CALL screencn(klon, knon, nsrf, zxli, &
+ &                   u_zref, temp, q_zref, zref, &
+ &                   ts1, qsurf, z0m, z0h, psol, &
+ &                   cdram, cdrah,  okri, &
+ &                   ri1, 0, &
+ &                   pref, delm, delh, ri2m)
+!
+        DO i = 1, knon
+          u_zref(i) = delm(i)*speed(i)
+          q_zref(i) = delh(i)*max(q1(i),0.0) + &
+          &           max(qsurf(i),0.0)*(1-delh(i))
+          te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
+!
+! return to normal temperature
+          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+!
+! compteurs ici
+!
+          ok_t2m_toosmall(i)=te_zref(i).LT.tpot(i).AND. &
+          & te_zref(i).LT.ts1(i)
+          ok_t2m_toobig(i)=te_zref(i).GT.tpot(i).AND. &
+          & te_zref(i).GT.ts1(i)
+          ok_q2m_toosmall(i)=q_zref(i).LT.q1(i).AND. &
+          & q_zref(i).LT.qsurf(i)
+          ok_q2m_toobig(i)=q_zref(i).GT.q1(i).AND. &
+          & q_zref(i).GT.qsurf(i)
+          ok_u2m_toobig(i)=u_zref(i).GT.speed(i)
+!
+          IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
+              n2mout(i,2)=n2mout(i,2)+1
+          ENDIF
+          IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
+              n2mout(i,4)=n2mout(i,4)+1
+          ENDIF
+          IF(ok_u2m_toobig(i)) THEN
+              n2mout(i,6)=n2mout(i,6)+1
+          ENDIF
+!
+          IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
+           & ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
+           & ok_u2m_toobig(i)) THEN 
+              delm(i)=min(max(delm(i),0.),1.)
+              delh(i)=min(max(delh(i),0.),1.)
+              u_zref(i) = delm(i)*speed(i)
+              q_zref(i) = delh(i)*max(q1(i),0.0) + &
+          &           max(qsurf(i),0.0)*(1-delh(i))
+              te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
+              temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+          ENDIF
+!
+!
+          IF(n.EQ.ncon) THEN
+            te_zref_con(i) = te_zref(i)
+            q_zref_con(i) = q_zref(i)
+          ENDIF 
+!
+        ENDDO 
+!
+      ENDDO 
+!
+      DO i = 1, knon
+        q_zref_c(i) = q_zref(i)
+        temp_c(i) = temp(i)
+!
+        ok_pred(i)=0.
+        ok_corr(i)=1.
+!
+        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+!
+        u_zref_c(i) = u_zref(i)
+        u_2m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
+      ENDDO
+!
+!
+!----------First aproximation of variables at zref --------------------------
+!
+      zref = 10.0
+!
+       CALL screencn(klon, knon, nsrf, zxli, &
+ &                   speed, tpot, q1, zref, &
+ &                   ts1, qsurf, z0m, z0h, psol, &           
+ &                   cdram, cdrah,  okri, &
+ &                   ri1, 1, &
+ &                   pref_new, delm_new, delh_new, ri10m)
+!
+       DO i = 1, knon
+         u_zref(i) = delm_new(i)*speed(i)
+         q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
+         &           max(qsurf(i),0.0)*(1-delh_new(i))
+         te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
+         temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
+         u_zref_p(i) = u_zref(i)
+!
+! compteurs ici
+!
+         ok_t10m_toosmall(i)=te_zref(i).LT.tpot(i).AND. &
+         & te_zref(i).LT.ts1(i)
+         ok_t10m_toobig(i)=te_zref(i).GT.tpot(i).AND. &
+         & te_zref(i).GT.ts1(i)
+         ok_q10m_toosmall(i)=q_zref(i).LT.q1(i).AND. &
+         & q_zref(i).LT.qsurf(i)
+         ok_q10m_toobig(i)=q_zref(i).GT.q1(i).AND. &
+         & q_zref(i).GT.qsurf(i)
+         ok_u10m_toobig(i)=u_zref(i).GT.speed(i)
+!
+         IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
+             n10mout(i,1)=n10mout(i,1)+1
+         ENDIF
+         IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
+             n10mout(i,3)=n10mout(i,3)+1
+         ENDIF
+         IF(ok_u10m_toobig(i)) THEN
+             n10mout(i,5)=n10mout(i,5)+1
+         ENDIF
+!
+         IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
+          & ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
+          & ok_u10m_toobig(i)) THEN 
+             delm_new(i)=min(max(delm_new(i),0.),1.)
+             delh_new(i)=min(max(delh_new(i),0.),1.)
+             u_zref(i) = delm_new(i)*speed(i)
+             u_zref_p(i) = u_zref(i)
+             q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
+         &               max(qsurf(i),0.0)*(1-delh_new(i))
+             te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
+             temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
+         ENDIF 
+!
+       ENDDO
+!
+! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
+!
+      DO n = 1, niter
+!
+        okri=.TRUE.
+        CALL screencn(klon, knon, nsrf, zxli, &
+ &                   u_zref, temp, q_zref, zref, &
+ &                   ts1, qsurf, z0m, z0h, psol, &
+ &                   cdram, cdrah,  okri, &
+ &                   ri1, 0, &
+ &                   pref, delm, delh, ri10m)
+!
+        DO i = 1, knon
+          u_zref(i) = delm(i)*speed(i)
+          q_zref(i) = delh(i)*max(q1(i),0.0) + &
+          &           max(qsurf(i),0.0)*(1-delh(i))
+          te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
+!
+! return to normal temperature
+          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+!
+! compteurs ici
+!
+          ok_t10m_toosmall(i)=te_zref(i).LT.tpot(i).AND. &
+          & te_zref(i).LT.ts1(i)
+          ok_t10m_toobig(i)=te_zref(i).GT.tpot(i).AND. &
+          & te_zref(i).GT.ts1(i)
+          ok_q10m_toosmall(i)=q_zref(i).LT.q1(i).AND. &
+          & q_zref(i).LT.qsurf(i)
+          ok_q10m_toobig(i)=q_zref(i).GT.q1(i).AND. &
+          & q_zref(i).GT.qsurf(i)
+          ok_u10m_toobig(i)=u_zref(i).GT.speed(i)
+!
+          IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
+              n10mout(i,2)=n10mout(i,2)+1
+          ENDIF
+          IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
+              n10mout(i,4)=n10mout(i,4)+1
+          ENDIF
+          IF(ok_u10m_toobig(i)) THEN
+              n10mout(i,6)=n10mout(i,6)+1
+          ENDIF
+!
+          IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
+           & ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
+           & ok_u10m_toobig(i)) THEN 
+              delm(i)=min(max(delm(i),0.),1.)
+              delh(i)=min(max(delh(i),0.),1.)
+              u_zref(i) = delm(i)*speed(i)
+              q_zref(i) = delh(i)*max(q1(i),0.0) + &
+          &           max(qsurf(i),0.0)*(1-delh(i))
+              te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
+              temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
+          ENDIF
+!
+!
+          IF(n.EQ.ncon) THEN
+            te_zref_con(i) = te_zref(i)
+            q_zref_con(i) = q_zref(i)
+          ENDIF 
+!
+        ENDDO 
+!
+      ENDDO 
+!
+      DO i = 1, knon
+        q_zref_c(i) = q_zref(i)
+        temp_c(i) = temp(i)
+!
+        ok_pred(i)=0.
+        ok_corr(i)=1.
+!
+        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
+        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
+!
+        u_zref_c(i) = u_zref(i)
+        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
+      ENDDO
+!
+      RETURN
+      END subroutine stdlevvarn
+
+END MODULE stdlevvar_mod
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/suphel.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/suphel.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/suphel.F90	(revision 3851)
@@ -131,4 +131,5 @@
   rcvv = rcpv - rv
   rkappa = rd/rcpd
+  eps_w = rmv / rmd
   retv = rv/rd - 1.
   WRITE (UNIT=6, FMT='('' *** Thermodynamic, gas     ***'')')
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_landice_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_landice_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_landice_mod.F90	(revision 3851)
@@ -25,5 +25,5 @@
 
     USE dimphy
-    USE surface_data,     ONLY : type_ocean, calice, calsno, ok_snow
+    USE surface_data,     ONLY : type_ocean, calice, calsno, landice_opt, n_dtis
     USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
     USE cpl_mod,          ONLY : cpl_send_landice_fields
@@ -36,4 +36,9 @@
     USE surf_sisvat_mod,  ONLY : surf_sisvat
 #endif
+
+#ifdef CPP_INLANDSIS
+    USE surf_inlandsis_mod,  ONLY : surf_inlandsis
+#endif
+
     USE indice_sol_mod
 
@@ -86,6 +91,6 @@
 !    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
 !    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2  ! new albedo in near IR interval
-    REAL, DIMENSION(6), INTENT(IN)              ::SFRWL
-    REAL, DIMENSION(klon,nsw), INTENT(OUT)        ::alb_dir,alb_dif
+    REAL, DIMENSION(6), INTENT(IN)                :: SFRWL
+    REAL, DIMENSION(klon,nsw), INTENT(OUT)        :: alb_dir,alb_dif
 !albedo SB <<<
     REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
@@ -108,16 +113,18 @@
     REAL, DIMENSION(klon)    :: zfra, alb_neig
     REAL, DIMENSION(klon)    :: radsol
-    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay
-    INTEGER                  :: i,j
+    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay, ustar
+    INTEGER                  :: i,j,nt
 
     REAL, DIMENSION(klon)    :: 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)    :: zsl_height, wind_velo      !surface layer height, wind spd
     REAL, DIMENSION(klon)    :: dens_air,  snow_cont_air  !air density; snow content air
     REAL, DIMENSION(klon)    :: alb_soil                  !albedo of underlying ice
     REAL, DIMENSION(klon)    :: pexner                    !Exner potential
     REAL                     :: pref
-    REAL, DIMENSION(klon,nsoilmx) :: tsoil0 !modfi
+    REAL, DIMENSION(klon,nsoilmx) :: tsoil0               !modif
+    REAL                          :: dtis                ! subtimestep
+    LOGICAL                       :: debut_is, lafin_is  ! debut and lafin for inlandsis
 
     CHARACTER (len = 20)                      :: modname = 'surf_landice'
@@ -139,7 +146,8 @@
   LOGICAL, SAVE :: firstcall = .TRUE.
   !$OMP THREADPRIVATE(firstcall)
-!FC
-
-
+
+
+!FC firtscall initializations
+!******************************************************************************************
   IF (firstcall) THEN
   alb_vis_sno_lic=0.77
@@ -149,7 +157,11 @@
   CALL getin_p('alb_nir_sno_lic',alb_nir_sno_lic)
            PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic
+  
+!  z0m=1.e-3
+!  z0h = z0m
   firstcall=.false.
   ENDIF
-!
+!******************************************************************************************
+
 ! Initialize output variables
     alb3(:) = 999999.
@@ -166,9 +178,16 @@
 
 !****************************************************************************************
-!   ok_snow = TRUE  : prepare and call SISVAT snow model
-!   ok_snow = FALSE : soil_model, calcul_flux, fonte_neige, ... 
-!
-!****************************************************************************************
-    IF (ok_snow) THEN
+!  landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ...  
+!  landice_opt = 1  : prepare and call SISVAT snow model
+!  landice_opt = 2  : prepare and call INLANDSIS snow model
+!****************************************************************************************
+
+
+    IF (landice_opt .EQ. 1) THEN
+    
+!****************************************************************************************
+! CALL to SISVAT interface
+!****************************************************************************************
+
 #ifdef CPP_SISVAT
        ! Prepare for calling SISVAT
@@ -192,11 +211,8 @@
           pexner(i)        = (p1lay(i)/pref)**(RD/RCPD)
           dens_air(i)      = p1lay(i)/RD/temp_air(i)  ! dry air density
-          bl_height(i)     = pphi1(i)/RG              
+          zsl_height(i)     = pphi1(i)/RG              
        END DO
 
-!****************************************************************************************
-! CALL to SISVAT interface
-!
-!****************************************************************************************
+
        ! config: compute everything with SV but temperatures afterwards with soil/calculfluxs
        DO i = 1, knon
@@ -209,5 +225,5 @@
             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, &
+            zsl_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, &
@@ -232,8 +248,87 @@
             flux_u1, flux_v1)
 #else
-       abort_message='Pb de coherence: ok_snow = .true. mais CPP_SISVAT = .false.'
+       abort_message='Pb de coherence: landice_opt = 1 mais CPP_SISVAT = .false.'
        CALL abort_physic(modname,abort_message,1)
 #endif
-    ELSE ! ok_snow=FALSE
+
+!****************************************************************************************
+! CALL to INLANDSIS interface
+!****************************************************************************************
+
+    ELSE IF (landice_opt .EQ. 2) THEN
+#ifdef CPP_INLANDSIS
+
+        debut_is=debut
+        lafin_is=.false.
+        ! Suppose zero surface speed
+        u0(:)            = 0.0
+        v0(:)            = 0.0
+
+
+        CALL calcul_flux_wind(knon, dtime, &
+         u0, v0, u1, v1, gustiness, cdragm, &
+         AcoefU, AcoefV, BcoefU, BcoefV, &
+         p1lay, temp_air, &
+         flux_u1, flux_v1)
+
+       
+       ! Set constants and compute some input for SISVAT
+       ! = 1000 hPa
+       ! and calculate incoming flux for SW and LW interval: swdown, lwdown
+       swdown(:)        = 0.0
+       lwdown(:)        = 0.0
+       snow_adv(:)      = 0.  ! no snow blown in for now
+       snow_cont_air(:) = 0.       
+       alb_soil(:)      = 0.4 ! before albedo(:) but here it is the ice albedo that we have to set
+       ustar(:)         = 0.
+       pref             = 100000.       
+       DO i = 1, knon
+          swdown(i)        = swnet(i)/(1-albedo(i))
+          lwdown(i)        = lwdownm(i)
+          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
+          zsl_height(i)    = pphi1(i)/RG      
+          tsoil0(i,:)      = tsoil(i,:)  
+          ustar(i)= (cdragm(i)*(wind_velo(i)**2))**0.5   
+       END DO
+       
+
+       ! Subtimestepping
+       
+        dtis=dtime/n_dtis
+
+        DO nt=1,n_dtis
+
+          IF (lafin .and. nt.eq.n_dtis) THEN
+            lafin_is=.true.
+          END IF
+
+        !PRINT*,'RENTRE DANS INLANDSIS','itime',itime,'dtime',dtime,'dtis',dtis
+        CALL surf_inlandsis(knon, rlon, rlat, knindex, itime, dtis, debut_is, lafin_is, &
+            rmu0, swdown, lwdown, albedo, pexner, ps, p1lay, &
+            precip_rain, precip_snow, precip_snow_adv, snow_adv, &
+            zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf, &
+            rugoro, snow_cont_air, alb_soil, slope, cloudf, &
+            radsol, qsol, tsoil0, snow, zfra, snowhgt, qsnow, to_ice,sissnow, agesno, &
+            AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
+            run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &        
+            tsurf_new, alb1, alb2, alb3, &
+            emis_new, z0m, z0h, qsurf)      
+
+         debut_is=.false.
+
+        END DO
+
+
+#else
+       abort_message='Pb de coherence: landice_opt = 2 mais CPP_INLANDSIS = .false.'
+       CALL abort_physic(modname,abort_message,1)
+#endif
+
+
+
+    ELSE 
 
 !****************************************************************************************
@@ -241,4 +336,10 @@
 ! 
 !****************************************************************************************
+
+    ! EV: use calbeta
+    CALL calbeta(dtime, is_lic, knon, snow, qsol, beta, cal, dif_grnd)
+
+
+    ! use soil model and recalculate properly cal
     IF (soil_model) THEN 
        CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
@@ -255,6 +356,6 @@
 !
 !****************************************************************************************
-    beta(:) = 1.0
-    dif_grnd(:) = 0.0
+!    beta(:) = 1.0
+!    dif_grnd(:) = 0.0
 
 ! Suppose zero surface speed
@@ -281,5 +382,5 @@
 !    
 !****************************************************************************************
-    CALL fonte_neige( knon, is_lic, knindex, dtime, &
+    CALL fonte_neige(knon, is_lic, knindex, dtime, &
          tsurf, precip_rain, precip_snow, &
          snow, qsol, tsurf_new, evap)
@@ -291,4 +392,5 @@
 !****************************************************************************************
     CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
+
     WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
     zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
@@ -303,5 +405,5 @@
 !IM: KstaTER0.77 & LMD_ARMIP6    
 
-! Attantion: alb1 and alb2 are the same!
+! Attantion: alb1 and alb2 are not the same!
     alb1(1:knon)  = alb_vis_sno_lic
     alb2(1:knon)  = alb_nir_sno_lic
@@ -316,5 +418,10 @@
     z0m = SQRT(z0m**2+rugoro**2)
 
-    END IF ! ok_snow
+
+
+
+    
+
+    END IF ! landice_opt
 
 
@@ -333,12 +440,13 @@
   
 !****************************************************************************************
-       snow_o=0.
-       zfra_o = 0.
-       DO j = 1, knon
-           i = knindex(j)
-           snow_o(i) = snow(j) 
-           zfra_o(i) = zfra(j)
-       ENDDO
-
+! Etienne: comment these lines because of duplication just below
+!       snow_o=0.
+!       zfra_o = 0.
+!       DO j = 1, knon
+!           i = knindex(j)
+!           snow_o(i) = snow(j) 
+!           zfra_o(i) = zfra(j)
+!       ENDDO
+!
 !****************************************************************************************
        snow_o=0.
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_ocean_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_ocean_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_ocean_mod.F90	(revision 3851)
@@ -20,7 +20,9 @@
        z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
        tsurf_new, dflux_s, dflux_l, lmt_bils, &
-       flux_u1, flux_v1)
+       flux_u1, flux_v1, delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, tkt, tks, &
+       taur, sss)
 
     use albedo, only: alboc, alboc_cd
+    use bulk_flux_m, only: bulk_flux
     USE dimphy, ONLY: klon, zmasq
     USE surface_data, ONLY     : type_ocean
@@ -30,4 +32,5 @@
     USE indice_sol_mod, ONLY : nbsrf, is_oce
     USE limit_read_mod
+    use config_ocean_skin_m, only: activate_ocean_skin
     !
     ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, 
@@ -50,8 +53,8 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface  
     REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
+    REAL, DIMENSION(klon), INTENT(IN)        :: windsp ! wind at 10 m, in m s-1
     REAL, DIMENSION(klon), INTENT(IN)        :: rmu0  
     REAL, DIMENSION(klon), INTENT(IN)        :: fder
-    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
+    REAL, INTENT(IN):: tsurf_in(klon) ! defined only for subscripts 1:knon
     REAL, DIMENSION(klon), INTENT(IN)        :: p1lay,z1lay ! pression (Pa) et altitude (m) du premier niveau
     REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
@@ -73,6 +76,24 @@
     REAL, DIMENSION(klon), INTENT(inOUT):: z0h
 
+    REAL, intent(inout):: delta_sst(:) ! (knon)
+    ! Ocean-air interface temperature minus bulk SST, in K. Defined
+    ! only if activate_ocean_skin >= 1.
+
+    real, intent(inout):: delta_sal(:) ! (knon)
+    ! Ocean-air interface salinity minus bulk salinity, in ppt. Defined
+    ! only if activate_ocean_skin >= 1.
+
+    REAL, intent(inout):: ds_ns(:) ! (knon)
+    ! "delta salinity near surface". Salinity variation in the
+    ! near-surface turbulent layer. That is subskin salinity minus
+    ! foundation salinity. In ppt.
+
+    REAL, intent(inout):: dt_ns(:) ! (knon)
+    ! "delta temperature near surface". Temperature variation in the
+    ! near-surface turbulent layer. That is subskin temperature
+    ! minus foundation temperature. (Can be negative.) In K.
+
     ! Output variables
-    !******************************************************************************
+    !**************************************************************************
     REAL, DIMENSION(klon), INTENT(OUT)       :: z0m
     !albedo SB >>>
@@ -83,11 +104,35 @@
     !albedo SB <<<     
     REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
+    REAL, INTENT(OUT):: tsurf_new(klon) ! sea surface temperature, in K
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
     REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
     REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
 
+    REAL, intent(out):: dter(:) ! (knon)
+    ! Temperature variation in the diffusive microlayer, that is
+    ! ocean-air interface temperature minus subskin temperature. In
+    ! K.
+
+    REAL, intent(out):: dser(:) ! (knon)
+    ! Salinity variation in the diffusive microlayer, that is
+    ! ocean-air interface salinity minus subskin salinity. In ppt.
+
+    REAL, intent(out):: tkt(:) ! (knon)
+    ! épaisseur (m) de la couche de diffusion thermique (microlayer)
+    ! cool skin thickness
+
+    REAL, intent(out):: tks(:) ! (knon)
+    ! épaisseur (m) de la couche de diffusion de masse (microlayer)
+
+    REAL, intent(out):: taur(:) ! (knon)
+    ! momentum flux due to rain, in Pa
+
+    real, intent(out):: sss(:) ! (klon)
+    ! Bulk salinity of the surface layer of the ocean, in ppt. (Only
+    ! defined for subscripts 1:knon, but we have to declare it with
+    ! size klon because of the coupling machinery.)
+
     ! Local variables
-    !******************************************************************************
+    !*************************************************************************
     INTEGER               :: i, k
     REAL                  :: tmp
@@ -97,7 +142,11 @@
     REAL, DIMENSION(klon) :: cdragq ! Cdrag pour l'evaporation
     CHARACTER(len=20),PARAMETER :: modname="surf_ocean"
-
-    ! End definition
-    !******************************************************************************
+    real rhoa(knon) ! density of moist air  (kg / m3)
+    REAL sens_prec_liq(knon)
+
+    REAL t_int(knon) ! ocean-air interface temperature, in K
+    real s_int(knon) ! ocean-air interface salinity, in ppt
+
+    !**************************************************************************
 
 
@@ -126,5 +175,5 @@
     ENDIF
 
-
+    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
     !******************************************************************************
     ! Switch according to type of ocean (couple, slab or forced)
@@ -139,8 +188,9 @@
             AcoefH, AcoefQ, BcoefH, BcoefQ, &
             AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, &
+            ps, u1, v1, gustiness, tsurf_in, &
             radsol, snow, agesno, &
             qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l)
+            tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
+            delta_sst)
 
     CASE('slab')
@@ -162,8 +212,8 @@
             AcoefH, AcoefQ, BcoefH, BcoefQ, &
             AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, &
+            ps, u1, v1, gustiness, tsurf_in, &
             radsol, snow, agesno, &
             qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l)
+            tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa)
     END SELECT
 
@@ -268,8 +318,22 @@
        CALL abort_physic(modname,'version non prevue',1)
     ENDIF
-    !
-    !******************************************************************************
+
+    if (activate_ocean_skin >= 1) then
+       if (type_ocean /= 'couple') sss(:knon) = 35.
+       call bulk_flux(tkt, tks, taur, dter, dser, t_int, s_int, ds_ns, dt_ns, &
+            u = windsp(:knon), t_ocean_1 = tsurf_new(:knon), s1 = sss(:knon), &
+            rain = precip_rain(:knon) + precip_snow(:knon), &
+            hf = - fluxsens(:knon), hlb = - fluxlat(:knon), &
+            rnl = - lwnet(:knon), &
+            tau = sqrt(flux_u1(:knon)**2 + flux_v1(:knon)**2), rhoa = rhoa, &
+            xlv = [(rlvtt, i = 1, knon)], rf = - sens_prec_liq, dtime = dtime, &
+            rns = swnet(:knon))
+       delta_sst = t_int - tsurf_new(:knon)
+       delta_sal = s_int - sss(:knon)
+       if (activate_ocean_skin >= 2) tsurf_new(:knon) = t_int
+    end if
+    
   END SUBROUTINE surf_ocean
-  !******************************************************************************
+  !****************************************************************************
   !
 END MODULE surf_ocean_mod
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_seaice_mod.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_seaice_mod.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/surf_seaice_mod.F90	(revision 3851)
@@ -37,4 +37,7 @@
     INCLUDE "dimsoil.h"
     INCLUDE "clesphys.h"
+
+    INCLUDE "YOMCST.h"
+    ! for rd and retv
 
 ! Input arguments
@@ -87,5 +90,7 @@
     REAL, DIMENSION(klon) :: alb1_new,alb2_new
 !albedo SB <<<
-!
+
+    real rhoa(knon) ! density of moist air  (kg / m3)
+
 ! End definitions
 !****************************************************************************************
@@ -98,4 +103,6 @@
     radsol(:) = 0.0
     radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
 
 !****************************************************************************************
@@ -116,5 +123,5 @@
             radsol, snow, qsurf, &
             alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l)
+            tsurf_new, dflux_s, dflux_l, rhoa)
        
     ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
@@ -138,5 +145,5 @@
             radsol, snow, qsol, agesno, tsoil, &
             qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l)
+            tsurf_new, dflux_s, dflux_l, rhoa)
 
     END IF
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/surface_data.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/surface_data.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/surface_data.F90	(revision 3851)
@@ -15,7 +15,4 @@
   !$OMP THREADPRIVATE(type_veget)
 
-  LOGICAL, SAVE          :: ok_snow       ! true for coupling to snow model SISVAT
-  !$OMP THREADPRIVATE(ok_snow)
-
   CHARACTER(len=6), SAVE :: type_ocean    ! force/slab/couple
   !$OMP THREADPRIVATE(type_ocean)
@@ -30,3 +27,22 @@
   !$OMP THREADPRIVATE(t_coupl)
 
+  ! FOR INLANDSIS:
+  !===============
+
+   INTEGER, SAVE          :: landice_opt       ! 1 for coupling with SISVAT, 2 for coupling with INLANDSIS
+  !$OMP THREADPRIVATE(landice_opt)
+
+   INTEGER, SAVE          :: iflag_tsurf_inlandsis ! 0 SISVAT method, 1 LMDZ method
+  !$OMP THREADPRIVATE(iflag_tsurf_inlandsis)
+
+   INTEGER, SAVE          :: iflag_albzenith ! dependency of albedo to zenith angle
+  !$OMP THREADPRIVATE(iflag_albzenith)  
+
+   INTEGER, SAVE          :: n_dtis           ! number of subtimesteps for INLANDSIS
+  !$OMP THREADPRIVATE(n_dtis)
+
+  ! with or without snow module/ blowing snow, ascii outfile
+   LOGICAL, SAVE           :: SnoMod,BloMod,ok_outfor 
+  !$OMP THREADPRIVATE(SnoMod,BloMod,ok_outfor)    
+
 END MODULE surface_data
Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/yamada4.F90
===================================================================
--- LMDZ6/branches/LMDZ-tracers/libf/phylmd/yamada4.F90	(revision 3725)
+++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/yamada4.F90	(revision 3851)
@@ -6,5 +6,6 @@
   USE dimphy
   USE ioipsl_getin_p_mod, ONLY : getin_p
-
+  USE phys_local_var_mod, only: tke_dissip
+  
   IMPLICIT NONE
   include "iniprint.h"
@@ -56,8 +57,10 @@
   !             iflag_pbl=11 -> the model starts with NP from start files created by ce0l
   !                          -> the model can run with longer time-steps.
-  !             2016/11/30 (EV etienne.vignon@univ-grenoble-alpes.fr)
+  !             2016/11/30 (EV etienne.vignon@lmd.ipsl.fr)
   !               On met tke (=q2/2) en entr??e plut??t que q2
   !               On corrige l'update de la tke
-  !
+  !             2020/10/01 (EV)
+  !               On ajoute la dissipation de la TKE en diagnostique de sortie
+  !                  
   ! Inpout/Output :
   !==============
@@ -121,5 +124,5 @@
   REAL,SAVE :: viscom,viscoh
   !$OMP THREADPRIVATE( hboville,viscom,viscoh)
-  INTEGER ig, k
+  INTEGER ig, jg, k
   REAL ri, zrif, zalpha, zsm, zsn
   REAL rif(klon, klev+1), sm(klon, klev+1), alpha(klon, klev)
@@ -186,4 +189,5 @@
        viscom=1.46E-5
        viscoh=2.06E-5
+       !lmixmin=1.0E-3
        lmixmin=0.
        yamada4_num=5
@@ -416,4 +420,9 @@
   ELSE IF (iflag_pbl>=10) THEN
 
+    shear(:,:)=0.
+    buoy(:,:)=0.
+    dissip(:,:)=0.
+    km(:,:)=0.
+        
     IF (yamada4_num>=1) THEN
  
@@ -424,8 +433,9 @@
       shear(ig,k)=km(ig, k)*m2(ig, k)
       buoy(ig,k)=km(ig, k)*m2(ig, k)*(-1.*rif(ig,k))
-      dissip(ig,k)=((sqrt(q2(ig,k)))**3)/(b1*l(ig,k))
+!      dissip(ig,k)=min(max(((sqrt(q2(ig,k)))**3)/(b1*l(ig,k)),1.E-12),1.E4)
+      dissip(ig,k)=((sqrt(q2(ig,k)))**3)/(b1*l(ig,k)) 
      ENDDO
     ENDDO
-
+    
     IF (yamada4_num==1) THEN ! Schema du MAR tel quel
        DO k = 2, klev - 1
@@ -478,4 +488,9 @@
         ENDDO
        ENDDO
+       
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Attention, yamada4_num=5 est inexacte car néglige les termes de flottabilité
+      !! en conditions instables
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     ELSE IF (yamada4_num==5) THEN ! version modifiee avec integration exacte pour la dissipation
        DO k = 2, klev - 1
@@ -507,13 +522,23 @@
        DO k = 2, klev - 1
          DO ig=1,ngrid
+         !tkeprov=q2(ig,k)/ydeux
+         !tkeprov=tkeprov+max(buoy(ig,k)+shear(ig,k),0.)*dt
+         !disseff=dissip(ig,k)-min(0.,buoy(ig,k)+shear(ig,k)) 
+         !tkeexp=exp(-dt*disseff/tkeprov)
+         !tkeprov= tkeprov*tkeexp
+         !q2(ig,k)=tkeprov*ydeux
+         ! En cas stable, on traite la flotabilite comme la
+         ! dissipation, en supposant que dissipeff/TKE est constant.
+         ! Puis on prend la solution exacte
+         ! 
+         ! With drag and dissipation from high vegetation (EV & FC, 05/10/2020)
+         winds(ig,k)=sqrt(u(ig,k)**2+v(ig,k)**2)
          tkeprov=q2(ig,k)/ydeux
-         tkeprov=tkeprov+max(buoy(ig,k)+shear(ig,k),0.)*dt
-         disseff=dissip(ig,k)-min(0.,buoy(ig,k)+shear(ig,k))
+         tkeprov=tkeprov+max(buoy(ig,k)+shear(ig,k)+drgpro(ig,k)*(winds(ig,k))**3,0.)*dt
+         disseff=dissip(ig,k)-min(0.,buoy(ig,k)+shear(ig,k)+drgpro(ig,k)*(winds(ig,k))**3) + drgpro(ig,k)*tkeprov
          tkeexp=exp(-dt*disseff/tkeprov)
          tkeprov= tkeprov*tkeexp
          q2(ig,k)=tkeprov*ydeux
-         ! En cas stable, on traite la flotabilite comme la
-         ! dissipation, en supposant que buoy/q2^3 est constant.
-         ! Puis on prend la solution exacte
+         
         ENDDO
        ENDDO
@@ -725,4 +750,17 @@
 
 !============================================================================
+! Diagnostique de la dissipation
+!============================================================================
+
+! Diagnostics
+ tke_dissip(1:ngrid,:,nsrf)=0.
+! DO k=2,klev
+!    DO ig=1,ngrid
+!       jg=ni(ig)
+!       tke_dissip(jg,k,nsrf)=dissip(ig,k)
+!    ENDDO
+! ENDDO
+ 
+!=============================================================================
 
   RETURN
@@ -1017,5 +1055,5 @@
 !=====================================================================
 
-
+  l1(1:ngrid,:)=0.
   IF (iflag_pbl==8 .OR. iflag_pbl==10) THEN
 
@@ -1135,5 +1173,5 @@
 
 
- DO k=2,klev
+ DO k=1,klev+1
     DO ig=1,ngrid
        lmix(ig,k)=MAX(MAX(l1(ig,k), l2(ig,k)),lmixmin)
