Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 8568)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 8586)
@@ -1,7 +1,7 @@
 MODULE ice
    !!======================================================================
-   !!                        ***  MODULE ice  ***
-   !! LIM-3 Sea Ice physics:  diagnostics variables of ice defined in memory
-   !!=====================================================================
+   !!                        ***  MODULE  ice  ***
+   !!   sea-ice:  ice variables defined in memory
+   !!======================================================================
    !! History :  3.0  ! 2008-03  (M. Vancoppenolle) original code LIM-3
    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
@@ -9,5 +9,5 @@
 #if defined key_lim3
    !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!   'key_lim3'                                       ESIM sea-ice model
    !!----------------------------------------------------------------------
    USE in_out_manager ! I/O manager
@@ -17,5 +17,5 @@
    PRIVATE
 
-   PUBLIC    ice_alloc  !  Called in sbc_lim_init
+   PUBLIC   ice_alloc   ! called by icestp.F90
 
    !!======================================================================
@@ -63,21 +63,20 @@
    !!   meaningful and/or used in ice thermodynamics                      |
    !!                                                                     |
-   !! Routines in limvar.F90 perform conversions                          |
-   !!  - lim_var_glo2eqv  : from global to equivalent variables           |
-   !!  - lim_var_eqv2glo  : from equivalent to global variables           |
+   !! Routines in icevar.F90 perform conversions                          |
+   !!  - ice_var_glo2eqv  : from global to equivalent variables           |
+   !!  - ice_var_eqv2glo  : from equivalent to global variables           |
    !!                                                                     |
    !! For various purposes, the sea ice state variables have sometimes    |
    !! to be aggregated over all ice thickness categories. This operation  |
    !! is done in :                                                        |
-   !!  - lim_var_agg                                                      |
+   !!  - ice_var_agg                                                      |
    !!                                                                     |
    !! in icestp.F90, the routines that compute the changes in the ice     |
    !! state variables are called                                          |
-   !! - lim_dyn : ice dynamics                                            |
-   !! - lim_trp : ice transport                                           |
-   !! - lim_itd_me : mechanical redistribution (ridging and rafting)      |
-   !! - lim_thd : ice halo-thermodynamics                                 |
-   !! - lim_itd_th : thermodynamic changes in ice thickness distribution  |
-   !!                and creation of new ice                              |
+   !! - ice_rhg : ice dynamics                                            |
+   !! - ice_adv : ice advection                                           |
+   !! - ice_rdgrft : ice ridging and rafting                              |
+   !! - ice_thd : ice halo-thermodynamics and creation of new ice         |
+   !! - ice_itd : thermodynamic changes in ice thickness distribution     |
    !!                                                                     |
    !! See the associated routines for more information                    |
@@ -107,10 +106,10 @@
    !! v_i         |      -      |    Ice volume per unit area     | m     |
    !! v_s         |      -      |    Snow volume per unit area    | m     |
-   !! smv_i       |      -      |    Sea ice salt content         | ppt.m |
-   !! oa_i        !      -      !    Sea ice areal age content    | day   |
+   !! sv_i        |      -      |    Sea ice salt content         | ppt.m |
+   !! oa_i        !      -      !    Sea ice areal age content    | s     |
    !! e_i         !      -      !    Ice enthalpy                 | J/m2  | 
-   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  | 
+   !!      -      ! e_i_1d      !    Ice enthalpy per unit vol.   | J/m3  | 
    !! e_s         !      -      !    Snow enthalpy                | J/m2  | 
-   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  | 
+   !!      -      ! e_s_1d      !    Snow enthalpy per unit vol.  | J/m3  | 
    !!                                                                     |
    !!-------------|-------------|---------------------------------|-------|
@@ -119,9 +118,9 @@
    !!-------------|-------------|---------------------------------|-------|
    !!                                                                     |
-   !! ht_i        | ht_i_1d     |    Ice thickness                | m     |
-   !! ht_s        ! ht_s_1d     |    Snow depth                   | m     |
-   !! sm_i        ! sm_i_1d     |    Sea ice bulk salinity        ! ppt   |
-   !! s_i         ! s_i_1d      |    Sea ice salinity profile     ! ppt   |
-   !! o_i         !      -      |    Sea ice Age                  ! days  |
+   !! h_i         | h_i_1d      |    Ice thickness                | m     |
+   !! h_s         ! h_s_1d      |    Snow depth                   | m     |
+   !! s_i         ! s_i_1d      |    Sea ice bulk salinity        ! ppt   |
+   !! sz_i        ! sz_i_1d     |    Sea ice salinity profile     ! ppt   |
+   !! o_i         !      -      |    Sea ice Age                  ! s     |
    !! t_i         ! t_i_1d      |    Sea ice temperature          ! K     |
    !! t_s         ! t_s_1d      |    Snow temperature             ! K     |
@@ -144,5 +143,5 @@
    !! vt_i        |      -      |    Total ice vol. per unit area | m     |
    !! vt_s        |      -      |    Total snow vol. per unit ar. | m     |
-   !! smt_i       |      -      |    Mean sea ice salinity        | ppt   |
+   !! sm_i        |      -      |    Mean sea ice salinity        | ppt   |
    !! tm_i        |      -      |    Mean sea ice temperature     | K     |
    !! et_i        !      -      !    Total ice enthalpy           | J/m2  | 
@@ -151,13 +150,14 @@
    !!=====================================================================
 
-   LOGICAL, PUBLIC ::   con_i = .false.   ! switch for conservation test
-
-   !!--------------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    !! * Share Module variables
-   !!--------------------------------------------------------------------------
-   !                                     !!** ice-generic parameters namelist (namicerun) **
+   !!----------------------------------------------------------------------
+   !                                     !!** ice-generic parameters namelist (nampar) **
    INTEGER           , PUBLIC ::   jpl             !: number of ice  categories 
    INTEGER           , PUBLIC ::   nlay_i          !: number of ice  layers 
    INTEGER           , PUBLIC ::   nlay_s          !: number of snow layers 
+   INTEGER           , PUBLIC ::   nn_monocat      !: virtual ITD mono-category parameterizations (1-4) or not (0)
+   LOGICAL           , PUBLIC ::   ln_icedyn       !: flag for ice dynamics (T) or not (F)
+   LOGICAL           , PUBLIC ::   ln_icethd       !: flag for ice thermo   (T) or not (F)
    REAL(wp)          , PUBLIC ::   rn_amax_n       !: maximum ice concentration Northern hemisphere
    REAL(wp)          , PUBLIC ::   rn_amax_s       !: maximum ice concentration Southern hemisphere
@@ -166,90 +166,34 @@
    CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory
    CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory
-   LOGICAL           , PUBLIC ::   ln_limthd       !: flag for ice thermo (T) or not (F)
-   LOGICAL           , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
-   INTEGER           , PUBLIC ::   nn_limdyn       !: flag for ice dynamics
-   REAL(wp)          , PUBLIC ::   rn_uice         !: prescribed u-vel (case nn_limdyn=0)
-   REAL(wp)          , PUBLIC ::   rn_vice         !: prescribed v-vel (case nn_limdyn=0)
+
+   !                                     !!** ice-itd namelist (namitd) **
+   REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness
    
-   !                                     !!** ice-diagnostics namelist (namicediag) **
-   LOGICAL , PUBLIC ::   ln_limdiachk     !: flag for ice diag (T) or not (F)
-   LOGICAL , PUBLIC ::   ln_limdiahsb     !: flag for ice diag (T) or not (F)
-   LOGICAL , PUBLIC ::   ln_limctl        !: flag for sea-ice points output (T) or not (F)
-   INTEGER , PUBLIC ::   iiceprt          !: debug i-point
-   INTEGER , PUBLIC ::   jiceprt          !: debug j-point
-
-   !                                     !!** ice-init namelist (namiceini) **
-                                          ! -- limistate -- !
-   LOGICAL , PUBLIC ::   ln_limini        ! initialization or not
-   LOGICAL , PUBLIC ::   ln_limini_file   ! Ice initialization state from 2D netcdf file
-   REAL(wp), PUBLIC ::   rn_thres_sst     ! threshold water temperature for initial sea ice
-   REAL(wp), PUBLIC ::   rn_hts_ini_n     ! initial snow thickness in the north
-   REAL(wp), PUBLIC ::   rn_hts_ini_s     ! initial snow thickness in the south
-   REAL(wp), PUBLIC ::   rn_hti_ini_n     ! initial ice thickness in the north
-   REAL(wp), PUBLIC ::   rn_hti_ini_s     ! initial ice thickness in the south
-   REAL(wp), PUBLIC ::   rn_ati_ini_n     ! initial leads area in the north
-   REAL(wp), PUBLIC ::   rn_ati_ini_s     ! initial leads area in the south
-   REAL(wp), PUBLIC ::   rn_smi_ini_n     ! initial salinity 
-   REAL(wp), PUBLIC ::   rn_smi_ini_s     ! initial salinity
-   REAL(wp), PUBLIC ::   rn_tmi_ini_n     ! initial temperature
-   REAL(wp), PUBLIC ::   rn_tmi_ini_s     ! initial temperature
-   
-   !                                     !!** ice-thickness distribution namelist (namiceitd) **
-   INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2)
-   REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only)
-
-   !                                     !!** ice-dynamics namelist (namicedyn) **
-                                          ! -- limtrp & limadv -- !
-   INTEGER , PUBLIC ::   nn_limadv        !: choose the advection scheme (-1=Prather ; 0=Ultimate-Macho)
-   INTEGER , PUBLIC ::   nn_limadv_ord    !: choose the order of the advection scheme (if Ultimate-Macho)   
-                                          ! -- limitd_me -- !
-   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75)
-   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1
-   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength, Hibler JPO79
-   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength
-   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength
-                                          ! -- limdyn & limrhg -- !
-   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress
+   !                                     !!** ice-dynamics namelist (namdyn) **
+   REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice
+   LOGICAL , PUBLIC ::   ln_landfast      !: landfast ice parameterization (T or F) 
+   REAL(wp), PUBLIC ::   rn_gamma         !:    fraction of ocean depth that ice must reach to initiate landfast ice
+   REAL(wp), PUBLIC ::   rn_icebfr        !:    maximum bottom stress per unit area of contact (landfast ice) 
+   REAL(wp), PUBLIC ::   rn_lfrelax       !:    relaxation time scale (s-1) to reach static friction (landfast ice) 
+   !
+   !                                     !!** ice-rheology namelist (namrhg) **
    REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9
    REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve
    INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling
    REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
-   LOGICAL , PUBLIC ::   ln_landfast      !: landfast ice parameterization (T or F) 
-   REAL(wp), PUBLIC ::   rn_gamma         !: fraction of ocean depth that ice must reach to initiate landfast ice
-   REAL(wp), PUBLIC ::   rn_icebfr        !: maximum bottom stress per unit area of contact (landfast ice) 
-   REAL(wp), PUBLIC ::   rn_lfrelax       !: relaxation time scale (s-1) to reach static friction (landfast ice) 
-
-   !                                     !!** ice-diffusion namelist (namicehdf) **
-   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation)
-   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s)
-
-   !                                     !!** ice-thermodynamics namelist (namicethd) **
-                                          ! -- limthd_dif -- !
-   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
-   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion
-   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion
-   INTEGER , PUBLIC ::   nn_ice_thcon     !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
-   LOGICAL , PUBLIC ::   ln_it_qnsice     !: iterate surface flux with changing surface temperature or not (F)
-   INTEGER , PUBLIC ::   nn_monocat       !: virtual ITD mono-category parameterizations (1) or not (0)
-   REAL(wp), PUBLIC ::   rn_cdsn          !: thermal conductivity of the snow [W/m/K]
-                                          ! -- limthd_dh -- !
-   LOGICAL , PUBLIC ::   ln_limdH         !: activate ice thickness change from growing/melting (T) or not (F)
-   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice
-                                          ! -- limthd_da -- !
-   LOGICAL , PUBLIC ::   ln_limdA         !: activate lateral melting param. (T) or not (F)
-   REAL(wp), PUBLIC ::   rn_beta          !: coef. beta for lateral melting param.
-   REAL(wp), PUBLIC ::   rn_dmin          !: minimum floe diameter for lateral melting param.
-                                          ! -- limthd_lac -- !
-   LOGICAL , PUBLIC ::   ln_limdO         !: activate ice growth in open-water (T) or not (F)
-   REAL(wp), PUBLIC ::   rn_hnewice       !: thickness for new ice formation (m)
-   LOGICAL , PUBLIC ::   ln_frazil        !: use of frazil ice collection as function of wind (T) or not (F)
-   REAL(wp), PUBLIC ::   rn_maxfrazb      !: maximum portion of frazil ice collecting at the ice bottom
-   REAL(wp), PUBLIC ::   rn_vfrazb        !: threshold drift speed for collection of bottom frazil ice
-   REAL(wp), PUBLIC ::   rn_Cfrazb        !: squeezing coefficient for collection of bottom frazil ice
-                                          ! -- limitd_th -- !
-   REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness
-
-   !                                     !!** ice-salinity namelist (namicesal) **
-   LOGICAL , PUBLIC ::   ln_limdS         !: activate gravity drainage and flushing (T) or not (F)
+   !
+   !                                     !!** ice-surface forcing namelist (namforcing) **
+                                          ! -- icethd_dh -- !
+   REAL(wp), PUBLIC ::   rn_blow_s        !: coef. for partitioning of snowfall between leads and sea ice
+                                          ! -- icethd -- !
+   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress
+   INTEGER , PUBLIC ::   nn_iceflx        !: Redistribute heat flux over ice categories
+   !                                      !   =-1  Do nothing (needs N(cat) fluxes)
+   !                                      !   = 0  Average N(cat) fluxes then apply the average over the N(cat) ice 
+   !                                      !   = 1  Average N(cat) fluxes then redistribute over the N(cat) ice
+   !                                      !                                   using T-ice and albedo sensitivity
+   !                                      !   = 2  Redistribute a single flux over categories
+
+   !                                     !!** ice-salinity namelist (namthd_sal) **
    INTEGER , PUBLIC ::   nn_icesal        !: salinity configuration used in the model
    !                                      ! 1 - constant salinity in both space and time
@@ -257,30 +201,25 @@
    !                                      ! 3 - salinity profile, constant in time
    REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity
-   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU]
-   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s]
-   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU]
-   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s]
    REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU]
    REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU]
 
-   !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
-   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging            
-   INTEGER , PUBLIC ::   nn_partfun       !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
-   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging
-   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function
-   LOGICAL , PUBLIC ::   ln_ridging       !: ridging of ice or not                        
-   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice
-   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value)
-   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging
-   LOGICAL , PUBLIC ::   ln_rafting       !: rafting of ice or not                        
-   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging 
-   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting
-   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging
+   ! MV MP 2016
+   !                                     !!** melt pond namelist (nammp)
+   LOGICAL , PUBLIC ::   ln_pnd           !: activate ponds or not
+   LOGICAL , PUBLIC ::   ln_pnd_rad       !: ponds radiatively active or not
+   LOGICAL , PUBLIC ::   ln_pnd_fw        !: ponds active wrt meltwater or not
+   INTEGER , PUBLIC ::   nn_pnd_scheme    !: type of melt pond scheme:   =0 prescribed, =1 empirical, =2 topographic
+   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1), only if nn_pnd_scheme = 0
+   REAL(wp), PUBLIC ::   rn_hpnd          !: prescribed pond depth    (0<rn_hpnd<1), only if nn_pnd_scheme = 0
+   ! END MV MP 2016
+   !                                     !!** ice-diagnostics namelist (namdia) **
+   LOGICAL , PUBLIC ::   ln_icediachk     !: flag for ice diag (T) or not (F)
+   LOGICAL , PUBLIC ::   ln_icediahsb     !: flag for ice diag (T) or not (F)
+   LOGICAL , PUBLIC ::   ln_icectl        !: flag for sea-ice points output (T) or not (F)
+   INTEGER , PUBLIC ::   iiceprt          !: debug i-point
+   INTEGER , PUBLIC ::   jiceprt          !: debug j-point
 
    !                                     !!** some other parameters 
-   INTEGER , PUBLIC ::   nstart           !: iteration number of the begining of the run 
-   INTEGER , PUBLIC ::   nlast            !: iteration number of the end of the run 
-   INTEGER , PUBLIC ::   nitrun           !: number of iteration
-   INTEGER , PUBLIC ::   numit            !: iteration number
+   INTEGER , PUBLIC ::   kt_ice           !: iteration number
    REAL(wp), PUBLIC ::   rdt_ice          !: ice time step
    REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice
@@ -288,12 +227,13 @@
    REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s 
    REAL(wp), PUBLIC ::   rswitch          !: switch for the presence of ice (1) or not (0)
-   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number 
-   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number 
-   REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number 
+   REAL(wp), PUBLIC ::   rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft   !: conservation diagnostics
+   REAL(wp), PUBLIC, PARAMETER ::   epsi06 = 1.e-06_wp  !: small number 
+   REAL(wp), PUBLIC, PARAMETER ::   epsi10 = 1.e-10_wp  !: small number 
+   REAL(wp), PUBLIC, PARAMETER ::   epsi20 = 1.e-20_wp  !: small number 
+
 
    !                                     !!** define arrays
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce !: surface ocean velocity used in ice dynamics
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicol       !: ice collection thickness accreted in leads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce,v_oce !: surface ocean velocity used in ice dynamics
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_i_new    !: ice collection thickness accreted in leads
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element
@@ -303,7 +243,4 @@
    !
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]     
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean
@@ -311,6 +248,15 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: snow-ocean mass exchange   [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sni !: snow ice growth component of wfx_snw [kg.m-2.s-1]
+   ! MV MP 2016
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sum !: surface melt component of wfx_snw [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_pnd     !: melt pond-ocean mass exchange   [kg.m-2.s-1]
+   ! END MV MP 2016
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: snow precipitation on ice  [kg.m-2.s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: snow/ice sublimation       [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: sublimation of snow/ice    [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sub !: snow sublimation           [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice_sub !: ice sublimation            [kg.m-2.s-1]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_dyn !: dynamical component of wfx_snw    [kg.m-2.s-1]
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: ice-ocean mass exchange                   [kg.m-2.s-1]
@@ -325,6 +271,4 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)          [s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics)       [s-1]
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s]
@@ -346,5 +290,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice   [W.m-2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                          [W.m-2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion             [W.m-2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping             [W.m-2]
@@ -358,27 +301,25 @@
 
    ! heat flux associated with ice-ocean mass exchange
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  [W.m-2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from ridging                      [W.m-2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2]
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points
-
-   !!--------------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
    !! * Ice global state variables
-   !!--------------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    !! Variables defined for each ice category
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i      !: Ice thickness (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i       !: Ice thickness (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area(m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_s      !: Snow thickness (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_s       !: Snow thickness (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature (K)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sm_i      !: Sea-Ice Bulk salinity (ppt)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   smv_i     !: Sea-Ice Bulk salinity times volume per area (ppt.m)
-   !                                                                    !  this is an extensive variable that has to be transported
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age (days)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area (days)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   s_i       !: Sea-Ice Bulk salinity (ppt)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sv_i     !: Sea-Ice Bulk salinity times volume per area (ppt.m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age (s)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area (s)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume
 
@@ -391,49 +332,46 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i        !: mean sea ice salinity averaged over all categories [PSU]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sm_i         !: mean sea ice salinity averaged over all categories [PSU]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_i        !: mean ice  thickness over all categories
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_s        !: mean snow thickness over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_i         !: mean ice  thickness over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_s         !: mean snow thickness over all categories
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tau_icebfr   !: ice friction with bathy (landfast param activated)
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures [K]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow ...      
-      
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures          [K]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice thermal contents    [J/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i      !: ice salinities          [PSU]
-
-   !!--------------------------------------------------------------------------
-   !! * Moments for advection
-   !!--------------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   !: open water in sea ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   !: ice thickness 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    !: snow thickness
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     !: lead fraction
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxc0 , syc0 , sxxc0 , syyc0 , sxyc0    !: snow thermal content
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   !: ice salinity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   !: ice age
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     !: ice layers heat content
-
-   !!--------------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures     [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow enthalpy         [J/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures      [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice enthalpy          [J/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i     !: ice salinity          [PSU]
+
+   ! MV MP 2016
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip       !: melt pond fraction per grid cell area
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_ip       !: melt pond volume per grid cell area [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond volume per ice area
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond thickness [m]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond fraction
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per unit area [m]
+   ! END MV MP 2016
+
+   !!----------------------------------------------------------------------
    !! * Old values of global variables
-   !!--------------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b               !: snow and ice volumes
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, smv_i_b, oa_i_b     !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total)
+   !!----------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b  !: snow and ice volumes/thickness
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b, oa_i_b        !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                         !: snow heat content
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                         !: ice temperatures
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b              !: ice velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                        !: ice concentration (total)
             
-   !!--------------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    !! * Ice thickness distribution variables
-   !!--------------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories 
    !
-   !!--------------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    !! * Ice diagnostics
-   !!--------------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    ! thd refers to changes induced by thermodynamics
    ! trp   ''         ''     ''       advection (transport of ice)
@@ -443,13 +381,24 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_sv   !: transport of salt content
    !
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   [] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_sice     !: ice salt content variation   [] 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s] 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s] 
-   !
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
+
+   !
+   !!----------------------------------------------------------------------
+   !! * SIMIP extra diagnostics
+   !!----------------------------------------------------------------------
+   ! Extra sea ice diagnostics to address the data request
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   t_si          !: Temperature at Snow-ice interface (K) 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_si         !: mean temperature at the snow-ice interface (K) 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_fc_bo    !: Bottom conduction flux (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_fc_su    !: Surface conduction flux (W/m2)
+
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -463,5 +412,5 @@
       INTEGER :: ice_alloc
       !
-      INTEGER :: ierr(15), ii
+      INTEGER :: ierr(18), ii
       !!-----------------------------------------------------------------
 
@@ -471,19 +420,20 @@
       ! stay within Fortran's max-line length limit.
       ii = 1
-      ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) ,                                             &
-         &      ahiu    (jpi,jpj) , ahiv     (jpi,jpj) , hicol    (jpi,jpj) ,                        &
+      ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) , ht_i_new (jpi,jpj) ,                        &
          &      strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,  &
          &      delta_i (jpi,jpj) , divu_i   (jpi,jpj) , shear_i  (jpi,jpj) , STAT=ierr(ii) )
 
       ii = ii + 1
-      ALLOCATE( t_bo   (jpi,jpj) , frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,     &
-         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) ,     &
+      ALLOCATE( t_bo   (jpi,jpj) , wfx_snw_sni(jpi,jpj) ,                                                &
+         &      wfx_snw(jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) ,  &
+         &      wfx_ice(jpi,jpj) , wfx_sub    (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam    (jpi,jpj) ,  &
+         &      wfx_pnd(jpi,jpj) ,                                                              &
          &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     &
          &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     &
-         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj),   &
+         &      afx_tot(jpi,jpj) , rn_amax_2d(jpi,jpj),                                         &
          &      fhtur  (jpi,jpj) , qlead  (jpi,jpj) ,                                           &
          &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  &
          &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  &
-         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     & 
+         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) ,     & 
          &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld   (jpi,jpj) ,                        &
          &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     &
@@ -493,8 +443,8 @@
       ! * Ice global state variables
       ii = ii + 1
-      ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) , &
-         &      ht_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     &
-         &      v_s    (jpi,jpj,jpl) , ht_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     &
-         &      sm_i   (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,     &
+      ALLOCATE( ftr_ice(jpi,jpj,jpl) ,                                                 &
+         &      h_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     &
+         &      v_s    (jpi,jpj,jpl) , h_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     &
+         &      s_i   (jpi,jpj,jpl) , sv_i (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,     &
          &      oa_i   (jpi,jpj,jpl) , bv_i  (jpi,jpj,jpl) ,  STAT=ierr(ii) )
       ii = ii + 1
@@ -502,33 +452,22 @@
          &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) ,     &
          &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) ,     &
-         &      smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) ,     &
+         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) ,     &
          &      om_i (jpi,jpj) , tau_icebfr(jpi,jpj)                              , STAT=ierr(ii) )
       ii = ii + 1
       ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
-
-      ! * Moments for advection
-      ii = ii + 1
-      ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   &
-         &      sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) ,   &
-         &      STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( sxa  (jpi,jpj,jpl) , sya  (jpi,jpj,jpl) , sxxa  (jpi,jpj,jpl) , syya  (jpi,jpj,jpl) , sxya  (jpi,jpj,jpl) ,   &
-         &      sxc0 (jpi,jpj,jpl) , syc0 (jpi,jpj,jpl) , sxxc0 (jpi,jpj,jpl) , syyc0 (jpi,jpj,jpl) , sxyc0 (jpi,jpj,jpl) ,   &
-         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   &
-         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   &
-         &      STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     &
-         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) )
+      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
+
+      ii = ii + 1
+      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , &
+         &      h_ip(jpi,jpj,jpl) , STAT = ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( at_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) )
 
       ! * Old values of global variables
       ii = ii + 1
-      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     &
-         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     &
-         &      oa_i_b (jpi,jpj,jpl)                                                    , STAT=ierr(ii) )
+      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl)        , h_i_b(jpi,jpj,jpl)        ,   &
+         &      a_i_b  (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b (jpi,jpj,nlay_i,jpl) , e_s_b (jpi,jpj,nlay_s,jpl) ,   &
+         &      oa_i_b (jpi,jpj,jpl)                                                     , STAT=ierr(ii) )
       ii = ii + 1
       ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) )
@@ -541,6 +480,12 @@
       ii = ii + 1
       ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),   & 
-         &      diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat  (jpi,jpj),   &
-         &      diag_smvi  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) )
+         &      diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat  (jpi,jpj),   &
+         &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) )
+
+      ! * SIMIP diagnostics
+      ii = ii + 1
+      ALLOCATE( t_si (jpi,jpj,jpl)    , tm_si(jpi,jpj)        ,    & 
+                diag_fc_bo(jpi,jpj)   , diag_fc_su(jpi,jpj)   ,    &
+                STAT = ierr(ii) )
 
       ice_alloc = MAXVAL( ierr(:) )
@@ -551,5 +496,5 @@
 #else
    !!----------------------------------------------------------------------
-   !!   Default option         Empty module            NO LIM sea-ice model
+   !!   Default option         Empty module           NO ESIM sea-ice model
    !!----------------------------------------------------------------------
 #endif
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/ice1D.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/ice1D.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/ice1D.F90	(revision 8586)
@@ -0,0 +1,238 @@
+MODULE ice1D
+   !!======================================================================
+   !!                       ***  MODULE ice1D  ***
+   !! sea-ice :   Ice thermodynamics variables in 1D
+   !!=====================================================================
+   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   USE ice     , ONLY :   nlay_i, nlay_s, jpl   ! number of ice/snow layers and categories
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice1D_alloc   ! called by icestp.F90
+
+   !!----------------------
+   !! * 1D Module variables
+   !!----------------------
+   !: In ice thermodynamics, to spare memory, the vectors are folded
+   !: from 1D to 2D vectors. The following variables, with ending _1d
+   !: are the variables corresponding to 2d vectors
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nptidx !: selected points for ice thermo
+   INTEGER , PUBLIC                                  ::   npti   !  number of selected points
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rn_amax_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bom_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bog_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dif_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_opw_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dyn_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_out_1d
+
+   ! heat flux associated with ice-atmosphere mass exchange
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d
+
+   ! heat flux associated with ice-ocean mass exchange
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_sni_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_sum_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_dyn_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_sub_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_ice_sub_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_err_sub_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_lam_1d 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_dyn_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_pnd_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sub_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_lam_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_dyn_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ato_i_1d      !: <==> the 2D  ato_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice
+   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_si_1d       !: <==> the 2D  t_si
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ib_1d       !: <==> the 2D  a_i_b
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_i_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ib_1d      !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_s_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_sub      !: Ice surface sublimation [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_1d       !: Ice bulk salinity [ppt]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_i_1d        !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_s_1d        !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sv_i_1d      !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oa_i_1d       !:
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sz_i_1d  !: profiled ice salinity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e_i_1d   !:    Ice  enthalpy per unit volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e_s_1d   !:    Snow enthalpy per unit volume
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   eh_i_old !: ice heat content (q*h, J.m-2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m)
+
+   ! Conduction flux diagnostics (SIMIP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   diag_fc_bo_1d      !: <==> the 2D  diag_fc_bo
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   diag_fc_su_1d      !: <==> the 2D  diag_fc_su
+
+   ! surface fields from the ocean
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sst_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sss_1d
+
+   ! 
+   !!----------------------
+   !! * 2D Module variables
+   !!----------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_i_2d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_i_2d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_s_2d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   oa_i_2d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sv_i_2d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_ip_2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_ip_2d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_su_2d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_2d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_ib_2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_ib_2d
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: ice1D.F90 8379 2017-07-26 15:35:49Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION ice1D_alloc()
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE ice1D_alloc ***
+      !!---------------------------------------------------------------------!
+      INTEGER ::   ice1D_alloc   ! return value
+      INTEGER ::   ierr(7), ii
+      !!---------------------------------------------------------------------!
+      ierr(:) = 0
+
+      ii = 1
+      ALLOCATE( nptidx   (jpij) ,   &
+         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   &
+         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   &
+         &      t_bo_1d   (jpij) ,                                         &
+         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    & 
+         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,hfx_dyn_1d(jpij) ,    &
+         &      rn_amax_1d(jpij) ,                                         &
+         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      &
+         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) ,                      &
+         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , hfx_out_1d(jpij), STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( sprecip_1d (jpij) , at_i_1d    (jpij) , ato_i_1d(jpij) ,                    &
+         &      fhtur_1d   (jpij) , wfx_snw_sni_1d (jpij) , wfx_spr_1d (jpij) , wfx_snw_sum_1d(jpij) , &
+         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  &
+         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  &
+         &      wfx_snw_sub_1d(jpij), wfx_snw_dyn_1d(jpij), wfx_ice_sub_1d(jpij), wfx_err_sub_1d(jpij) ,   &
+         &      wfx_lam_1d(jpij)  , wfx_dyn_1d(jpij), wfx_pnd_1d(jpij),dqns_ice_1d(jpij) , evap_ice_1d (jpij),   &
+         &      qprec_ice_1d(jpij), i0         (jpij) ,                                         &  
+         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  &
+         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  &
+         &      sfx_lam_1d (jpij) , sfx_dyn_1d(jpij)  , STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( t_su_1d  (jpij) , t_si_1d   (jpij) , a_i_1d  (jpij) , a_ib_1d(jpij) ,                  &
+         &      h_i_1d  (jpij) , h_ib_1d  (jpij) , h_s_1d (jpij) , fc_su  (jpij) , fc_bo_i(jpij) ,  &    
+         &      dh_s_tot (jpij) , dh_i_surf (jpij) , dh_i_sub(jpij) ,                                  &    
+         &      dh_i_bott(jpij) , dh_snowice(jpij) , s_i_1d (jpij) , s_i_new(jpij) , &
+         &      a_ip_1d  (jpij) , v_ip_1d   (jpij) , v_i_1d  (jpij) , v_s_1d (jpij) , &
+         &      sv_i_1d (jpij) , oa_i_1d   (jpij) , STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( t_s_1d  (jpij,nlay_s)     , t_i_1d (jpij,nlay_i)     , sz_i_1d(jpij,nlay_i) ,  &            
+         &      e_i_1d  (jpij,nlay_i)     , e_s_1d (jpij,nlay_s)     ,                        &
+         &      eh_i_old(jpij,0:nlay_i+1) , h_i_old(jpij,0:nlay_i+1) , STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( diag_fc_bo_1d(jpij)      , diag_fc_su_1d(jpij)      , STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( sst_1d(jpij) , sss_1d(jpij) , STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( a_i_2d(jpij,jpl) , a_ib_2d(jpij,jpl) , h_i_2d(jpij,jpl) , h_ib_2d(jpij,jpl) , &
+         &      v_i_2d(jpij,jpl) ,v_s_2d(jpij,jpl) ,oa_i_2d(jpij,jpl) ,sv_i_2d(jpij,jpl) ,  &
+         &      a_ip_2d(jpij,jpl) ,v_ip_2d(jpij,jpl) ,t_su_2d(jpij,jpl) ,  &
+         &      STAT=ierr(ii) )
+
+      ice1D_alloc = MAXVAL( ierr(:) )
+      IF( ice1D_alloc /= 0 )   CALL ctl_warn( 'ice1D_alloc: failed to allocate arrays.' )
+      !
+   END FUNCTION ice1D_alloc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE ice1D_alloc          ! Empty routine
+   END SUBROUTINE ice1D_alloc
+#endif
+ 
+   !!======================================================================
+END MODULE ice1D
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90	(revision 8586)
@@ -0,0 +1,353 @@
+MODULE icealb
+   !!======================================================================
+   !!                       ***  MODULE  icealb  ***
+   !! Atmospheric forcing:  Albedo over sea ice
+   !!=====================================================================
+   !! History :  4.0  ! 2017-07  (C. Rousset) Split ice and ocean albedos
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_alb        : albedo for ice (clear and overcast skies)
+   !!   ice_alb_init   : initialisation of albedo computation
+   !!----------------------------------------------------------------------
+   USE ice, ONLY: jpl ! sea-ice: number of categories
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_alb_init   ! called in icestp
+   PUBLIC   ice_alb        ! called in iceforcing.F90 and iceupdate.F90
+
+   REAL(wp), PUBLIC, PARAMETER ::   rn_alb_oce = 0.066   !: ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001)
+
+   REAL(wp) , PARAMETER ::   ppc1    = 0.05    ! snow thickness (only for nn_ice_alb=0)
+   REAL(wp) , PARAMETER ::   ppc2    = 0.10    !  "        "
+   REAL(wp) , PARAMETER ::   ppcloud = 0.06    ! cloud effect on albedo (only-for nn_ice_alb=0)
+   REAL(wp) , PARAMETER ::   pp1_c1 = 1. / ppc1
+   REAL(wp) , PARAMETER ::   pp1_c2 = 1. / ppc2
+   !
+   ! ** albedo namelist (namalb)
+   INTEGER  ::   nn_ice_alb       ! type of albedo scheme: 0: Shine & Henderson-Sellers (JGR 1985)
+   !                                      !                         1: "home made" based on Brandt et al. (JClim 2005)
+   !                                      !                                             and Grenfell & Perovich (JGR 2004)
+   !                                      !                         2: Same as 1 but with melt ponds
+   REAL(wp) ::   rn_alb_sdry      ! dry snow albedo
+   REAL(wp) ::   rn_alb_smlt      ! melting snow albedo
+   REAL(wp) ::   rn_alb_idry      ! dry ice albedo
+   REAL(wp) ::   rn_alb_imlt      ! bare puddled ice albedo
+   REAL(wp) ::   rn_alb_dpnd      ! ponded ice albedo
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icealb.F90 8268 2017-07-03 15:01:04Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_alb( pt_ice, ph_ice, ph_snw, pafrac_pnd, ph_pnd, ld_pnd, pa_ice_cs, pa_ice_os )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE ice_alb  ***
+      !!          
+      !! ** Purpose :   Computation of the albedo of the snow/ice system 
+      !!       
+      !! ** Method  :   Two schemes are available (from namelist parameter nn_ice_alb)
+      !!                  0: the scheme is that of Shine & Henderson-Sellers (JGR 1985) for clear-skies
+      !!                  1: the scheme is "home made" (for cloudy skies) and based on Brandt et al. (J. Climate 2005)
+      !!                                                                           and Grenfell & Perovich (JGR 2004)
+      !!                  2: fractional surface-based formulation of scheme 1 (NEW)
+      !!                Description of scheme 1:
+      !!                  1) Albedo dependency on ice thickness follows the findings from Brandt et al (2005)
+      !!                     which are an update of Allison et al. (JGR 1993) ; Brandt et al. 1999
+      !!                     0-5cm  : linear function of ice thickness
+      !!                     5-150cm: log    function of ice thickness
+      !!                     > 150cm: constant
+      !!                  2) Albedo dependency on snow thickness follows the findings from Grenfell & Perovich (2004)
+      !!                     i.e. it increases as -EXP(-snw_thick/0.02) during freezing and -EXP(-snw_thick/0.03) during melting
+      !!                  3) Albedo dependency on clouds is speculated from measurements of Grenfell and Perovich (2004)
+      !!                     i.e. cloudy-clear albedo depend on cloudy albedo following a 2d order polynomial law
+      !!                  4) The needed 4 parameters are: dry and melting snow, freezing ice and bare puddled ice
+      !!
+      !! ** Note    :   The parameterization from Shine & Henderson-Sellers presents several misconstructions:
+      !!                  1) ice albedo when ice thick. tends to 0 is different than ocean albedo
+      !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger 
+      !!                     under melting conditions than under freezing conditions
+      !!                  3) the evolution of ice albedo as a function of ice thickness shows  
+      !!                     3 sharp inflexion points (at 5cm, 100cm and 150cm) that look highly unrealistic
+      !!
+      !! References :   Shine & Henderson-Sellers 1985, JGR, 90(D1), 2243-2250.
+      !!                Brandt et al. 2005, J. Climate, vol 18
+      !!                Grenfell & Perovich 2004, JGR, vol 109 
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice       !  ice surface temperature (Kelvin)
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice       !  sea-ice thickness
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_snw       !  snow depth
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pafrac_pnd   !  melt pond relative fraction (per unit ice area)
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_pnd       !  melt pond depth
+      LOGICAL , INTENT(in   )                   ::   ld_pnd       !  melt ponds radiatively active or not
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_cs    !  albedo of ice under clear    sky
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os    !  albedo of ice under overcast sky
+      !
+      INTEGER  ::   ji, jj, jl                ! dummy loop indices
+      REAL(wp) ::   zswitch, z1_c1, z1_c2     ! local scalar
+      REAL(wp) ::   z1_href_pnd               !   -      -                 
+      REAL(wp) ::   zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb, zalb_it   ! intermediate variable & albedo of ice (snow free)
+!! MV MP
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_pnd        ! ponded sea ice albedo
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_ice        ! bare sea ice albedo
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_snw        ! snow-covered sea ice albedo
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zafrac_snw      ! relative snow fraction
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zafrac_ice      ! relative ice fraction
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zafrac_pnd      ! relative ice fraction (effective)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('icealb')
+      !
+      !-----------------------------------------------------
+      !  Snow-free albedo (no ice thickness dependence yet)
+      !-----------------------------------------------------
+      !
+      ! Part common to nn_ice_alb = 0, 1, 2
+      !
+      IF ( .NOT. ld_pnd ) THEN   !--- No melt ponds OR radiatively inactive melt ponds
+         ! Bare ice albedo is prescribed, with implicit assumption on pond fraction and depth
+         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0 )   ;   zalb(:,:,:) = rn_alb_imlt
+         ELSEWHERE                                           ;   zalb(:,:,:) = rn_alb_idry
+         END WHERE
+      ENDIF
+
+      SELECT CASE ( nn_ice_alb )       ! select a parameterization
+      !
+      !              !------------------------------------------
+      CASE( 0 )      !  Shine and Henderson-Sellers (1985)     !   (based on clear sky values)
+         !           !------------------------------------------
+         !
+         !                       ! Thickness-dependent bare ice albedo
+         WHERE    ( 1.5  < ph_ice                     )   ;   zalb_it = zalb
+         ELSEWHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )   ;   zalb_it = 0.472  + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 )
+         ELSEWHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )   ;   zalb_it = 0.2467 + 0.7049 * ph_ice              &
+            &                                                                  - 0.8608 * ph_ice * ph_ice     &
+            &                                                                  + 0.3812 * ph_ice * ph_ice * ph_ice
+         ELSEWHERE                                        ;   zalb_it = 0.1    + 3.6    * ph_ice
+         END WHERE
+         !
+         IF ( ld_pnd ) THEN      ! Depth-dependent ponded ice albedo
+            z1_href_pnd = 1. / 0.05    ! inverse of the characteristic length scale (Lecomte et al. 2015)
+            zalb_pnd  = rn_alb_dpnd - ( rn_alb_dpnd - zalb_it ) * EXP( - ph_pnd * z1_href_pnd ) 
+            !                          ! Snow-free ice albedo is a function of pond fraction
+            WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0 )   
+               zalb_it = zalb_it * ( 1. - pafrac_pnd  ) + zalb_pnd * pafrac_pnd 
+            END WHERE
+         ENDIF 
+         !
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !                    ! Freezing snow
+                  ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > ppc2
+                  zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - ppc1 ) ) )
+                  zalb_sf = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  &
+                     &                                   + ph_snw(ji,jj,jl) * ( rn_alb_sdry - zalb_it(ji,jj,jl) ) * pp1_c1  )   &
+                     &    +           zswitch   * rn_alb_sdry  
+                     !
+                  !                    ! Melting snow
+                  ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > ppc2
+                  zswitch = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - ppc2 ) )
+                  zalb_sm = ( 1._wp - zswitch ) * ( rn_alb_imlt + ph_snw(ji,jj,jl) * ( rn_alb_smlt - rn_alb_imlt ) * pp1_c2 )   &
+                     &      +         zswitch   *   rn_alb_smlt 
+                     !
+                  !                    ! Snow albedo
+                  zswitch =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zalb_st =  zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
+                  !
+                  !                    ! Surface albedo
+                  zswitch             = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
+                  pa_ice_cs(ji,jj,jl) = zswitch * zalb_st + ( 1._wp - zswitch ) * zalb_it(ji,jj,jl)
+                  !
+               END DO
+            END DO
+         END DO
+         !
+         pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + ppcloud       ! Oberhuber correction for overcast sky
+         !
+         !
+         !           !------------------------------------------
+      CASE( 1 )      !  New parameterization (2016)            !    (based on overcast sky values)
+         !           !------------------------------------------
+         !
+         !                    compilation of values from literature (reference overcast sky values)
+         !                          rn_alb_sdry = 0.85      ! dry snow
+         !                          rn_alb_smlt = 0.75      ! melting snow
+         !                          rn_alb_idry = 0.60      ! bare frozen ice
+         !                          rn_alb_dpnd = 0.36      ! ponded-ice overcast albedo (Lecomte et al, 2015)
+         !                                                  ! early melt pnds 0.27, late melt ponds 0.14 Grenfell & Perovich
+         !                    Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved
+         !                          rn_alb_sdry = 0.85      ! dry snow
+         !                          rn_alb_smlt = 0.72      ! melting snow
+         !                          rn_alb_idry = 0.65      ! bare frozen ice
+         !                    Brandt et al 2005 (East Antarctica)
+         !                          rn_alb_sdry = 0.87      ! dry snow
+         !                          rn_alb_smlt = 0.82      ! melting snow
+         !                          rn_alb_idry = 0.54      ! bare frozen ice
+         ! 
+         !              !--- Computation of snow-free ice albedo 
+         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
+         z1_c2 = 1. / 0.05
+
+         !              !--- Accounting for the ice-thickness dependency
+         WHERE     ( 1.5  < ph_ice                     )   ;   zalb_it = zalb
+         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 )   ;   zalb_it = zalb + ( 0.18 - zalb ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice) )
+         ELSE WHERE                                        ;   zalb_it = rn_alb_oce + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice
+         END WHERE
+         !
+         IF ( ld_pnd ) THEN      ! Depth-dependent ponded ice albedo
+            z1_href_pnd = 0.05        ! inverse of the characteristic length scale (Lecomte et al. 2015)
+            zalb_pnd  = rn_alb_dpnd - ( rn_alb_dpnd - zalb_it ) * EXP( - ph_pnd * z1_href_pnd ) 
+            !
+            !                    ! Snow-free ice albedo is weighted mean of ponded ice and bare ice contributions
+            WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0 )
+               zalb_it = zalb_it * ( 1. - pafrac_pnd  ) + zalb_pnd * pafrac_pnd
+            END WHERE
+         ENDIF 
+         !
+         !              !--- Overcast sky surface albedo (accounting for snow, ice melt ponds)
+         z1_c1 = 1. / 0.02
+         z1_c2 = 1. / 0.03
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! Snow depth dependence of snow albedo
+                  zalb_sf = rn_alb_sdry - ( rn_alb_sdry - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 );
+                  zalb_sm = rn_alb_smlt - ( rn_alb_smlt - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 );
+
+                  ! Snow albedo (MV I guess we could use rt0 instead of rt0_snow)
+                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
+
+                  ! Surface albedo   
+                  zswitch             = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
+                  pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch *  zalb_it(ji,jj,jl)
+
+              END DO
+            END DO
+         END DO
+         !
+         !              !--- Clear sky surface albedo
+         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 
+         !
+         !
+         !           !------------------------------------------
+      CASE( 2 )      !  Fractional surface-based parameterization (2017)
+         !           !------------------------------------------
+         !              MV: I propose this formulation that is more elegant, and more easy to expand towards
+         !              varying pond and snow fraction.
+         !              Formulation 1 has issues to handle ponds and snow together that can't easily be fixed. 
+         !              This one handles it better, I believe.
+         !
+         !                 !==  Snow, bare ice and ponded ice fractions  ==!
+         !
+         !                       ! Specific fractions (zafrac) refer to relative area covered by snow within each ice category
+         !
+         !                       !--- Effective pond fraction (for now, we prevent melt ponds and snow at the same time)
+         zafrac_pnd = 0._wp
+         IF ( ld_pnd ) THEN
+            WHERE( ph_snw == 0._wp )   zafrac_pnd = pafrac_pnd   ! Snow fully "shades" melt ponds
+         ENDIF         
+         !
+         !                       !--- Specific snow fraction (for now, prescribed)
+         WHERE( ph_snw > 0._wp )   ;   zafrac_snw = 1.
+         ELSEWHERE                 ;   zafrac_snw = 0.
+         END WHERE
+         !
+         !                       !--- Specific ice fraction 
+         zafrac_ice = 1. - zafrac_snw - zafrac_pnd
+         !
+         !                 !==  Snow-covered, pond-covered, and bare ice albedos  ==!
+         !
+         !                       !--- Bare ice albedo
+         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
+         z1_c2 = 1. / 0.05
+         WHERE    ( 1.5  < ph_ice                     )   ;   zalb_ice = zalb
+         ELSEWHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 )   ;   zalb_ice = zalb       + ( 0.18 - zalb       ) * z1_c1 *  &
+            &                                                                       ( LOG(1.5) - LOG(ph_ice) )
+         ELSEWHERE                                        ;   zalb_ice = rn_alb_oce + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice
+         END WHERE
+         !
+         z1_c1 = 1. / 0.02       !--- Snow-covered ice albedo (freezing, melting cases)
+         z1_c2 = 1. / 0.03
+         !
+         WHERE( pt_ice < rt0_snow )   ;   zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw * z1_c1 )
+         ELSEWHERE                    ;   zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw * z1_c2 )
+         END WHERE
+         !
+         IF ( ld_pnd ) THEN      !--- Depth-dependent ponded ice albedo
+            z1_href_pnd = 0.05        ! inverse of the characteristic length scale (Lecomte et al. 2015)
+            zalb_pnd  = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd * z1_href_pnd ) 
+         ELSE
+            zalb_pnd  = rn_alb_dpnd
+         ENDIF
+         !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions
+         pa_ice_os = zafrac_snw * zalb_snw  +  zafrac_pnd * zalb_pnd  +  zafrac_ice * zalb_ice
+         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 )
+
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('icealb')
+      !
+   END SUBROUTINE ice_alb
+
+
+   SUBROUTINE ice_alb_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE alb_init  ***
+      !!
+      !! ** Purpose :   initializations for the albedo parameters
+      !!
+      !! ** Method  :   Read the namelist namalb
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namalb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt, rn_alb_dpnd
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namalb in reference namelist : Albedo parameters
+      READ  ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namalb in configuration namelist : Albedo parameters
+      READ  ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namalb )
+      !
+      IF(lwp) THEN                      ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_alb_init: set albedo parameters'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namalb:'
+         WRITE(numout,*) '      choose the albedo parameterization   nn_ice_alb  = ', nn_ice_alb
+         WRITE(numout,*) '      albedo of dry snow                   rn_alb_sdry = ', rn_alb_sdry
+         WRITE(numout,*) '      albedo of melting snow               rn_alb_smlt = ', rn_alb_smlt
+         WRITE(numout,*) '      albedo of dry ice                    rn_alb_idry = ', rn_alb_idry
+         WRITE(numout,*) '      albedo of bare puddled ice           rn_alb_imlt = ', rn_alb_imlt
+         WRITE(numout,*) '      albedo of ponded ice                 rn_alb_dpnd = ', rn_alb_dpnd
+      ENDIF
+      !
+   END SUBROUTINE ice_alb_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icealb
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icecor.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icecor.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icecor.F90	(revision 8586)
@@ -0,0 +1,191 @@
+MODULE icecor
+   !!======================================================================
+   !!                     ***  MODULE  icecor  ***
+   !!   ESIM : Corrections on sea-ice variables at the end of the time step
+   !!======================================================================
+   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
+   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!    ice_cor      : corrections on sea-ice variables
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE phycst         ! physical constants
+   USE ice            ! sea-ice: variable
+   USE ice1D          ! sea-ice: thermodynamic sea-ice variables
+   USE iceitd         ! sea-ice: rebining
+   USE icevar         ! sea-ice: operations
+   USE icectl         ! sea-ice: control prints
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_cor   ! called by icestp.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icecor.F90 8378 2017-07-26 13:55:59Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_cor( kt, kn )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE ice_cor  ***
+      !!               
+      !! ** Purpose :   Computes corrections on sea-ice global variables at 
+      !!              the end of the dynamics (kn=1) and thermodynamics (kn=2)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      INTEGER, INTENT(in) ::   kn    ! 1 = after dyn ; 2 = after thermo
+      !
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   zsal, zzc
+      REAL(wp), DIMENSION(jpi,jpj) ::   zafx   ! concentration trends diag
+      !!----------------------------------------------------------------------
+      ! controls
+      IF( nn_timing == 1 )   CALL timing_start('icecor')                                                             ! timing
+      IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+      !
+      IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_cor:  correct sea ice variables if out of bounds ' 
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      !
+      IF( kn == 2 ) THEN
+         !                          !-----------------------------------------------------
+         !                          !  thickness of the smallest category above himin    !
+         !                          !-----------------------------------------------------
+         WHERE( a_i(:,:,1) >= epsi20 )   ;   h_i(:,:,1) = v_i (:,:,1) / a_i(:,:,1)
+         ELSEWHERE                       ;   h_i(:,:,1) = 0._wp
+         END WHERE
+         WHERE( h_i(:,:,1) < rn_himin )      a_i(:,:,1) = a_i (:,:,1) * h_i(:,:,1) / rn_himin
+         !
+      ENDIF
+      !                             !-----------------------------------------------------
+      !                             !  ice concentration should not exceed amax          !
+      !                             !-----------------------------------------------------
+      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
+      DO jl  = 1, jpl
+         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:)
+      END DO
+    
+      !                             !-----------------------------------------------------
+      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        !
+      !                             !-----------------------------------------------------
+         zzc = rhoic * r1_rdtice
+         DO jl = 1, jpl
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  zsal = sv_i(ji,jj,jl)
+                  sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  )
+                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !                             !-----------------------------------------------------
+      !                             !  Rebin categories with thickness out of bounds     !
+      !                             !-----------------------------------------------------
+      IF ( jpl > 1 )   CALL ice_itd_reb( kt )
+
+      !                             !-----------------------------------------------------
+      CALL ice_var_zapsmall         !  Zap small values                                  !
+      !                             !-----------------------------------------------------
+
+      !                             !-----------------------------------------------------
+      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values !
+         DO jj = 2, jpjm1           !-----------------------------------------------------
+            DO ji = 2, jpim1
+               IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
+                  IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
+                  IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
+                  IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
+                  IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
+               ENDIF
+            END DO
+         END DO
+         CALL lbc_lnk_multi( u_ice, 'U', -1., v_ice, 'V', -1. )            ! lateral boundary conditions
+      ENDIF
+
+!!gm I guess the trends are only out on demand 
+!!   So please, only do this is it exite an iom_use of on a these variables
+!!   furthermore, only allocate the diag_ arrays in this case 
+!!   and do the iom_put here so that it is only a local allocation
+!!gm 
+      !                             !-----------------------------------------------------
+      SELECT CASE( kn )             !  Diagnostics                                       !
+      !                             !-----------------------------------------------------
+      CASE( 1 )                        !--- dyn trend diagnostics
+         !
+!!gm   here I think the number of ice cat is too small to use a SUM instruction...
+         DO jj = 1, jpj
+            DO ji = 1, jpi            
+               !                 ! heat content variation (W.m-2)
+               diag_heat(ji,jj) = - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    & 
+                  &                  + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice
+               !                 ! salt, volume
+               diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+               diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice
+               diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice
+            END DO
+         END DO
+         !                       ! concentration tendency (dynamics)
+         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
+         afx_tot(:,:) = zafx(:,:)
+         IF( iom_use('afxdyn') )   CALL iom_put( 'afxdyn' , zafx(:,:) )
+         !
+      CASE( 2 )                        !--- thermo trend diagnostics & ice aging
+         !
+         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice   ! ice natural aging incrementation
+         !
+!!gm   here I think the number of ice cat is too small to use a SUM instruction...
+         DO jj = 1, jpj
+            DO ji = 1, jpi            
+               !                 ! heat content variation (W.m-2)
+               diag_heat(ji,jj) = diag_heat(ji,jj) - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    & 
+                  &                                   + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice
+               !                 ! salt, volume
+               diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+               diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice
+               diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice
+            END DO
+         END DO
+         !                       ! concentration tendency (total + thermo)
+         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice
+         afx_tot(:,:) = afx_tot(:,:) + zafx(:,:)
+         IF( iom_use('afxthd') )   CALL iom_put( 'afxthd' , zafx(:,:) )
+         IF( iom_use('afxtot') )   CALL iom_put( 'afxtot' , afx_tot(:,:) )
+         !
+      END SELECT
+      !
+      ! controls
+      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+      IF( ln_ctl         )   CALL ice_prt3D   ('icecor')                                                             ! prints
+      IF( ln_icectl .AND. kn == 2 )   CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                   ! prints
+      IF( nn_timing == 1 )   CALL timing_stop ('icecor')                                                             ! timing
+      !
+   END SUBROUTINE ice_cor
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icecor
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90	(revision 8586)
@@ -0,0 +1,674 @@
+MODULE icectl
+   !!======================================================================
+   !!                     ***  MODULE  icectl  ***
+   !!   sea-ice : controls and prints
+   !!======================================================================
+   !! History :  3.5  !  2015-01  (M. Vancoppenolle) Original code
+   !!            3.7  !  2016-10  (C. Rousset)       Add routine ice_prt3D
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!    ice_cons_hsm     : conservation tests on heat, salt and mass
+   !!    ice_cons_final   : conservation tests on heat, salt and mass at end of time step
+   !!    ice_ctl          : control prints in case of crash
+   !!    ice_prt          : control prints at a given grid point
+   !!    ice_prt3D        : control prints of ice arrays
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamics variables
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice   fields
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE timing         ! Timing
+   USE prtctl         ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_cons_hsm
+   PUBLIC   ice_cons_final
+   PUBLIC   ice_ctl
+   PUBLIC   ice_prt
+   PUBLIC   ice_prt3D
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icectl.F90 5043 2015-01-28 16:44:18Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_cons_hsm( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft )
+      !!-------------------------------------------------------------------
+      !!                       ***  ROUTINE ice_cons_hsm ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
+      !!                     + test if ice concentration and volume are > 0
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_icediachk=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zt_sill) which determine violations are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!-------------------------------------------------------------------
+      INTEGER         , INTENT(in)    ::   icount        ! called at: =0 the begining of the routine, =1  the end
+      CHARACTER(len=*), INTENT(in)    ::   cd_routine    ! name of the routine
+      REAL(wp)        , INTENT(inout) ::   pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft
+      !!
+      REAL(wp) ::   zv, zs, zt, zfs, zfv, zft
+      REAL(wp) ::   zvmin, zamin, zamax 
+      REAL(wp) ::   zvtrp, zetrp
+      REAL(wp) ::   zarea, zv_sill, zs_sill, zt_sill
+      REAL(wp), PARAMETER ::   zconv = 1.e-9 ! convert W to GW and kg to Mt
+      !!-------------------------------------------------------------------
+      !
+      IF( icount == 0 ) THEN
+         !                          ! water flux
+         pdiag_fv = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:)     + wfx_sum(:,:)     + wfx_sni(:,:)     +                     &
+            &                    wfx_opw(:,:) + wfx_res(:,:)     + wfx_dyn(:,:)     + wfx_lam(:,:)     + wfx_ice_sub(:,:) +  &
+            &                    wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:)    &
+            &                  ) * e1e2t(:,:) ) * zconv
+         !
+         !                          ! salt flux
+         pdiag_fs = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                    sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &
+            &                  ) *  e1e2t(:,:) ) * zconv 
+         !
+         !                          ! heat flux
+         pdiag_ft = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &                  - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &                  ) *  e1e2t(:,:) ) * zconv
+
+         pdiag_v = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * zconv )
+
+         pdiag_s = glob_sum( SUM( sv_i * rhoic             , dim=3 ) * e1e2t * zconv )
+
+         pdiag_t = glob_sum( (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )     &
+            &                 + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )   ) * e1e2t ) * zconv
+
+      ELSEIF( icount == 1 ) THEN
+
+         ! water flux
+         zfv  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:)     + wfx_sum(:,:)     + wfx_sni(:,:)     +                     &
+            &                wfx_opw(:,:) + wfx_res(:,:)     + wfx_dyn(:,:)     + wfx_lam(:,:)     + wfx_ice_sub(:,:) +  &
+            &                wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:)        &
+            &              ) * e1e2t(:,:) ) * zconv - pdiag_fv
+
+         ! salt flux
+         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
+            &              ) * e1e2t(:,:) ) * zconv - pdiag_fs
+
+         ! heat flux
+         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &              ) * e1e2t(:,:) ) * zconv - pdiag_ft
+ 
+         ! outputs
+         zv = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t  ) * zconv  &
+            &     - pdiag_v ) * r1_rdtice - zfv ) * rday
+
+         zs = ( ( glob_sum( SUM( sv_i * rhoic            , dim=3 ) * e1e2t ) * zconv  &
+            &     - pdiag_s ) * r1_rdtice + zfs ) * rday
+
+         zt = ( glob_sum( (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )   &
+            &                + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv   &
+            &   - pdiag_t ) * r1_rdtice + zft
+
+         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative
+         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t  ) * zconv * rday 
+         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t  ) * zconv
+
+         zvmin = glob_min( v_i )
+         zamax = glob_max( SUM( a_i, dim=3 ) )
+         zamin = glob_min( a_i )
+
+         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2
+         zv_sill = zarea * 2.5e-5
+         zs_sill = zarea * 25.e-5
+         zt_sill = zarea * 10.e-5
+
+         IF(lwp) THEN
+            IF ( ABS( zv   ) > zv_sill )   WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zv
+            IF ( ABS( zs   ) > zs_sill )   WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zs
+            IF ( ABS( zt   ) > zt_sill )   WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zt
+            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'icedyn_adv' ) THEN
+                                           WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp
+                                           WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp
+            ENDIF
+            IF ( zvmin < -epsi10 )         WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin
+            IF ( zamax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' )  &
+               &                           WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
+            IF ( zamin < -epsi10 )         WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin
+         ENDIF
+         !
+      ENDIF
+
+   END SUBROUTINE ice_cons_hsm
+
+
+   SUBROUTINE ice_cons_final( cd_routine )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE ice_cons_final ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_icediachk=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zt_sill) which determine the violation are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!-------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
+      REAL(wp)                        :: zhfx, zsfx, zvfx
+      REAL(wp)                        :: zarea, zv_sill, zs_sill, zt_sill
+      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
+      !!-------------------------------------------------------------------
+
+      ! water flux
+      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) * zconv * rday
+
+      ! salt flux
+      zsfx  = glob_sum( ( sfx + diag_sice ) * e1e2t ) * zconv * rday
+
+      ! heat flux
+      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es   &
+      !  &              - SUM( qevap_ice * a_i_b, dim=3 )                           & !!clem: I think this line must be commented (but need check)
+         &              ) * e1e2t ) * zconv
+
+      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2
+      zv_sill = zarea * 2.5e-5
+      zs_sill = zarea * 25.e-5
+      zt_sill = zarea * 10.e-5
+
+      IF(lwp) THEN
+         IF( ABS( zvfx ) > zv_sill )   WRITE(numout,*) 'violation vfx  [Mt/day]       (',cd_routine,') = ',zvfx
+         IF( ABS( zsfx ) > zs_sill )   WRITE(numout,*) 'violation sfx  [psu*Mt/day]   (',cd_routine,') = ',zsfx
+         IF( ABS( zhfx ) > zt_sill )   WRITE(numout,*) 'violation hfx  [GW]           (',cd_routine,') = ',zhfx
+      ENDIF
+      !
+   END SUBROUTINE ice_cons_final
+
+   
+   SUBROUTINE ice_ctl( kt )
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_ctl *** 
+      !!                 
+      !! ** Purpose :   Alerts in case of model crash
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices
+      INTEGER  ::   inb_altests       ! number of alert tests (max 20)
+      INTEGER  ::   ialert_id         ! number of the current alert
+      REAL(wp) ::   ztmelts           ! ice layer melting point
+      CHARACTER (len=30), DIMENSION(20) ::   cl_alname   ! name of alert
+      INTEGER           , DIMENSION(20) ::   inb_alp     ! number of alerts positive
+      !!-------------------------------------------------------------------
+
+      inb_altests = 10
+      inb_alp(:)  =  0
+
+      ! Alert if incompatible volume and concentration
+      ialert_id = 2 ! reference number of this alert
+      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
+                  !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
+                  !WRITE(numout,*) ' at_i     ', at_i(ji,jj)
+                  !WRITE(numout,*) ' Point - category', ji, jj, jl
+                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl)
+                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl)
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Alerte if very thick ice
+      ialert_id = 3 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
+      jl = jpl 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN
+               !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if very fast ice
+      ialert_id = 4 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  &
+               &  at_i(ji,jj) > 0._wp   ) THEN
+               !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
+               !WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
+               !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
+               !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
+               !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
+               !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
+               !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
+               !WRITE(numout,*) 
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if there is ice on continents
+      ialert_id = 6 ! reference number of this alert
+      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
+               !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
+               !WRITE(numout,*) ' masks s, u, v        : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1) 
+               !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+               !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
+               !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
+               !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
+               !
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+!
+!     ! Alert if very fresh ice
+      ialert_id = 7 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+!                 CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
+!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+!                 WRITE(numout,*) 
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+!
+
+!     ! Alert if too old ice
+      ialert_id = 9 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
+                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
+                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+                  !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+ 
+      ! Alert on salt flux
+      ialert_id = 5 ! reference number of this alert
+      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
+               !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
+               !DO jl = 1, jpl
+                  !WRITE(numout,*) ' Category no: ', jl
+                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' '
+               !END DO
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if qns very big
+      ialert_id = 8 ! reference number of this alert
+      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
+               !
+               !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
+               !WRITE(numout,*) ' ji, jj    : ', ji, jj
+               !WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj)
+               !
+               !CALL ice_prt( kt, ji, jj, 2, '   ')
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               !
+            ENDIF
+         END DO
+      END DO
+      !+++++
+ 
+      ! Alert if very warm ice
+      ialert_id = 10 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
+      inb_alp(ialert_id) = 0
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztmelts    =  -tmut * sz_i(ji,jj,jk,jl) + rt0
+                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
+                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
+                     !WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
+                     !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
+                     !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' sz_i: ', sz_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' ztmelts : ', ztmelts
+                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! sum of the alerts on all processors
+      IF( lk_mpp ) THEN
+         DO ialert_id = 1, inb_altests
+            CALL mpp_sum(inb_alp(ialert_id))
+         END DO
+      ENDIF
+
+      ! print alerts
+      IF( lwp ) THEN
+         ialert_id = 1                                 ! reference number of this alert
+         cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
+         WRITE(numout,*) ' time step ',kt
+         WRITE(numout,*) ' All alerts at the end of ice model '
+         DO ialert_id = 1, inb_altests
+            WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
+         END DO
+      ENDIF
+     !
+   END SUBROUTINE ice_ctl
+ 
+   
+   SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 )
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_prt *** 
+      !!                 
+      !! ** Purpose :   Writes global ice state on the (i,j) point 
+      !!                in ocean.ouput 
+      !!                3 possibilities exist 
+      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
+      !!                n = 2    -> exhaustive state
+      !!                n = 3    -> ice/ocean salt fluxes
+      !!
+      !! ** input   :   point coordinates (i,j) 
+      !!                n : number of the option
+      !!-------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt            ! ocean time step
+      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
+      CHARACTER(len=*), INTENT(in) ::   cd1           !
+      !!
+      INTEGER :: jl, ji, jj
+      !!-------------------------------------------------------------------
+
+      DO ji = mi0(ki), mi1(ki)
+         DO jj = mj0(kj), mj1(kj)
+
+            WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title
+
+            !----------------
+            !  Simple state
+            !----------------
+            
+            IF ( kn == 1 .OR. kn == -1 ) THEN
+               WRITE(numout,*) ' ice_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Simple state '
+               WRITE(numout,*) ' masks s,u,v   : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
+               WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' - Ice drift   '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (', jl,')'
+                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl)
+                  WRITE(numout,*) ' h_i           : ', h_i(ji,jj,jl)
+                  WRITE(numout,*) ' h_s           : ', h_s(ji,jj,jl)
+                  WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl)
+                  WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl)
+                  WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl)
+                  WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' s_i           : ', s_i(ji,jj,jl)
+                  WRITE(numout,*) ' sv_i          : ', sv_i(ji,jj,jl)
+                  WRITE(numout,*)
+               END DO
+            ENDIF
+            IF( kn == -1 ) THEN
+               WRITE(numout,*) ' Mechanical Check ************** '
+               WRITE(numout,*) ' Check what means ice divergence '
+               WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
+               WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj)
+               WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj)
+               WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
+            ENDIF
+            
+
+            !--------------------
+            !  Exhaustive state
+            !--------------------
+            
+            IF ( kn .EQ. 2 ) THEN
+               WRITE(numout,*) ' ice_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Exhaustive state '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)  
+               WRITE(numout,*)
+               
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (',jl,')'
+                  WRITE(numout,*) '   ~~~~~~~~         ' 
+                  WRITE(numout,*) ' h_i        : ', h_i(ji,jj,jl)              , ' h_s        : ', h_s(ji,jj,jl)
+                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' s_i        : ', s_i(ji,jj,jl)              , ' o_i        : ', o_i(ji,jj,jl)
+                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
+                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)  
+                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl)
+               END DO !jl
+               
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat / FW fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
+               WRITE(numout,*) ' qsr_ini       : ', (1._wp-at_i_b(ji,jj)) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
+               WRITE(numout,*) ' qns_ini       : ', (1._wp-at_i_b(ji,jj)) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
+               WRITE(numout,*)
+               WRITE(numout,*) 
+               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
+               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Stresses '
+               WRITE(numout,*) '   ~~~~~~~~ '
+               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
+               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
+               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
+               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
+            ENDIF
+            
+            !---------------------
+            ! Salt / heat fluxes
+            !---------------------
+            
+            IF ( kn .EQ. 3 ) THEN
+               WRITE(numout,*) ' ice_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Salt / Heat Fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
+               WRITE(numout,*) ' qsr       : ', qsr(ji,jj)
+               WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
+               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj)
+               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj)
+               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)              
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
+               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
+               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
+               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj) 
+               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
+               WRITE(numout,*) ' emp       : ', emp    (ji,jj)
+               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj)
+               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj)
+               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
+               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Momentum fluxes '
+               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
+               WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
+            ENDIF 
+            WRITE(numout,*) ' '
+            !
+         END DO
+      END DO
+      !
+   END SUBROUTINE ice_prt
+
+   SUBROUTINE ice_prt3D( cd_routine )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_prt3D ***
+      !!
+      !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated 
+      !!
+      !!-------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)  :: cd_routine    ! name of the routine
+      INTEGER                       :: jk, jl        ! dummy loop indices
+      
+      CALL prt_ctl_info(' ========== ')
+      CALL prt_ctl_info( cd_routine )
+      CALL prt_ctl_info(' ========== ')
+      CALL prt_ctl_info(' - Cell values : ')
+      CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+      CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' cell area   :')
+      CALL prt_ctl(tab2d_1=at_i       , clinfo1=' at_i        :')
+      CALL prt_ctl(tab2d_1=ato_i      , clinfo1=' ato_i       :')
+      CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' vt_i        :')
+      CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' vt_s        :')
+      CALL prt_ctl(tab2d_1=divu_i     , clinfo1=' divu_i      :')
+      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :')
+      CALL prt_ctl(tab2d_1=stress1_i  , clinfo1=' stress1_i   :')
+      CALL prt_ctl(tab2d_1=stress2_i  , clinfo1=' stress2_i   :')
+      CALL prt_ctl(tab2d_1=stress12_i , clinfo1=' stress12_i  :')
+      CALL prt_ctl(tab2d_1=strength   , clinfo1=' strength    :')
+      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :')
+      CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
+       
+      DO jl = 1, jpl
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Category : ', ivar1=jl)
+         CALL prt_ctl_info('   ~~~~~~~~~~')
+         CALL prt_ctl(tab2d_1=h_i        (:,:,jl)        , clinfo1= ' h_i         : ')
+         CALL prt_ctl(tab2d_1=h_s        (:,:,jl)        , clinfo1= ' h_s         : ')
+         CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' t_su        : ')
+         CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' t_snow      : ')
+         CALL prt_ctl(tab2d_1=s_i        (:,:,jl)        , clinfo1= ' s_i         : ')
+         CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' o_i         : ')
+         CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' a_i         : ')
+         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ')
+         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ')
+         CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ')
+         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ')
+         CALL prt_ctl(tab2d_1=sv_i       (:,:,jl)        , clinfo1= ' sv_i        : ')
+         CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' oa_i        : ')
+         
+         DO jk = 1, nlay_i
+            CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ')
+         END DO
+      END DO
+      
+      CALL prt_ctl_info(' ')
+      CALL prt_ctl_info(' - Heat / FW fluxes : ')
+      CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ')
+      CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ')
+      CALL prt_ctl(tab2d_1=qsr    , clinfo1= ' qsr   : ', tab2d_2=qns       , clinfo2= ' qns       : ')
+      CALL prt_ctl(tab2d_1=emp    , clinfo1= ' emp   : ', tab2d_2=sfx       , clinfo2= ' sfx       : ')
+      
+      CALL prt_ctl_info(' ')
+      CALL prt_ctl_info(' - Stresses : ')
+      CALL prt_ctl_info('   ~~~~~~~~~~ ')
+      CALL prt_ctl(tab2d_1=utau       , clinfo1= ' utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ')
+      CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ')
+      
+   END SUBROUTINE ice_prt3D
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module           No ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icectl
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90	(revision 8586)
@@ -0,0 +1,286 @@
+MODULE icedia
+   !!======================================================================
+   !!                       ***  MODULE icedia  ***
+   !!  Sea-Ice model :   global budgets 
+   !!======================================================================
+   !! History :  3.4  ! 2012-10  (C. Rousset)  original code
+   !!            4.0  ! 2017-08  (C. Rousset)  fits nemo4.0 standards
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    ice_dia      : diagnostic of the sea-ice global heat content, salt content and volume conservation
+   !!    ice_dia_init : initialization of budget calculation
+   !!    ice_dia_rst  : read/write budgets restart
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE phycst         ! physical constant
+   USE daymod         ! model calendar
+   USE sbc_oce , ONLY : sfx, nn_fsbc   ! surface boundary condition: ocean fields
+   USE ice            ! sea-ice: variables
+   USE icerst         ! sea-ice: restart
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dia        ! called by icestp.F90
+   PUBLIC   ice_dia_init   ! called in icestp.F90
+
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents
+   REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedia.F90 8413 2017-08-07 17:05:39Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION ice_dia_alloc()
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE ice_dia_alloc ***
+      !!---------------------------------------------------------------------!
+      ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ice_dia_alloc )
+
+      IF( lk_mpp             )   CALL mpp_sum ( ice_dia_alloc )
+      IF( ice_dia_alloc /= 0 )   CALL ctl_warn( 'ice_dia_alloc: failed to allocate arrays' )
+      !
+   END FUNCTION ice_dia_alloc
+
+   SUBROUTINE ice_dia( kt )
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_dia  ***
+      !!     
+      !! ** Purpose:   Compute the sea-ice global heat content, salt content 
+      !!             and volume conservation
+      !!---------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step 
+      !!
+      REAL(wp)   ::   zbg_ivol, zbg_item, zbg_area, zbg_isal
+      REAL(wp)   ::   zbg_svol, zbg_stem
+      REAL(wp)   ::   z_frc_voltop, z_frc_temtop, z_frc_sal
+      REAL(wp)   ::   z_frc_volbot, z_frc_tembot  
+      REAL(wp)   ::   zdiff_vol, zdiff_sal, zdiff_tem  
+      !!---------------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('ice_dia')
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'icedia: output ice diagnostics (integrated over the domain)'
+         WRITE(numout,*)'~~~~~~'
+      ENDIF
+
+!!gm glob_sum includes a " * tmask_i ", so remove  " * tmask(:,:,1) "
+
+      ! ----------------------- !
+      ! 1 -  Contents !
+      ! ----------------------- !
+      zbg_ivol = glob_sum( vt_i(:,:) * e1e2t(:,:) ) * 1.e-9                  ! ice volume (km3)
+      zbg_svol = glob_sum( vt_s(:,:) * e1e2t(:,:) ) * 1.e-9                  ! snow volume (km3)
+      zbg_area = glob_sum( at_i(:,:) * e1e2t(:,:) ) * 1.e-6                  ! area (km2)
+      zbg_isal = glob_sum( SUM( sv_i(:,:,:), dim=3 ) * e1e2t(:,:) ) * 1.e-9 ! salt content (pss*km3)
+      zbg_item = glob_sum( et_i * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J)
+      zbg_stem = glob_sum( et_s * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J)
+      
+      ! ---------------------------!
+      ! 2 - Trends due to forcing  !
+      ! ---------------------------!
+      z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9  ! freshwater flux ice/snow-ocean 
+      z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9                     ! freshwater flux ice/snow-atm
+      z_frc_sal    = r1_rau0 * glob_sum(   - sfx(:,:) * e1e2t(:,:) ) * 1.e-9                                          ! salt fluxes ice/snow-ocean
+      z_frc_tembot =           glob_sum( hfx_out(:,:) * e1e2t(:,:) ) * 1.e-20                                         ! heat on top of ocean (and below ice)
+      z_frc_temtop =           glob_sum( hfx_in (:,:) * e1e2t(:,:) ) * 1.e-20                                         ! heat on top of ice-coean
+      !
+      frc_voltop  = frc_voltop  + z_frc_voltop  * rdt_ice ! km3
+      frc_volbot  = frc_volbot  + z_frc_volbot  * rdt_ice ! km3
+      frc_sal     = frc_sal     + z_frc_sal     * rdt_ice ! km3*pss
+      frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J
+      frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J
+            
+      ! ----------------------- !
+      ! 3 -  Content variations !
+      ! ----------------------- !
+      zdiff_vol = r1_rau0 * glob_sum( ( rhoic*vt_i(:,:) + rhosn*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3) 
+      zdiff_sal = r1_rau0 * glob_sum( ( rhoic* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss)
+      zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:)             - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J)
+      !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check)
+
+      ! ----------------------- !
+      ! 4 -  Drifts             !
+      ! ----------------------- !
+      zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot )
+      zdiff_sal = zdiff_sal - frc_sal
+      zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop )
+
+      ! ----------------------- !
+      ! 5 - Diagnostics writing !
+      ! ----------------------- !
+!!gm I don't understand the division by the ocean surface (i.e. glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rdt )
+!!   and its multiplication bu kt ! is it really what we want ? what is this quantity ?
+!!   IF it is really what we want, compute it at kt=nit000, not 3 time by time-step !
+!!   kt*rdt  : you mean rdtice ?
+!!gm
+      !
+      IF( iom_use('ibgvolume')    )   CALL iom_put( 'ibgvolume' , zdiff_vol     )   ! ice/snow volume  drift            (km3 equivalent ocean water)         
+      IF( iom_use('ibgsaltco')    )   CALL iom_put( 'ibgsaltco' , zdiff_sal     )   ! ice salt content drift            (psu*km3 equivalent ocean water)
+      IF( iom_use('ibgheatco')    )   CALL iom_put( 'ibgheatco' , zdiff_tem     )   ! ice/snow heat content drift       (1.e20 J)
+      IF( iom_use('ibgheatfx')    )   CALL iom_put( 'ibgheatfx' ,               &   ! ice/snow heat flux drift          (W/m2)
+         &                                                     zdiff_tem /glob_sum( e1e2t(:,:) * 1.e-20 * kt*rdt ) )
+
+      IF( iom_use('ibgfrcvoltop') )   CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
+      IF( iom_use('ibgfrcvolbot') )   CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
+      IF( iom_use('ibgfrcsal')    )   CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)   
+      IF( iom_use('ibgfrctemtop') )   CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)   
+      IF( iom_use('ibgfrctembot') )   CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)   
+      IF( iom_use('ibgfrchfxtop') )   CALL iom_put( 'ibgfrchfxtop' ,            &   ! heat on top of ice/snw/ocean      (W/m2) 
+         &                                                          frc_temtop / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rdt  )
+      IF( iom_use('ibgfrchfxbot') )   CALL iom_put( 'ibgfrchfxbot' ,            &   ! heat on top of ocean(below ice)   (W/m2) 
+         &                                                          frc_tembot / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rdt  )
+
+      IF( iom_use('ibgvol_tot' )  )   CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                       (km3)
+      IF( iom_use('sbgvol_tot' )  )   CALL iom_put( 'sbgvol_tot'  , zbg_svol     )   ! snow volume                      (km3)
+      IF( iom_use('ibgarea_tot')  )   CALL iom_put( 'ibgarea_tot' , zbg_area     )   ! ice area                         (km2)
+      IF( iom_use('ibgsalt_tot')  )   CALL iom_put( 'ibgsalt_tot' , zbg_isal     )   ! ice salinity content             (pss*km3)
+      IF( iom_use('ibgheat_tot')  )   CALL iom_put( 'ibgheat_tot' , zbg_item     )   ! ice heat content                 (1.e20 J)
+      IF( iom_use('sbgheat_tot')  )   CALL iom_put( 'sbgheat_tot' , zbg_stem     )   ! snow heat content                (1.e20 J)
+      !
+      IF( lrst_ice )   CALL ice_dia_rst( 'WRITE', kt_ice )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('ice_dia')
+      !
+   END SUBROUTINE ice_dia
+
+
+   SUBROUTINE ice_dia_init
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_dia_init  ***
+      !!     
+      !! ** Purpose: Initialization for the heat salt volume budgets
+      !!	
+      !! ** Method : Compute initial heat content, salt content and volume
+      !!
+      !! ** Action : - Compute initial heat content, salt content and volume
+      !!             - Initialize forcing trends
+      !!             - Compute coefficients for conversion
+      !!---------------------------------------------------------------------------
+      INTEGER            ::   ios, ierror   ! local integer
+      !!
+      NAMELIST/namdia/ ln_icediachk, ln_icediahsb, ln_icectl, iiceprt, jiceprt  
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )      ! Namelist namdia in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )      ! Namelist namdia in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namdia )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_dia_init: ice diagnostics'
+         WRITE(numout,*) ' ~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namdia:'
+         WRITE(numout,*) '      Diagnose online heat/mass/salt budget      ln_icediachk = ', ln_icediachk
+         WRITE(numout,*) '      Output          heat/mass/salt budget      ln_icediahsb = ', ln_icediahsb
+         WRITE(numout,*) '      control prints for a given grid point      ln_icectl    = ', ln_icectl
+         WRITE(numout,*) '         chosen grid point position         (iiceprt,jiceprt) = (', iiceprt,',', jiceprt,')'
+      ENDIF
+      !      
+      IF( ln_icediahsb ) THEN
+         IF( ice_dia_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_dia_init : unable to allocate arrays' )   ! allocate tke arrays
+         CALL ice_dia_rst( 'READ' )   ! read or initialize all required files
+      ENDIF
+      !
+   END SUBROUTINE ice_dia_init
+
+
+   SUBROUTINE ice_dia_rst( cdrw, kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE icedia_rst  ***
+      !!                     
+      !! ** Purpose :   Read or write DIA file in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
+      !
+      INTEGER  ::   iter    ! local integer
+      REAL(wp) ::   ziter   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+         IF( ln_rstart ) THEN                   !* Read the restart file
+            !
+            CALL iom_get( numrir, 'kt_ice' , ziter )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'ice_dia_rst read at time step = ', ziter
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            CALL iom_get( numrir, 'frc_voltop' , frc_voltop  )
+            CALL iom_get( numrir, 'frc_volbot' , frc_volbot  )
+            CALL iom_get( numrir, 'frc_temtop' , frc_temtop  )
+            CALL iom_get( numrir, 'frc_tembot' , frc_tembot  )
+            CALL iom_get( numrir, 'frc_sal'    , frc_sal     )
+            CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini )
+            CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini )
+            CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini )
+         ELSE
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' ice_dia at initial state '
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+            ! set trends to 0
+            frc_voltop  = 0._wp                                          
+            frc_volbot  = 0._wp                                          
+            frc_temtop  = 0._wp                                                 
+            frc_tembot  = 0._wp                                                 
+            frc_sal     = 0._wp                                                 
+            ! record initial ice volume, salt and temp
+            vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:)  ! ice/snow volume (kg/m2)
+            tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                  ! ice/snow heat content (J)
+            sal_loc_ini(:,:) = rhoic * SUM( sv_i(:,:,:), dim=3 )      ! ice salt content (pss*kg/m2)
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
+         !
+         IF( iter == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'ice_dia_rst write at time step = ', kt
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ENDIF
+         !
+         ! Write in numriw (if iter == nitrst)
+         ! ------------------ 
+         CALL iom_rstput( iter, nitrst, numriw, 'frc_voltop' , frc_voltop  )
+         CALL iom_rstput( iter, nitrst, numriw, 'frc_volbot' , frc_volbot  )
+         CALL iom_rstput( iter, nitrst, numriw, 'frc_temtop' , frc_temtop  )
+         CALL iom_rstput( iter, nitrst, numriw, 'frc_tembot' , frc_tembot  )
+         CALL iom_rstput( iter, nitrst, numriw, 'frc_sal'    , frc_sal     )
+         CALL iom_rstput( iter, nitrst, numriw, 'vol_loc_ini', vol_loc_ini )
+         CALL iom_rstput( iter, nitrst, numriw, 'tem_loc_ini', tem_loc_ini )
+         CALL iom_rstput( iter, nitrst, numriw, 'sal_loc_ini', sal_loc_ini )
+         !
+      ENDIF
+      !
+   END SUBROUTINE ice_dia_rst
+ 
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icedia
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90	(revision 8586)
@@ -0,0 +1,285 @@
+MODULE icedyn
+   !!======================================================================
+   !!                     ***  MODULE  icedyn  ***
+   !!   Sea-Ice dynamics : master routine for sea ice dynamics 
+   !!======================================================================
+   !! history :  4.0  ! 2017-09  (C. Rousset)  original code 
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_dyn       : dynamics of sea ice
+   !!   ice_dyn_init  : initialization and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE ice            ! sea-ice: variables
+   USE icedyn_rhg     ! sea-ice: rheology
+   USE icedyn_adv     ! sea-ice: advection
+   USE icedyn_rdgrft  ! sea-ice: ridging/rafting
+   USE icecor         ! sea-ice: corrections
+   USE icevar         ! sea-ice: operations
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dyn        ! called by icestp.F90
+   PUBLIC   ice_dyn_init   ! called by icestp.F90
+   
+   INTEGER ::              nice_dyn   ! choice of the type of dynamics
+   !                                        ! associated indices:
+   INTEGER, PARAMETER ::   np_dynFULL    = 1   ! full ice dynamics               (rheology + advection + ridging/rafting + correction)
+   INTEGER, PARAMETER ::   np_dynRHGADV1 = 2   ! no ridging/rafting              (rheology + advection                   + correction)
+   INTEGER, PARAMETER ::   np_dynRHGADV2 = 3   ! pure dynamics                   (rheology + advection) 
+   INTEGER, PARAMETER ::   np_dynADV     = 4   ! only advection w prescribed vel.(rn_uvice + advection)
+   !
+   ! ** namelist (namdyn) **
+   LOGICAL  ::   ln_dynFULL       ! full ice dynamics               (rheology + advection + ridging/rafting + correction)
+   LOGICAL  ::   ln_dynRHGADV     ! no ridge/raft & no corrections  (rheology + advection)
+   LOGICAL  ::   ln_dynADV        ! only advection w prescribed vel.(rn_uvice + advection)
+   REAL(wp) ::   rn_uice          !    prescribed u-vel (case np_dynADV)
+   REAL(wp) ::   rn_vice          !    prescribed v-vel (case np_dynADV)
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedyn.F90 8378 2017-07-26 13:55:59Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_dyn( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE ice_dyn  ***
+      !!               
+      !! ** Purpose :   this routine manages sea ice dynamics
+      !!
+      !! ** Action : - Initialisation of some variables
+      !!             - call ice_rhg
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ice time step
+      !!
+      INTEGER ::   ji, jj, jl         ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zhmax
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('icedyn')
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'ice_dyn: sea-ice dynamics'
+         WRITE(numout,*)'~~~~~~~'
+      ENDIF
+
+      !                      
+      IF( ln_landfast ) THEN            !-- Landfast ice parameterization: define max bottom friction
+         tau_icebfr(:,:) = 0._wp
+         DO jl = 1, jpl
+            WHERE( h_i(:,:,jl) > ht_n(:,:) * rn_gamma )   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr
+         END DO
+         IF( iom_use('tau_icebfr') )   CALL iom_put( 'tau_icebfr', tau_icebfr )  
+      ENDIF
+
+      zhmax(:,:,:) = h_i_b(:,:,:)      !-- Record max of the surrounding 9-pts ice thick. (for CALL Hbig)
+      DO jl = 1, jpl
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+!!gm use of MAXVAL here is very probably less efficient than expending the 9 values
+               zhmax(ji,jj,jl) = MAX( epsi20, MAXVAL( h_i_b(ji-1:ji+1,jj-1:jj+1,jl) ) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zhmax(:,:,:), 'T', 1. )
+      !
+      !
+      SELECT CASE( nice_dyn )           !-- Set which dynamics is running
+
+      CASE ( np_dynFULL )          !==  all dynamical processes  ==!
+         CALL ice_dyn_rhg   ( kt )                            ! -- rheology  
+         CALL ice_dyn_adv   ( kt )   ;   CALL Hbig( zhmax )   ! -- advection of ice + correction on ice thickness
+         CALL ice_dyn_rdgrft( kt )                            ! -- ridging/rafting 
+         CALL ice_cor       ( kt , 1 )                        ! -- Corrections
+
+      CASE ( np_dynRHGADV1 )       !==  no ridge/raft ==!   (mono cat. case 2)
+         CALL ice_dyn_rhg   ( kt )                            ! -- rheology  
+         CALL ice_dyn_adv   ( kt )                            ! -- advection of ice
+         CALL Hpiling                                         ! -- simple pile-up (replaces ridging/rafting)
+         CALL ice_cor       ( kt , 1 )                        ! -- Corrections
+
+      CASE ( np_dynRHGADV2 )       !==  no ridge/raft & no corrections ==!
+         CALL ice_dyn_rhg   ( kt )                            ! -- rheology  
+         CALL ice_dyn_adv   ( kt )                            ! -- advection of ice
+         CALL Hpiling                                         ! -- simple pile-up (replaces ridging/rafting)
+
+      CASE ( np_dynADV )           !==  pure advection ==!   (prescribed velocities)
+         u_ice(:,:) = rn_uice * umask(:,:,1)
+         v_ice(:,:) = rn_vice * vmask(:,:,1)
+         !!CALL RANDOM_NUMBER(u_ice(:,:))
+         !!CALL RANDOM_NUMBER(v_ice(:,:))
+         CALL ice_dyn_adv   ( kt )                            ! -- advection of ice
+
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('icedyn')
+      !
+   END SUBROUTINE ice_dyn
+
+   SUBROUTINE Hbig( phmax )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE Hbig  ***
+      !!
+      !! ** Purpose : Thickness correction in case advection scheme creates
+      !!              abnormally tick ice
+      !!
+      !! ** Method  : 1- check whether ice thickness resulting from advection is
+      !!                 larger than the surrounding 9-points before advection
+      !!                 and reduce it if a) divergence or b) convergence & at_i>0.8
+      !!              2- bound ice thickness with hi_max (99m)
+      !!
+      !! ** input   : Max thickness of the surrounding 9-points
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   phmax   ! max ice thick from surrounding 9-pts
+      !
+      INTEGER  ::   ji, jj, jl         ! dummy loop indices
+      REAL(wp) ::   zh, zdv
+      !!-------------------------------------------------------------------
+      !
+      CALL ice_var_zapsmall                       !-- zap small areas
+      !
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( v_i(ji,jj,jl) > 0._wp ) THEN  !-- bound to hmax
+                  !
+                  zh  = v_i (ji,jj,jl) / a_i(ji,jj,jl)
+                  zdv = v_i(ji,jj,jl) - v_i_b(ji,jj,jl)  
+                  !
+                  IF ( ( zdv >  0.0 .AND. zh > phmax(ji,jj,jl) .AND. at_i_b(ji,jj) < 0.80 ) .OR. &
+                     & ( zdv <= 0.0 .AND. zh > phmax(ji,jj,jl) ) ) THEN
+                     a_i (ji,jj,jl) = v_i(ji,jj,jl) / MIN( phmax(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m)
+                  ENDIF
+                  !
+               ENDIF
+            END DO
+         END DO
+      END DO
+            
+      IF ( nn_pnd_scheme > 0 ) THEN               !-- correct pond fraction to avoid a_ip > a_i
+         WHERE( a_ip(:,:,:) > a_i(:,:,:) )   a_ip(:,:,:) = a_i(:,:,:)
+      ENDIF
+      !
+   END SUBROUTINE Hbig
+
+   SUBROUTINE Hpiling
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE Hpiling  ***
+      !!
+      !! ** Purpose : Simple conservative piling comparable with 1-cat models
+      !!
+      !! ** Method  : pile-up ice when no ridging/rafting
+      !!
+      !! ** input   : a_i
+      !!-------------------------------------------------------------------
+      INTEGER ::   jl         ! dummy loop indices
+      !!-------------------------------------------------------------------
+      !
+      CALL ice_var_zapsmall                       !-- zap small areas
+      !
+      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
+      DO jl = 1, jpl
+         WHERE( at_i(:,:) > epsi20 )
+            a_i(:,:,jl) = a_i(:,:,jl) * (  1._wp + MIN( rn_amax_2d(:,:) - at_i(:,:) , 0._wp ) / at_i(:,:)  )
+         END WHERE
+      END DO
+      !
+   END SUBROUTINE Hpiling
+
+   SUBROUTINE ice_dyn_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_dyn_init  ***
+      !!
+      !! ** Purpose : Physical constants and parameters linked to the ice
+      !!      dynamics
+      !!
+      !! ** Method  :  Read the namdyn namelist and check the ice-dynamic
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namdyn
+      !!-------------------------------------------------------------------
+      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namdyn/ ln_dynFULL, ln_dynRHGADV, ln_dynADV, rn_uice, rn_vice,  &
+         &             rn_ishlat  ,                                            &
+         &             ln_landfast, rn_gamma , rn_icebfr, rn_lfrelax
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )         ! Namelist namdyn in reference namelist : Ice dynamics
+      READ  ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist', lwp )
+      !
+      REWIND( numnam_ice_cfg )         ! Namelist namdyn in configuration namelist : Ice dynamics
+      READ  ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namdyn )
+      !
+      IF(lwp) THEN                     ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_dyn_init: ice parameters for ice dynamics '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namdyn:'
+         WRITE(numout,*) '      Full ice dynamics      (rhg + adv + ridge/raft + corr)  ln_dynFULL   = ', ln_dynFULL
+         WRITE(numout,*) '      No ridge/raft & No cor (rhg + adv)                      ln_dynRHGADV = ', ln_dynRHGADV
+         WRITE(numout,*) '      Advection only         (rn_uvice + adv)                 ln_dynADV    = ', ln_dynADV
+         WRITE(numout,*) '           with prescribed velocity given by '
+         WRITE(numout,*) '               a uniform field               (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',', rn_vice,')'
+         WRITE(numout,*) '      lateral boundary condition for sea ice dynamics         rn_ishlat    = ', rn_ishlat
+         WRITE(numout,*) '      Landfast: param (T or F)                                ln_landfast  = ', ln_landfast
+         WRITE(numout,*) '         fraction of ocean depth that ice must reach          rn_gamma     = ', rn_gamma
+         WRITE(numout,*) '         maximum bottom stress per unit area of contact       rn_icebfr    = ', rn_icebfr
+         WRITE(numout,*) '         relax time scale (s-1) to reach static friction      rn_lfrelax   = ', rn_lfrelax
+      ENDIF
+      !                             !== set the choice of ice dynamics ==!
+      ioptio = 0 
+      !      !--- full dynamics                               (rheology + advection + ridging/rafting + correction)
+      IF( ln_dynFULL .AND. nn_monocat /= 2 ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynFULL      ;   ENDIF
+      !      !--- dynamics without ridging/rafting            (rheology + advection                   + correction)
+      IF( ln_dynFULL .AND. nn_monocat == 2 ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynRHGADV1   ;   ENDIF
+      !      !--- dynamics without ridging/rafting and corr   (rheology + advection)
+      IF( ln_dynRHGADV                     ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynRHGADV2   ;   ENDIF
+      !      !--- advection only with prescribed ice velocities (from namelist)
+      IF( ln_dynADV                        ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynADV       ;   ENDIF
+      !
+      IF( ioptio /= 1 )    CALL ctl_stop( 'ice_dyn_init: one and only one ice dynamics option has to be defined ' )
+      !
+      !                                      !--- Lateral boundary conditions
+      IF     (      rn_ishlat == 0.                ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  free-slip'
+      ELSEIF (      rn_ishlat == 2.                ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  no-slip'
+      ELSEIF ( 0. < rn_ishlat .AND. rn_ishlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  partial-slip'
+      ELSEIF ( 2. < rn_ishlat                      ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  strong-slip'
+      ENDIF
+      !                                      !--- NO Landfast ice : set to zero once for all
+      IF( .NOT. ln_landfast )   tau_icebfr(:,:) = 0._wp
+      !
+      CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters
+      CALL ice_dyn_rhg_init             ! set ice rheology parameters
+      CALL ice_dyn_adv_init             ! set ice advection parameters
+      !
+   END SUBROUTINE ice_dyn_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif 
+
+   !!======================================================================
+END MODULE icedyn
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90	(revision 8586)
@@ -0,0 +1,175 @@
+MODULE icedyn_adv
+   !!======================================================================
+   !!                       ***  MODULE icedyn_adv   ***
+   !!   ESIM : sea-ice advection
+   !!======================================================================
+   !! History : LIM-2 ! 2000-01 (M.A. Morales Maqueda, H. Goosse, and T. Fichefet)  Original code
+   !!            3.0  ! 2005-11 (M. Vancoppenolle)   Multi-layer sea ice, salinity variations
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_dyn_adv   : advection of sea ice variables
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constant
+   USE dom_oce        ! ocean domain
+   USE sbc_oce , ONLY : nn_fsbc   ! frequency of sea-ice call
+   USE ice            ! sea-ice: variables
+   USE icevar         ! sea-ice: operations
+   USE icedyn_adv_pra ! sea-ice: advection scheme (Prather)
+   USE icedyn_adv_umx ! sea-ice: advection scheme (ultimate-macho)
+   USE icectl         ! sea-ice: control prints
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE timing         ! Timing
+   USE prtctl         ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dyn_adv        ! called by icestp
+   PUBLIC   ice_dyn_adv_init   ! called by icedyn
+
+   INTEGER ::              nice_adv   ! choice of the type of advection scheme
+   !                                        ! associated indices:
+   INTEGER, PARAMETER ::   np_advPRA = 1   ! Prather scheme
+   INTEGER, PARAMETER ::   np_advUMx = 2   ! Ultimate-Macho scheme
+   !
+   ! ** namelist (namdyn_adv) **
+   LOGICAL ::   ln_adv_Pra   ! Prather        advection scheme
+   LOGICAL ::   ln_adv_UMx   ! Ultimate-Macho advection scheme
+   INTEGER ::   nn_UMx       ! order of the UMx advection scheme   
+   !
+   !! * Substitution
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedyn_adv.F90 8373 2017-07-25 17:44:54Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_dyn_adv( kt ) 
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_dyn_adv ***
+      !!                    
+      !! ** purpose : advection of sea ice
+      !!
+      !! ** method  : One can choose between 
+      !!     a) an Ultimate-Macho scheme (with order defined by nn_UMx) => ln_adv_UMx
+      !!     b) and a second order Prather scheme => ln_adv_Pra
+      !!
+      !! ** action :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('icedyn_adv')
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_dyn_adv: sea-ice advection'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      
+      ! conservation test
+      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
+                     
+      !----------
+      ! Advection
+      !----------
+      SELECT CASE( nice_adv )
+      !                                !-----------------------!
+      CASE( np_advUMx )                ! ULTIMATE-MACHO scheme !
+         !                             !-----------------------!
+         CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice,  &
+            &                  ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
+      !                                !-----------------------!
+      CASE( np_advPRA )                ! PRATHER scheme        !
+         !                             !-----------------------!
+         CALL ice_dyn_adv_pra( kt, u_ice, v_ice,  &
+            &                  ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
+      END SELECT
+
+      !------------
+      ! diagnostics
+      !------------
+      diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice
+      diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
+      diag_trp_sv(:,:) = SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice
+      diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice
+      diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice
+      IF( iom_use('icetrp') )   CALL iom_put( "icetrp" , diag_trp_vi )          ! ice volume transport
+      IF( iom_use('snwtrp') )   CALL iom_put( "snwtrp" , diag_trp_vs )          ! snw volume transport
+      IF( iom_use('saltrp') )   CALL iom_put( "saltrp" , diag_trp_sv * rhoic )  ! salt content transport
+      IF( iom_use('deitrp') )   CALL iom_put( "deitrp" , diag_trp_ei )          ! advected ice enthalpy (W/m2)
+      IF( iom_use('destrp') )   CALL iom_put( "destrp" , diag_trp_es )          ! advected snw enthalpy (W/m2)
+
+      ! controls
+      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+      IF( ln_icectl      )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ')                           ! prints
+      IF( nn_timing == 1 )   CALL timing_stop ('icedyn_adv')                                                             ! timing
+      !
+   END SUBROUTINE ice_dyn_adv
+
+
+   SUBROUTINE ice_dyn_adv_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_dyn_adv_init  ***
+      !!
+      !! ** Purpose :   Physical constants and parameters linked to the ice
+      !!                dynamics
+      !!
+      !! ** Method  :   Read the namdyn_adv namelist and check the ice-dynamic
+      !!                parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namdyn_adv
+      !!-------------------------------------------------------------------
+      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namdyn_adv/ ln_adv_Pra, ln_adv_UMx, nn_UMx
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )         ! Namelist namdyn_adv in reference namelist : Ice dynamics
+      READ  ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp )
+      !
+      REWIND( numnam_ice_cfg )         ! Namelist namdyn_adv in configuration namelist : Ice dynamics
+      READ  ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namdyn_adv )
+      !
+      IF(lwp) THEN                     ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_dyn_adv_init: ice parameters for ice dynamics '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namdyn_adv:'
+         WRITE(numout,*) '      type of advection scheme (Prather)             ln_adv_Pra = ', ln_adv_Pra 
+         WRITE(numout,*) '      type of advection scheme (Ulimate-Macho)       ln_adv_UMx = ', ln_adv_UMx 
+         WRITE(numout,*) '         order of the Ultimate-Macho scheme          nn_UMx     = ', nn_UMx
+      ENDIF
+      !
+      !                             !== set the choice of ice advection ==!
+      ioptio = 0 
+      IF( ln_adv_Pra ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advPRA    ;   ENDIF
+      IF( ln_adv_UMx ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advUMx    ;   ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_dyn_adv_init: choose one and only one ice adv. scheme (ln_adv_Pra or ln_adv_UMx)' )
+      !
+      IF( ln_adv_Pra )   CALL adv_pra_init  !* read or initialize all required files
+      !
+   END SUBROUTINE ice_dyn_adv_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icedyn_adv
+
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90	(revision 8586)
@@ -0,0 +1,1039 @@
+MODULE icedyn_adv_pra 
+   !!======================================================================
+   !!                       ***  MODULE icedyn_adv_pra   ***
+   !!   sea-ice : advection => Prather scheme
+   !!======================================================================
+   !! History :  LIM  ! 2008-03 (M. Vancoppenolle)  LIM-3 from LIM-2 code
+   !!            3.2  ! 2009-06 (F. Dupont)  correct a error in the North fold b.c.
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!--------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_dyn_adv_pra   : advection of sea ice using Prather scheme
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE ice            ! sea-ice variables
+   USE sbc_oce , ONLY : nn_fsbc   ! frequency of sea-ice call
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE prtctl         ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dyn_adv_pra   ! called by icedyn_adv
+   PUBLIC   adv_pra_init      ! called by icedyn_adv
+
+   ! Moments for advection
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   ! open water in sea ice
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   ! ice thickness 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    ! snow thickness
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     ! lead fraction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxc0 , syc0 , sxxc0 , syyc0 , sxyc0    ! snow thermal content
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   ! ice salinity
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   ! ice age
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxap , syap , sxxap , syyap , sxyap    ! melt pond fraction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvp , syvp , sxxvp , syyvp , sxyvp    ! melt pond volume
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     ! ice layers heat content
+   !
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedyn_adv_pra.F90 6746 2016-06-27 17:20:57Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice,  &
+      &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
+      !!----------------------------------------------------------------------
+      !!                **  routine ice_dyn_adv_pra  **
+      !!  
+      !! ** purpose :   Computes and adds the advection trend to sea-ice
+      !!
+      !! ** method  :   Uses Prather second order scheme that advects tracers
+      !!                but also their quadratic forms. The method preserves
+      !!                tracer structures by conserving second order moments.
+      !!
+      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   kt         ! time step
+      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pu_ice     ! ice i-velocity
+      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pv_ice     ! ice j-velocity
+      REAL(wp), DIMENSION(:,:)    , INTENT(inout) ::   pato_i     ! open water area
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i       ! ice volume
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_s       ! snw volume
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   psv_i      ! salt content
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   poa_i      ! age content
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_i       ! ice concentration
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content
+      !
+      INTEGER  ::   jk, jl, jt              ! dummy loop indices
+      INTEGER  ::   initad                  ! number of sub-timestep for the advection
+      REAL(wp) ::   zcfl , zusnit           !   -      -
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zarea
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   z0opw
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   z0ice, z0snw, z0ai, z0es , z0smi , z0oi
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   z0ap , z0vp
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   z0ei
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme'
+      !
+      ALLOCATE( zarea(jpi,jpj)     , z0opw(jpi,jpj, 1 ) ,                                           &
+         &      z0ice(jpi,jpj,jpl) , z0snw(jpi,jpj,jpl) , z0ai(jpi,jpj,jpl) , z0es(jpi,jpj,jpl) ,   &
+         &      z0smi(jpi,jpj,jpl) , z0oi (jpi,jpj,jpl) , z0ap(jpi,jpj,jpl) , z0vp(jpi,jpj,jpl) ,   &
+         &      z0ei (jpi,jpj,nlay_i,jpl)                                                           )
+      !
+      ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- !        
+      zcfl  =            MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )
+      zcfl  = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+      IF( lk_mpp )   CALL mpp_max( zcfl )
+      
+      IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
+      ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
+      ENDIF
+      
+      zarea(:,:) = e1e2t(:,:)
+      !-------------------------
+      ! transported fields                                        
+      !-------------------------
+      z0opw(:,:,1) = pato_i(:,:) * e1e2t(:,:)              ! Open water area 
+      DO jl = 1, jpl
+         z0snw(:,:,jl) = pv_s (:,:,  jl) * e1e2t(:,:)     ! Snow volume
+         z0ice(:,:,jl) = pv_i (:,:,  jl) * e1e2t(:,:)     ! Ice  volume
+         z0ai (:,:,jl) = pa_i (:,:,  jl) * e1e2t(:,:)     ! Ice area
+         z0smi(:,:,jl) = psv_i(:,:,  jl) * e1e2t(:,:)     ! Salt content
+         z0oi (:,:,jl) = poa_i(:,:,  jl) * e1e2t(:,:)     ! Age content
+         z0es (:,:,jl) = pe_s (:,:,1,jl) * e1e2t(:,:)     ! Snow heat content
+         DO jk = 1, nlay_i
+            z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content
+         END DO
+         IF ( nn_pnd_scheme > 0 ) THEN
+            z0ap(:,:,jl)  = pa_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond fraction
+            z0vp(:,:,jl)  = pv_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond volume
+         ENDIF
+      END DO
+
+      !                                                    !--------------------------------------------!
+      IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==!
+         !                                                 !--------------------------------------------!
+         DO jt = 1, initad
+            CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+               &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &
+               &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            DO jl = 1, jpl
+               CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                  &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &
+                  &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                  &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &
+                  &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                  &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &
+                  &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---     
+                  &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &
+                  &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations ---
+                  &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
+                  &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents ---
+                  &                                      sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &
+                  &                                      sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+               DO jk = 1, nlay_i                                                               !--- ice heat contents ---
+                  CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     &                                      sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                     &                                      syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                  CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     &                                      sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                     &                                      syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+               END DO
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   &    !--- melt pond fraction --
+                     &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  )
+                  CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   & 
+                     &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  )
+                  CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   &    !--- melt pond volume   --
+                     &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  )
+                  CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   & 
+                     &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  )
+               ENDIF
+            END DO
+         END DO
+      !                                                    !--------------------------------------------!
+      ELSE                                                 !== even ice time step:  adv_y then adv_x  ==!
+         !                                                 !--------------------------------------------!
+         DO jt = 1, initad
+            CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+               &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &
+               &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            DO jl = 1, jpl
+               CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                  &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &
+                  &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                  &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &
+                  &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                  &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &
+                  &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
+                  &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &
+                  &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                  &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &
+                  &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+               CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                  &                                      sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+               CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &
+                  &                                      sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+               DO jk = 1, nlay_i                                                             !--- ice heat contents ---
+                  CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     &                                      sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                     &                                      syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                  CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     &                                      sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                     &                                      syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+               END DO
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   &   !--- melt pond fraction ---
+                     &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  )
+                  CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   &
+                     &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  )
+                  CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   &   !--- melt pond volume   ---
+                     &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  )
+                  CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   &
+                     &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  )
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      !-------------------------------------------
+      ! Recover the properties from their contents
+      !-------------------------------------------
+      pato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:)
+      DO jl = 1, jpl
+         pv_i (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:)
+         pv_s (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:)
+         psv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:)
+         poa_i(:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:)
+         pa_i (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:)
+         pe_s (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:)
+         DO jk = 1, nlay_i
+            pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:)
+         END DO
+         ! MV MP 2016
+         IF ( nn_pnd_scheme > 0 ) THEN
+            pa_ip  (:,:,jl)   = z0ap (:,:,jl) * r1_e1e2t(:,:)
+            pv_ip  (:,:,jl)   = z0vp (:,:,jl) * r1_e1e2t(:,:)
+         ENDIF
+         ! END MV MP 2016
+      END DO
+      !
+      DEALLOCATE( zarea , z0opw , z0ice, z0snw , z0ai , z0es , z0smi , z0oi , z0ap , z0vp , z0ei )
+      !
+      IF( lrst_ice )   CALL adv_pra_rst( 'WRITE', kt )   !* write Prather fields in the restart file
+      !
+   END SUBROUTINE ice_dyn_adv_pra
+   
+   SUBROUTINE adv_x( pdf, put , pcrh, psm , ps0 ,   &
+      &              psx, psxx, psy , psyy, psxy )
+      !!----------------------------------------------------------------------
+      !!                **  routine adv_x  **
+      !!  
+      !! ** purpose :   Computes and adds the advection trend to sea-ice
+      !!                variable on x axis
+      !!----------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
+      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call adv_x then adv_y (=1) or the opposite (=0)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   put                ! i-direction ice velocity at U-point [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
+      !! 
+      INTEGER  ::   ji, jj                               ! dummy loop indices
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars
+      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      -
+      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zf0 , zfx  , zfy   , zbet   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfm , zfxx , zfyy  , zfxy   !  -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q         !  -      -
+      !-----------------------------------------------------------------------
+
+      ! Limitation of moments.                                           
+
+      zrdt = rdt_ice * pdf      ! If ice drift field is too fast, use an appropriate time step for advection.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zslpmax = MAX( 0._wp, ps0(ji,jj) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) )
+            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
+               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+
+            ps0 (ji,jj) = zslpmax  
+            psx (ji,jj) = zs1new      * rswitch
+            psxx(ji,jj) = zs2new      * rswitch
+            psy (ji,jj) = psy (ji,jj) * rswitch
+            psyy(ji,jj) = psyy(ji,jj) * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
+         END DO
+      END DO
+
+      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
+      psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+
+      !  Calculate fluxes and moments between boxes i<-->i+1              
+      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0 
+         DO ji = 1, jpi
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
+            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  *   psm (ji,jj)
+            zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj) )  )
+            zfx (ji,jj)  =  zalfq * ( psx (ji,jj) + 3.0 * zalf1 * psxx(ji,jj) )
+            zfxx(ji,jj)  =  zalf  *   psxx(ji,jj) * zalfq
+            zfy (ji,jj)  =  zalf  * ( psy (ji,jj) + zalf1 * psxy(ji,jj) )
+            zfxy(ji,jj)  =  zalfq *   psxy(ji,jj)
+            zfyy(ji,jj)  =  zalf  *   psyy(ji,jj)
+
+            !  Readjust moments remaining in the box.
+            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+            psx (ji,jj)  =  zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) )
+            psxx(ji,jj)  =  zalf1  * zalf1q * psxx(ji,jj)
+            psy (ji,jj)  =  psy (ji,jj) - zfy(ji,jj)
+            psyy(ji,jj)  =  psyy(ji,jj) - zfyy(ji,jj)
+            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0.
+         DO ji = 1, fs_jpim1
+            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            !
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji+1,jj)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) )
+            zfx   (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) )
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji+1,jj) * zalfq
+            zfy   (ji,jj) = zfy (ji,jj) + zalf  * ( psy (ji+1,jj) - zalf1 * psxy(ji+1,jj) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji+1,jj)
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji+1,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Readjust moments remaining in the box. 
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            !
+            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) )
+            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) )
+            psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) )
+            psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj)
+            psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) )
+            psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj)
+         END DO
+      END DO
+
+      !   Put the temporary moments into appropriate neighboring boxes.    
+      DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0.
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj)
+            zalf        = zbt * zfm(ji-1,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj)
+            !
+            ps0 (ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj)
+            psx (ji,jj) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj)
+            psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj)                               &
+               &                + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  )   &
+               &                                                + zbt1 * psxx(ji,jj)
+            psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj)             &
+               &                + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj) ) )   &
+               &                                                + zbt1 * psxy(ji,jj)
+            psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj)
+            psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Flux from i+1 to i IF u LT 0.
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj)  = zbt * psm(ji,jj)  + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = - zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)
+            !
+            ps0(ji,jj)  = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )
+            psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp )
+            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( zalf * zalf * zfxx(ji,jj)  + zalf1 * zalf1 * psxx(ji,jj)  &
+               &                                      + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) )      &
+               &                                      + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)  &
+               &                                      + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) )  )
+            psy(ji,jj)  = zbt * psy (ji,jj)  + zbt1 * ( psy (ji,jj) + zfy (ji,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj)  + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) )
+         END DO
+      END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   &
+         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1., psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=psm  , clinfo1=' adv_x: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
+         CALL prt_ctl(tab2d_1=psx  , clinfo1=' adv_x: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
+         CALL prt_ctl(tab2d_1=psy  , clinfo1=' adv_x: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
+         CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_x: psxy :')
+      ENDIF
+      !
+   END SUBROUTINE adv_x
+
+
+   SUBROUTINE adv_y( pdf, pvt , pcrh, psm , ps0 ,   &
+      &              psx, psxx, psy , psyy, psxy )
+      !!---------------------------------------------------------------------
+      !!                **  routine adv_y  **
+      !!            
+      !! ** purpose :   Computes and adds the advection trend to sea-ice 
+      !!                variable on y axis
+      !!---------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
+      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call adv_x then adv_y (=1) or the opposite (=0)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvt                ! j-direction ice velocity at V-point [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
+      !!
+      INTEGER  ::   ji, jj                               ! dummy loop indices
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars
+      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
+      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      -
+      !---------------------------------------------------------------------
+
+      ! Limitation of moments.
+
+      zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zslpmax = MAX( 0._wp, ps0(ji,jj) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) )
+            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
+               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+            !
+            ps0 (ji,jj) = zslpmax  
+            psx (ji,jj) = psx (ji,jj) * rswitch
+            psxx(ji,jj) = psxx(ji,jj) * rswitch
+            psy (ji,jj) = zs1new * rswitch
+            psyy(ji,jj) = zs2new * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
+         END DO
+      END DO
+
+      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
+      psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
+
+      !  Calculate fluxes and moments between boxes j<-->j+1              
+      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0   
+         DO ji = 1, jpi
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
+            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  * psm(ji,jj)
+            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) ) 
+            zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) )
+            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj)
+            zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) )
+            zfxy(ji,jj)  =  zalfq * psxy(ji,jj)
+            zfxx(ji,jj)  =  zalf  * psxx(ji,jj)
+            !
+            !  Readjust moments remaining in the box.
+            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+            psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) )
+            psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj)
+            psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj)
+            psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj)
+            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+         END DO
+      END DO
+      !
+      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
+         DO ji = 1, jpi
+            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            !
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji,jj+1)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) )
+            zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) )
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji,jj+1) * zalfq
+            zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx (ji,jj+1) - zalf1 * psxy(ji,jj+1) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji,jj+1)
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji,jj+1)
+         END DO
+      END DO
+
+      !  Readjust moments remaining in the box. 
+      DO jj = 2, jpj
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            !
+            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) )
+            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) )
+            psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) )
+            psyy(ji,jj) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj)
+            psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) )
+            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) )
+            psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj)
+         END DO
+      END DO
+
+      !   Put the temporary moments into appropriate neighboring boxes.    
+      DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0.
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 
+            zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj) 
+            zalf1       = 1.0 - zalf
+            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1)
+            !
+            ps0(ji,jj)  = zbt  * ( ps0(ji,jj) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj)
+            psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   &
+               &                                               + zbt1 * psy(ji,jj)  
+            psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             &
+               &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   & 
+               &                                               + zbt1 * psyy(ji,jj)
+            psxy(ji,jj) = zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)               &
+               &                  + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) )  )   &
+               &                                                + zbt1 * psxy(ji,jj)
+            psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj)
+            psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0.
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj)
+            zbt1 = ( 1.0 - zbet(ji,jj) )
+            psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = - zalf * ps0 (ji,jj) + zalf1 * zf0(ji,jj)
+            ps0 (ji,jj) =   zbt  * ps0 (ji,jj) + zbt1  * ( ps0(ji,jj) + zf0(ji,jj) )
+            psy (ji,jj) =   zbt  * psy (ji,jj) + zbt1  * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp )
+            psyy(ji,jj) =   zbt  * psyy(ji,jj) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)   &
+               &                                         + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) )          &
+               &                                         + ( zalf1 - zalf ) * ztemp )                                )
+            psxy(ji,jj) =   zbt  * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)       &
+               &                                         + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) )  )
+            psx (ji,jj) =   zbt  * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) )
+            psxx(ji,jj) =   zbt  * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) )
+         END DO
+      END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   &
+         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1.,  psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=psm  , clinfo1=' adv_y: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
+         CALL prt_ctl(tab2d_1=psx  , clinfo1=' adv_y: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
+         CALL prt_ctl(tab2d_1=psy  , clinfo1=' adv_y: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
+         CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_y: psxy :')
+      ENDIF
+      !
+   END SUBROUTINE adv_y
+
+   SUBROUTINE adv_pra_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE adv_pra_init  ***
+      !!
+      !! ** Purpose :   allocate and initialize arrays for Prather advection 
+      !!-------------------------------------------------------------------
+      INTEGER ::   ierr
+      !!-------------------------------------------------------------------
+      ALLOCATE( sxopw(jpi,jpj)     , syopw(jpi,jpj)     , sxxopw(jpi,jpj)     , syyopw(jpi,jpj)     , sxyopw(jpi,jpj)     ,   &
+         &      sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   &
+         &      sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) ,   &
+         &      sxa  (jpi,jpj,jpl) , sya  (jpi,jpj,jpl) , sxxa  (jpi,jpj,jpl) , syya  (jpi,jpj,jpl) , sxya  (jpi,jpj,jpl) ,   &
+         &      sxc0 (jpi,jpj,jpl) , syc0 (jpi,jpj,jpl) , sxxc0 (jpi,jpj,jpl) , syyc0 (jpi,jpj,jpl) , sxyc0 (jpi,jpj,jpl) ,   &
+         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   &
+         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   &
+         &      sxap(jpi,jpj,jpl)  , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   &
+         &      sxvp(jpi,jpj,jpl)  , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   &
+         &      sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) , &
+         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , &
+         &      STAT = ierr )
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'adv_pra_init : unable to allocate ice arrays for Prather advection scheme')
+      !
+      CALL adv_pra_rst( 'READ' )  !* read or initialize all required files
+      !
+   END SUBROUTINE adv_pra_init
+
+   SUBROUTINE adv_pra_rst( cdrw, kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE adv_pra_rst  ***
+      !!                     
+      !! ** Purpose :   Read or write RHG file in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
+      !
+      INTEGER ::   jk, jl   ! dummy loop indices
+      INTEGER ::   iter     ! local integer
+      INTEGER ::   id1      ! local integer
+      CHARACTER(len=25) ::   znam
+      CHARACTER(len=2)  ::   zchar, zchar1
+      REAL(wp), DIMENSION(jpi,jpj) :: z2d
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize
+         !                                   ! ---------------
+         IF( ln_rstart ) THEN                   !* Read the restart file
+            !
+            id1 = iom_varid( numrir, 'sxopw' , ldstop = .FALSE. )
+            !
+            IF( id1 > 0 ) THEN      ! fields exist
+               DO jl = 1, jpl 
+                  WRITE(zchar,'(I2.2)') jl
+                  znam = 'sxice'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxice(:,:,jl) = z2d(:,:)
+                  znam = 'syice'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syice(:,:,jl) = z2d(:,:)
+                  znam = 'sxxice'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxxice(:,:,jl) = z2d(:,:)
+                  znam = 'syyice'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syyice(:,:,jl) = z2d(:,:)
+                  znam = 'sxyice'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxyice(:,:,jl) = z2d(:,:)
+                  znam = 'sxsn'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxsn(:,:,jl) = z2d(:,:)
+                  znam = 'sysn'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sysn(:,:,jl) = z2d(:,:)
+                  znam = 'sxxsn'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxxsn(:,:,jl) = z2d(:,:)
+                  znam = 'syysn'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syysn(:,:,jl) = z2d(:,:)
+                  znam = 'sxysn'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxysn(:,:,jl) = z2d(:,:)
+                  znam = 'sxa'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxa(:,:,jl) = z2d(:,:)
+                  znam = 'sya'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sya(:,:,jl) = z2d(:,:)
+                  znam = 'sxxa'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxxa(:,:,jl) = z2d(:,:)
+                  znam = 'syya'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syya(:,:,jl) = z2d(:,:)
+                  znam = 'sxya'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxya(:,:,jl) = z2d(:,:)
+                  znam = 'sxc0'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxc0(:,:,jl) = z2d(:,:)
+                  znam = 'syc0'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syc0(:,:,jl) = z2d(:,:)
+                  znam = 'sxxc0'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxxc0(:,:,jl) = z2d(:,:)
+                  znam = 'syyc0'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syyc0(:,:,jl) = z2d(:,:)
+                  znam = 'sxyc0'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxyc0(:,:,jl) = z2d(:,:)
+                  znam = 'sxsal'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxsal(:,:,jl) = z2d(:,:)
+                  znam = 'sysal'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sysal(:,:,jl) = z2d(:,:)
+                  znam = 'sxxsal'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxxsal(:,:,jl) = z2d(:,:)
+                  znam = 'syysal'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syysal(:,:,jl) = z2d(:,:)
+                  znam = 'sxysal'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxysal(:,:,jl) = z2d(:,:)
+                  znam = 'sxage'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxage(:,:,jl) = z2d(:,:)
+                  znam = 'syage'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syage(:,:,jl) = z2d(:,:)
+                  znam = 'sxxage'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxxage(:,:,jl) = z2d(:,:)
+                  znam = 'syyage'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  syyage(:,:,jl) = z2d(:,:)
+                  znam = 'sxyage'//'_htc'//zchar
+                  CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                  sxyage(:,:,jl)= z2d(:,:)
+               END DO
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  DO jl = 1, jpl 
+                     WRITE(zchar,'(I2.2)') jl
+                     znam = 'sxap'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxap(:,:,jl) = z2d(:,:)
+                     znam = 'syap'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     syap(:,:,jl) = z2d(:,:)
+                     znam = 'sxxap'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxxap(:,:,jl) = z2d(:,:)
+                     znam = 'syyap'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     syyap(:,:,jl) = z2d(:,:)
+                     znam = 'sxyap'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxyap(:,:,jl) = z2d(:,:)
+
+                     znam = 'sxvp'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxvp(:,:,jl) = z2d(:,:)
+                     znam = 'syvp'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     syvp(:,:,jl) = z2d(:,:)
+                     znam = 'sxxvp'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxxvp(:,:,jl) = z2d(:,:)
+                     znam = 'syyvp'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     syyvp(:,:,jl) = z2d(:,:)
+                     znam = 'sxyvp'//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxyvp(:,:,jl) = z2d(:,:)
+                  END DO
+               ENDIF
+
+               CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  )
+               CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  )
+               CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw )
+               CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw )
+               CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw )
+
+               DO jl = 1, jpl 
+                  WRITE(zchar,'(I2.2)') jl
+                  DO jk = 1, nlay_i 
+                     WRITE(zchar1,'(I2.2)') jk
+                     znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxe(:,:,jk,jl) = z2d(:,:)
+                     znam = 'sye'//'_il'//zchar1//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sye(:,:,jk,jl) = z2d(:,:)
+                     znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxxe(:,:,jk,jl) = z2d(:,:)
+                     znam = 'syye'//'_il'//zchar1//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     syye(:,:,jk,jl) = z2d(:,:)
+                     znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
+                     CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+                     sxye(:,:,jk,jl) = z2d(:,:)
+                  END DO
+               END DO
+               !
+            ELSE                                     ! start rheology from rest
+               IF(lwp) WRITE(numout,*) '   ==>>   previous run without Prather, set moments to 0'
+               sxopw (:,:) = 0._wp   ;   sxice (:,:,:) = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:) = 0._wp
+               syopw (:,:) = 0._wp   ;   syice (:,:,:) = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:) = 0._wp
+               sxxopw(:,:) = 0._wp   ;   sxxice(:,:,:) = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:) = 0._wp
+               syyopw(:,:) = 0._wp   ;   syyice(:,:,:) = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:) = 0._wp
+               sxyopw(:,:) = 0._wp   ;   sxyice(:,:,:) = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:) = 0._wp
+               !
+               sxc0  (:,:,:) = 0._wp   ;   sxe  (:,:,:,:) = 0._wp   ;   sxsal  (:,:,:) = 0._wp   ;   sxage  (:,:,:) = 0._wp
+               syc0  (:,:,:) = 0._wp   ;   sye  (:,:,:,:) = 0._wp   ;   sysal  (:,:,:) = 0._wp   ;   syage  (:,:,:) = 0._wp
+               sxxc0 (:,:,:) = 0._wp   ;   sxxe (:,:,:,:) = 0._wp   ;   sxxsal (:,:,:) = 0._wp   ;   sxxage (:,:,:) = 0._wp
+               syyc0 (:,:,:) = 0._wp   ;   syye (:,:,:,:) = 0._wp   ;   syysal (:,:,:) = 0._wp   ;   syyage (:,:,:) = 0._wp
+               sxyc0 (:,:,:) = 0._wp   ;   sxye (:,:,:,:) = 0._wp   ;   sxysal (:,:,:) = 0._wp   ;   sxyage (:,:,:) = 0._wp
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  sxap  (:,:,:) = 0._wp    ; sxvp  (:,:,:) = 0._wp 
+                  syap  (:,:,:) = 0._wp    ; syvp  (:,:,:) = 0._wp 
+                  sxxap (:,:,:) = 0._wp    ; sxxvp (:,:,:) = 0._wp 
+                  syyap (:,:,:) = 0._wp    ; syyvp (:,:,:) = 0._wp 
+                  sxyap (:,:,:) = 0._wp    ; sxyvp (:,:,:) = 0._wp
+               ENDIF
+            ENDIF
+         ELSE                                   !* Start from rest
+            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set moments to 0'
+            sxopw (:,:) = 0._wp   ;   sxice (:,:,:) = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:) = 0._wp
+            syopw (:,:) = 0._wp   ;   syice (:,:,:) = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:) = 0._wp
+            sxxopw(:,:) = 0._wp   ;   sxxice(:,:,:) = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:) = 0._wp
+            syyopw(:,:) = 0._wp   ;   syyice(:,:,:) = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:) = 0._wp
+            sxyopw(:,:) = 0._wp   ;   sxyice(:,:,:) = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:) = 0._wp
+            !
+            sxc0  (:,:,:) = 0._wp   ;   sxe  (:,:,:,:) = 0._wp   ;   sxsal  (:,:,:) = 0._wp   ;   sxage  (:,:,:) = 0._wp
+            syc0  (:,:,:) = 0._wp   ;   sye  (:,:,:,:) = 0._wp   ;   sysal  (:,:,:) = 0._wp   ;   syage  (:,:,:) = 0._wp
+            sxxc0 (:,:,:) = 0._wp   ;   sxxe (:,:,:,:) = 0._wp   ;   sxxsal (:,:,:) = 0._wp   ;   sxxage (:,:,:) = 0._wp
+            syyc0 (:,:,:) = 0._wp   ;   syye (:,:,:,:) = 0._wp   ;   syysal (:,:,:) = 0._wp   ;   syyage (:,:,:) = 0._wp
+            sxyc0 (:,:,:) = 0._wp   ;   sxye (:,:,:,:) = 0._wp   ;   sxysal (:,:,:) = 0._wp   ;   sxyage (:,:,:) = 0._wp
+            IF ( nn_pnd_scheme > 0 ) THEN
+               sxap  (:,:,:) = 0._wp    ; sxvp  (:,:,:) = 0._wp 
+               syap  (:,:,:) = 0._wp    ; syvp  (:,:,:) = 0._wp 
+               sxxap (:,:,:) = 0._wp    ; sxxvp (:,:,:) = 0._wp 
+               syyap (:,:,:) = 0._wp    ; syyvp (:,:,:) = 0._wp 
+               sxyap (:,:,:) = 0._wp    ; sxyvp (:,:,:) = 0._wp
+            ENDIF
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- adv-rst ----'
+         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1
+         !
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            znam = 'sxice'//'_htc'//zchar
+            z2d(:,:) = sxice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syice'//'_htc'//zchar
+            z2d(:,:) = syice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxice'//'_htc'//zchar
+            z2d(:,:) = sxxice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syyice'//'_htc'//zchar
+            z2d(:,:) = syyice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxyice'//'_htc'//zchar
+            z2d(:,:) = sxyice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxsn'//'_htc'//zchar
+            z2d(:,:) = sxsn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sysn'//'_htc'//zchar
+            z2d(:,:) = sysn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxsn'//'_htc'//zchar
+            z2d(:,:) = sxxsn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syysn'//'_htc'//zchar
+            z2d(:,:) = syysn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxysn'//'_htc'//zchar
+            z2d(:,:) = sxysn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxa'//'_htc'//zchar
+            z2d(:,:) = sxa(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sya'//'_htc'//zchar
+            z2d(:,:) = sya(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxa'//'_htc'//zchar
+            z2d(:,:) = sxxa(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syya'//'_htc'//zchar
+            z2d(:,:) = syya(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxya'//'_htc'//zchar
+            z2d(:,:) = sxya(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxc0'//'_htc'//zchar
+            z2d(:,:) = sxc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syc0'//'_htc'//zchar
+            z2d(:,:) = syc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxc0'//'_htc'//zchar
+            z2d(:,:) = sxxc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syyc0'//'_htc'//zchar
+            z2d(:,:) = syyc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxyc0'//'_htc'//zchar
+            z2d(:,:) = sxyc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxsal'//'_htc'//zchar
+            z2d(:,:) = sxsal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sysal'//'_htc'//zchar
+            z2d(:,:) = sysal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxsal'//'_htc'//zchar
+            z2d(:,:) = sxxsal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syysal'//'_htc'//zchar
+            z2d(:,:) = syysal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxysal'//'_htc'//zchar
+            z2d(:,:) = sxysal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxage'//'_htc'//zchar
+            z2d(:,:) = sxage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syage'//'_htc'//zchar
+            z2d(:,:) = syage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxage'//'_htc'//zchar
+            z2d(:,:) = sxxage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syyage'//'_htc'//zchar
+            z2d(:,:) = syyage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxyage'//'_htc'//zchar
+            z2d(:,:) = sxyage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         END DO
+
+         CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  )
+         CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  )
+         CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw )
+         CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw )
+         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw )
+         
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            DO jk = 1, nlay_i 
+               WRITE(zchar1,'(I2.2)') jk
+               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sxe(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sye'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sye(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sxxe(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'syye'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = syye(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sxye(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            END DO
+         END DO
+         IF ( nn_pnd_scheme > 0 ) THEN
+            DO jl = 1, jpl 
+               WRITE(zchar,'(I2.2)') jl
+               znam = 'sxap'//'_htc'//zchar
+               z2d(:,:) = sxap(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'syap'//'_htc'//zchar
+               z2d(:,:) = syap(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxxap'//'_htc'//zchar
+               z2d(:,:) = sxxap(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'syyap'//'_htc'//zchar
+               z2d(:,:) = syyap(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxyap'//'_htc'//zchar
+               z2d(:,:) = sxyap(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+   
+               znam = 'sxvp'//'_htc'//zchar
+               z2d(:,:) = sxvp(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'syvp'//'_htc'//zchar
+               z2d(:,:) = syvp(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxxvp'//'_htc'//zchar
+               z2d(:,:) = sxxvp(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'syyvp'//'_htc'//zchar
+               z2d(:,:) = syyvp(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxyvp'//'_htc'//zchar
+               z2d(:,:) = sxyvp(:,:,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE adv_pra_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy module        NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icedyn_adv_pra
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_umx.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_umx.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_umx.F90	(revision 8586)
@@ -0,0 +1,658 @@
+MODULE icedyn_adv_umx
+   !!==============================================================================
+   !!                       ***  MODULE  icedyn_adv_umx  ***
+   !! sea-ice : advection using the ULTIMATE-MACHO scheme
+   !!==============================================================================
+   !! History :  3.6  !  2014-11  (C. Rousset, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_dyn_adv_umx   : update the tracer trend with the 3D advection trends using a TVD scheme
+   !!   ultimate_x(_y)    : compute a tracer value at velocity points using ULTIMATE scheme at various orders
+   !!   macho             : ???
+   !!   nonosc_2d         : compute monotonic tracer fluxes by a non-oscillatory algorithm 
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constant
+   USE dom_oce        ! ocean domain
+   USE sbc_oce , ONLY : nn_fsbc   ! update frequency of surface boundary condition
+   USE ice            ! sea-ice variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dyn_adv_umx   ! called by icedyn_adv.F90
+      
+   REAL(wp) ::   z1_6   = 1._wp /   6._wp   ! =1/6
+   REAL(wp) ::   z1_120 = 1._wp / 120._wp   ! =1/120
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedyn_adv_umx.F90 4499 2014-02-18 15:14:31Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_dyn_adv_umx( k_order, kt, pu_ice, pv_ice,  &
+      &                    pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_dyn_adv_umx  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!                 tracers and add it to the general trend of tracer equations
+      !!                 using an "Ultimate-Macho" scheme
+      !!
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   k_order    ! order of the scheme (1-5 or 20)
+      INTEGER                     , INTENT(in   ) ::   kt         ! time step
+      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pu_ice     ! ice i-velocity
+      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pv_ice     ! ice j-velocity
+      REAL(wp), DIMENSION(:,:)    , INTENT(inout) ::   pato_i     ! open water area
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i       ! ice volume
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_s       ! snw volume
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   psv_i      ! salt content
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   poa_i      ! age content
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_i       ! ice concentration
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content
+      !
+      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices
+      INTEGER  ::   initad                  ! number of sub-timestep for the advection
+      REAL(wp) ::   zcfl , zusnit, zdt      !   -      -
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zudy, zvdx, zcu_box, zcv_box
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme'
+      !
+      ALLOCATE( zudy(jpi,jpj) , zvdx(jpi,jpj) , zcu_box(jpi,jpj) , zcv_box(jpi,jpj) )
+      !
+      ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- !        
+      zcfl  =            MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )
+      zcfl  = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+      IF( lk_mpp )   CALL mpp_max( zcfl )
+
+      IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
+      ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
+      ENDIF
+
+      zdt = rdt_ice / REAL(initad)
+
+      ! --- transport --- !
+      zudy(:,:) = pu_ice(:,:) * e2u(:,:)
+      zvdx(:,:) = pv_ice(:,:) * e1v(:,:)
+
+      ! --- define velocity for advection: u*grad(H) --- !
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp
+            ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj)
+            ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj)
+            ENDIF
+
+            IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp
+            ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1)
+            ELSE                                                      ;   zcv_box(ji,jj) = pv_ice(ji,jj  )
+            ENDIF
+         END DO
+      END DO
+
+      !---------------!
+      !== advection ==!
+      !---------------!
+      DO jt = 1, initad
+         CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pato_i(:,:) )             ! Open water area 
+         DO jl = 1, jpl
+            CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pa_i(:,:,jl) )         ! Ice area
+            CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pv_i(:,:,jl) )         ! Ice  volume
+            CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, psv_i(:,:,jl) )        ! Salt content
+            CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, poa_i(:,:,jl) )        ! Age content
+            DO jk = 1, nlay_i
+               CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pe_i(:,:,jk,jl) )   ! Ice  heat content
+            END DO
+            CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pv_s(:,:,jl) )         ! Snow volume
+            CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pe_s(:,:,1,jl) )       ! Snow heat content
+            IF ( nn_pnd_scheme > 0 ) THEN
+               CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pa_ip(:,:,jl) )     ! Melt pond fraction
+               CALL adv_umx( k_order, kt, zdt, zudy, zvdx, zcu_box, zcv_box, pv_ip(:,:,jl) )     ! Melt pond volume
+            ENDIF
+         END DO
+      END DO
+      !
+      DEALLOCATE( zudy, zvdx, zcu_box, zcv_box )
+      !
+   END SUBROUTINE ice_dyn_adv_umx
+   
+   SUBROUTINE adv_umx( k_order, kt, pdt, puc, pvc, pubox, pvbox, ptc )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE adv_umx  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction)
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - pt  the after advective tracer
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   k_order        ! order of the ULTIMATE scheme
+      INTEGER                     , INTENT(in   ) ::   kt             ! number of iteration
+      REAL(wp)                    , INTENT(in   ) ::   pdt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   puc  , pvc     ! 2 ice velocity components => u*e2
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pubox, pvbox   ! upstream velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptc            ! tracer content field
+      !
+      INTEGER  ::   ji, jj           ! dummy loop indices  
+      REAL(wp) ::   ztra             ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj   !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfu_ups, zfu_ho, zt_u, zt_ups
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfv_ups, zfv_ho, zt_v, ztrd
+      !!----------------------------------------------------------------------
+      !
+      !  upstream advection with initial mass fluxes & intermediate update
+      ! --------------------------------------------------------------------
+      DO jj = 1, jpjm1         ! upstream tracer flux in the i and j direction
+         DO ji = 1, fs_jpim1   ! vector opt.
+            zfp_ui = puc(ji,jj) + ABS( puc(ji,jj) )
+            zfm_ui = puc(ji,jj) - ABS( puc(ji,jj) )
+            zfp_vj = pvc(ji,jj) + ABS( pvc(ji,jj) )
+            zfm_vj = pvc(ji,jj) - ABS( pvc(ji,jj) )
+            zfu_ups(ji,jj) = 0.5_wp * ( zfp_ui * ptc(ji,jj) + zfm_ui * ptc(ji+1,jj  ) )
+            zfv_ups(ji,jj) = 0.5_wp * ( zfp_vj * ptc(ji,jj) + zfm_vj * ptc(ji  ,jj+1) )
+         END DO
+      END DO
+      
+      DO jj = 2, jpjm1            ! total intermediate advective trends
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ztra = - (   zfu_ups(ji,jj) - zfu_ups(ji-1,jj  )   &
+               &       + zfv_ups(ji,jj) - zfv_ups(ji  ,jj-1)   ) * r1_e1e2t(ji,jj)
+            !
+            ztrd(ji,jj) =                         ztra                         ! upstream trend [ -div(uh) or -div(uhT) ]  
+            zt_ups (ji,jj) = ( ptc(ji,jj) + pdt * ztra ) * tmask(ji,jj,1)      ! guess after content field with monotonic scheme
+         END DO
+      END DO
+      CALL lbc_lnk( zt_ups, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign)
+      
+      ! High order (_ho) fluxes 
+      ! -----------------------
+      SELECT CASE( k_order )
+      CASE ( 20 )                          ! centered second order
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( ptc(ji,jj) + ptc(ji+1,jj) )
+               zfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( ptc(ji,jj) + ptc(ji,jj+1) )
+            END DO
+         END DO
+         !
+      CASE ( 1:5 )                      ! 1st to 5th order ULTIMATE-MACHO scheme
+         CALL macho( k_order, kt, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v )
+         !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_ho(ji,jj) = puc(ji,jj) * zt_u(ji,jj)
+               zfv_ho(ji,jj) = pvc(ji,jj) * zt_v(ji,jj)
+            END DO
+         END DO
+         !
+      END SELECT
+         
+      ! antidiffusive flux : high order minus low order
+      ! --------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zfu_ho(ji,jj) = zfu_ho(ji,jj) - zfu_ups(ji,jj)
+            zfv_ho(ji,jj) = zfv_ho(ji,jj) - zfv_ups(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk_multi( zfu_ho, 'U', -1., zfv_ho, 'V', -1. )         ! Lateral bondary conditions
+      
+      ! monotonicity algorithm
+      ! -------------------------
+      CALL nonosc_2d( ptc, zfu_ho, zfv_ho, zt_ups, pdt )
+      
+      ! final trend with corrected fluxes
+      ! ------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.  
+            ztra       = ztrd(ji,jj)  - (  zfu_ho(ji,jj) - zfu_ho(ji-1,jj  )   &
+               &                         + zfv_ho(ji,jj) - zfv_ho(ji  ,jj-1) ) * r1_e1e2t(ji,jj)  
+            ptc(ji,jj) = ptc(ji,jj) + pdt * ztra
+         END DO
+      END DO
+      CALL lbc_lnk( ptc(:,:) , 'T',  1. )
+      !
+   END SUBROUTINE adv_umx
+
+
+   SUBROUTINE macho( k_order, kt, pdt, ptc, puc, pvc, pubox, pvbox, pt_u, pt_v )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE ultimate_x  ***
+      !!     
+      !! **  Purpose :   compute  
+      !!
+      !! **  Method  :   ... ???
+      !!                 TIM = transient interpolation Modeling 
+      !!
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   k_order    ! order of the ULTIMATE scheme
+      INTEGER                     , INTENT(in   ) ::   kt         ! number of iteration
+      REAL(wp)                    , INTENT(in   ) ::   pdt        ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptc        ! tracer fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   puc, pvc   ! 2 ice velocity components
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pubox, pvbox   ! upstream velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_u, pt_v ! tracer at u- and v-points 
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) ::   zc_box    !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) :: zzt
+      !!----------------------------------------------------------------------
+      !
+!!      IF( nn_timing == 1 )  CALL timing_start('macho')
+      !
+      IF( MOD( (kt - 1) / nn_fsbc , 2 ) == 0 ) THEN         !==  odd ice time step:  adv_x then adv_y  ==!
+         !
+         !                                                           !--  ultimate interpolation of pt at u-point  --!
+         CALL ultimate_x( k_order, pdt, ptc, puc, pt_u )
+         !
+         !                                                           !--  advective form update in zzt  --!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zzt(ji,jj) = ptc(ji,jj) - pubox(ji,jj) * pdt * ( pt_u(ji,jj) - pt_u(ji-1,jj) ) * r1_e1t(ji,jj)  &
+                  &                    - ptc  (ji,jj) * pdt * ( puc (ji,jj) - puc (ji-1,jj) ) * r1_e1e2t(ji,jj)
+               zzt(ji,jj) = zzt(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( zzt, 'T', 1. )
+         !
+         !                                                           !--  ultimate interpolation of pt at v-point  --!
+         CALL ultimate_y( k_order, pdt, zzt, pvc, pt_v )
+         !
+      ELSE                                                  !==  even ice time step:  adv_y then adv_x  ==!
+         !
+         !                                                           !--  ultimate interpolation of pt at v-point  --!
+         CALL ultimate_y( k_order, pdt, ptc, pvc, pt_v )
+         !
+         !                                                           !--  advective form update in zzt  --!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zzt(ji,jj) = ptc(ji,jj) - pvbox(ji,jj) * pdt * ( pt_v(ji,jj) - pt_v(ji,jj-1) ) * r1_e2t(ji,jj)  &
+                  &                    - ptc  (ji,jj) * pdt * ( pvc (ji,jj) - pvc (ji,jj-1) ) * r1_e1e2t(ji,jj)
+               zzt(ji,jj) = zzt(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( zzt, 'T', 1. )
+         !
+         !                                                           !--  ultimate interpolation of pt at u-point  --!
+         CALL ultimate_x( k_order, pdt, zzt, puc, pt_u )
+         !      
+      ENDIF      
+      !
+!!      IF( nn_timing == 1 )  CALL timing_stop('macho')
+      !
+   END SUBROUTINE macho
+
+
+   SUBROUTINE ultimate_x( k_order, pdt, pt, puc, pt_u )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE ultimate_x  ***
+      !!     
+      !! **  Purpose :   compute  
+      !!
+      !! **  Method  :   ... ???
+      !!                 TIM = transient interpolation Modeling 
+      !!
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   k_order   ! ocean time-step index
+      REAL(wp)                    , INTENT(in   ) ::   pdt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   puc       ! ice i-velocity component
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pt        ! tracer fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_u      ! tracer at u-point 
+      !
+      INTEGER  ::   ji, jj       ! dummy loop indices
+      REAL(wp) ::   zcu, zdx2, zdx4    !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) :: ztu1, ztu2, ztu3, ztu4
+      !!----------------------------------------------------------------------
+      !
+!!      IF( nn_timing == 1 )  CALL timing_start('ultimate_x')
+      !
+      !                                                     !--  Laplacian in i-direction  --!
+      DO jj = 2, jpjm1         ! First derivative (gradient)
+         DO ji = 1, fs_jpim1
+            ztu1(ji,jj) = ( pt(ji+1,jj) - pt(ji,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
+         END DO
+         !                     ! Second derivative (Laplacian)
+         DO ji = fs_2, fs_jpim1
+            ztu2(ji,jj) = ( ztu1(ji,jj) - ztu1(ji-1,jj) ) * r1_e1t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztu2, 'T', 1. )
+      !
+      !                                                     !--  BiLaplacian in i-direction  --!
+      DO jj = 2, jpjm1         ! Third derivative
+         DO ji = 1, fs_jpim1
+            ztu3(ji,jj) = ( ztu2(ji+1,jj) - ztu2(ji,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
+         END DO
+         !                     ! Fourth derivative
+         DO ji = fs_2, fs_jpim1
+            ztu4(ji,jj) = ( ztu3(ji,jj) - ztu3(ji-1,jj) ) * r1_e1t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztu4, 'T', 1. )
+      !
+      !
+      SELECT CASE (k_order )
+      !
+      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21)
+         !        
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (                               pt(ji+1,jj) + pt(ji,jj)   &
+                  &                                    - SIGN( 1._wp, puc(ji,jj) ) * ( pt(ji+1,jj) - pt(ji,jj) ) )
+            END DO
+         END DO
+         !
+      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (                                   pt(ji+1,jj) + pt(ji,jj)   &
+                  &                                               -              zcu   * ( pt(ji+1,jj) - pt(ji,jj) ) ) 
+            END DO
+         END DO
+         CALL lbc_lnk( pt_u(:,:) , 'U',  1. )
+         !  
+      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
+!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (         (                         pt  (ji+1,jj) + pt  (ji,jj)        &
+                  &                                               -              zcu   * ( pt  (ji+1,jj) - pt  (ji,jj) )  )   &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                         ztu2(ji+1,jj) + ztu2(ji,jj)        &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj) - ztu2(ji,jj) )  )   )
+            END DO
+         END DO
+         !
+      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
+!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (         (                   pt  (ji+1,jj) + pt  (ji,jj)        &
+                  &                                               -          zcu * ( pt  (ji+1,jj) - pt  (ji,jj) )  )   &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                   ztu2(ji+1,jj) + ztu2(ji,jj)        &
+                  &                                               - 0.5_wp * zcu * ( ztu2(ji+1,jj) - ztu2(ji,jj) )  )   )
+            END DO
+         END DO
+         !
+      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
+!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
+               zdx4 = zdx2 * zdx2
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (               (                   pt  (ji+1,jj) + pt  (ji,jj)       &
+                  &                                                     -          zcu * ( pt  (ji+1,jj) - pt  (ji,jj) ) )   &
+                  &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) *     (                   ztu2(ji+1,jj) + ztu2(ji,jj)       &
+                  &                                                     - 0.5_wp * zcu * ( ztu2(ji+1,jj) - ztu2(ji,jj) ) )   &
+                  &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj) + ztu4(ji,jj)       &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj) - ztu4(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+!!      IF( nn_timing == 1 )  CALL timing_stop('ultimate_x')
+      !
+   END SUBROUTINE ultimate_x
+   
+ 
+   SUBROUTINE ultimate_y( k_order, pdt, pt, pvc, pt_v )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE ultimate_y  ***
+      !!     
+      !! **  Purpose :   compute  
+      !!
+      !! **  Method  :   ... ???
+      !!                 TIM = transient interpolation Modeling 
+      !!
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   k_order   ! ocean time-step index
+      REAL(wp)                    , INTENT(in   ) ::   pdt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvc       ! ice j-velocity component
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pt        ! tracer fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_v      ! tracer at v-point 
+      !
+      INTEGER  ::   ji, jj       ! dummy loop indices
+      REAL(wp) ::   zcv, zdy2, zdy4    !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) :: ztv1, ztv2, ztv3, ztv4
+      !!----------------------------------------------------------------------
+      !
+!!      IF( nn_timing == 1 )  CALL timing_start('ultimate_y')
+      !
+      !                                                     !--  Laplacian in j-direction  --!
+      DO jj = 1, jpjm1         ! First derivative (gradient)
+         DO ji = fs_2, fs_jpim1
+            ztv1(ji,jj) = ( pt(ji,jj+1) - pt(ji,jj) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END DO
+      END DO
+      DO jj = 2, jpjm1         ! Second derivative (Laplacian)
+         DO ji = fs_2, fs_jpim1
+            ztv2(ji,jj) = ( ztv1(ji,jj) - ztv1(ji,jj-1) ) * r1_e2t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztv2, 'T', 1. )
+      !
+      !                                                     !--  BiLaplacian in j-direction  --!
+      DO jj = 1, jpjm1         ! First derivative
+         DO ji = fs_2, fs_jpim1
+            ztv3(ji,jj) = ( ztv2(ji,jj+1) - ztv2(ji,jj) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END DO
+      END DO
+      DO jj = 2, jpjm1         ! Second derivative
+         DO ji = fs_2, fs_jpim1
+            ztv4(ji,jj) = ( ztv3(ji,jj) - ztv3(ji,jj-1) ) * r1_e2t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztv4, 'T', 1. )
+      !
+      !
+      SELECT CASE (k_order )
+      !
+      CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1) + pt(ji,jj) )  &
+                  &                                     - SIGN( 1._wp, pvc(ji,jj) ) * ( pt(ji,jj+1) - pt(ji,jj) ) )
+            END DO
+         END DO
+         !
+      CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (        ( pt(ji,jj+1) + pt(ji,jj) )  &
+                  &                                     - zcv * ( pt(ji,jj+1) - pt(ji,jj) ) )
+            END DO
+         END DO
+         CALL lbc_lnk( pt_v(:,:) , 'V',  1. )
+         !
+      CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
+!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                                 ( pt  (ji,jj+1) + pt  (ji,jj)       &
+                  &                                     -                        zcv   * ( pt  (ji,jj+1) - pt  (ji,jj) ) )   &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1) + ztv2(ji,jj)       &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
+!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                           ( pt  (ji,jj+1) + pt  (ji,jj)       &
+                  &                                               -          zcv * ( pt  (ji,jj+1) - pt  (ji,jj) ) )   &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                   ztv2(ji,jj+1) + ztv2(ji,jj)       &
+                  &                                               - 0.5_wp * zcv * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
+!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
+               zdy4 = zdy2 * zdy2
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                                 ( pt  (ji,jj+1) + pt  (ji,jj)      &
+                  &                                                     -          zcv * ( pt  (ji,jj+1) - pt  (ji,jj) ) )  &
+                  &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) *     (                   ztv2(ji,jj+1) + ztv2(ji,jj)      &
+                  &                                                     - 0.5_wp * zcv * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) )  &
+                  &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1) + ztv4(ji,jj)      &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1) - ztv4(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+!!      IF( nn_timing == 1 )  CALL timing_stop('ultimate_y')
+      !
+   END SUBROUTINE ultimate_y
+   
+  
+   SUBROUTINE nonosc_2d( pbef, paa, pbb, paft, pdt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      REAL(wp)                     , INTENT(in   ) ::   pdt          ! tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pbef, paft   ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(inout) ::   paa, pbb     ! monotonic fluxes in the 2 directions
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      INTEGER  ::   ikm1      ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zsml, z1_dt   ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv
+      !!----------------------------------------------------------------------
+      !
+!!      IF( nn_timing == 1 )  CALL timing_start('nonosc_2d')
+      !
+      zbig = 1.e+40_wp
+      zsml = 1.e-15_wp
+
+      ! clem test
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.  
+            zdiv(ji,jj) =  - (  paa(ji,jj) - paa(ji-1,jj  )   &
+               &              + pbb(ji,jj) - pbb(ji  ,jj-1) )  
+         END DO
+      END DO
+      CALL lbc_lnk( zdiv, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign)
+
+      ! Determine ice masks for before and after tracers 
+      WHERE( pbef(:,:) == 0._wp .AND. paft(:,:) == 0._wp .AND. zdiv(:,:) == 0._wp )   ;   zmsk(:,:) = 0._wp
+      ELSEWHERE                                                                       ;   zmsk(:,:) = 1._wp * tmask(:,:,1)
+      END WHERE
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+!      zbup(:,:) = MAX( pbef(:,:) * tmask(:,:,1) - zbig * ( 1.e0 - tmask(:,:,1) ),   &
+!         &             paft(:,:) * tmask(:,:,1) - zbig * ( 1.e0 - tmask(:,:,1) )  )
+!      zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ),   &
+!         &             paft(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) )  )
+      zbup(:,:) = MAX( pbef(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ),   &
+         &             paft(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) )  )
+      zbdo(:,:) = MIN( pbef(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ),   &
+         &             paft(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) )  )
+
+      z1_dt = 1._wp / pdt
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            !
+            zup  = MAX(   zbup(ji,jj), zbup(ji-1,jj  ), zbup(ji+1,jj  ),   &        ! search max/min in neighbourhood
+               &                       zbup(ji  ,jj-1), zbup(ji  ,jj+1)    )
+            zdo  = MIN(   zbdo(ji,jj), zbdo(ji-1,jj  ), zbdo(ji+1,jj  ),   &
+               &                       zbdo(ji  ,jj-1), zbdo(ji  ,jj+1)    )
+               !
+            zpos = MAX( 0., paa(ji-1,jj  ) ) - MIN( 0., paa(ji  ,jj  ) )   &        ! positive/negative  part of the flux
+               & + MAX( 0., pbb(ji  ,jj-1) ) - MIN( 0., pbb(ji  ,jj  ) )
+            zneg = MAX( 0., paa(ji  ,jj  ) ) - MIN( 0., paa(ji-1,jj  ) )   &
+               & + MAX( 0., pbb(ji  ,jj  ) ) - MIN( 0., pbb(ji  ,jj-1) )
+               !
+            zbt = e1e2t(ji,jj) * z1_dt                                   ! up & down beta terms
+            zbetup(ji,jj) = ( zup         - paft(ji,jj) ) / ( zpos + zsml ) * zbt
+            zbetdo(ji,jj) = ( paft(ji,jj) - zdo         ) / ( zneg + zsml ) * zbt
+         END DO
+      END DO
+      CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
+      ! monotonic flux in the i & j direction (paa & pbb)
+      ! -------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zau = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji+1,jj) )
+            zbu = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji+1,jj) )
+            zcu = 0.5  + SIGN( 0.5 , paa(ji,jj) )
+            !
+            zav = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji,jj+1) )
+            zbv = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji,jj+1) )
+            zcv = 0.5  + SIGN( 0.5 , pbb(ji,jj) )
+            !
+            paa(ji,jj) = paa(ji,jj) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+            pbb(ji,jj) = pbb(ji,jj) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+            !
+         END DO
+      END DO
+      CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+      !
+!!      IF( nn_timing == 1 )  CALL timing_stop('nonosc_2d')
+      !
+   END SUBROUTINE nonosc_2d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icedyn_adv_umx
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90	(revision 8586)
@@ -0,0 +1,952 @@
+MODULE icedyn_rdgrft
+   !!======================================================================
+   !!                       ***  MODULE icedyn_rdgrft ***
+   !!    sea-ice : Mechanical impact on ice thickness distribution      
+   !!======================================================================
+   !! History :  LIM  ! 2006-02  (M. Vancoppenolle) Original code 
+   !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_dyn_rdgrft       : ridging/rafting of sea ice
+   !!   ice_dyn_rdgrft_init  : initialization of ridging/rafting of sea ice
+   !!   ice_strength         : ice strength calculation
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE phycst         ! physical constants (ocean directory) 
+   USE sbc_oce , ONLY : sss_m, sst_m   ! surface boundary condition: ocean fields
+   USE ice1D          ! sea-ice: thermodynamics
+   USE ice            ! sea-ice: variables
+   USE icetab         ! sea-ice: 1D <==> 2D transformation
+   USE icevar         ! sea-ice: operations
+   USE icectl         ! sea-ice: control prints
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dyn_rdgrft        ! called by icestp
+   PUBLIC   ice_dyn_rdgrft_init   ! called by icedyn
+   PUBLIC   ice_strength          ! called by icedyn_rhg_evp
+
+   ! Variables shared among ridging subroutines
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   closing_net     ! net rate at which area is removed    (1/s)
+      !                                                 ! (ridging ice area - area of new ridges) / dt
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   opning         ! rate of opening due to divergence/shear
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   closing_gross  ! rate at which area removed, not counting area of new ridges
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apartf   ! participation function; fraction of ridging/closing associated w/ category n
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hrmin    ! minimum ridge thickness
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hrmax    ! maximum ridge thickness
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hraft    ! thickness of rafted ice
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hi_hrdg  ! thickness of ridging ice / mean ridge thickness
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   aridge   ! participating ice ridging
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   araft    ! participating ice rafting
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ze_i_2d
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ze_s_2d
+   !
+   REAL(wp), PARAMETER ::   hrdg_hi_min = 1.1_wp    ! min ridge thickness multiplier: min(hrdg/hi)
+   REAL(wp), PARAMETER ::   hi_hrft     = 0.5_wp    ! rafting multipliyer: (hi/hraft)
+   !
+   ! ** namelist (namdyn_rdgrft) **
+   LOGICAL  ::   ln_str_H79       ! ice strength parameterization (Hibler79)
+   REAL(wp) ::   rn_pstar         ! determines ice strength, Hibler JPO79
+   REAL(wp) ::   rn_crhg          ! determines changes in ice strength
+   REAL(wp) ::   rn_csrdg         ! fraction of shearing energy contributing to ridging            
+   LOGICAL  ::   ln_partf_lin     ! participation function linear (Thorndike et al. (1975))
+   REAL(wp) ::   rn_gstar         !    fractional area of young ice contributing to ridging
+   LOGICAL  ::   ln_partf_exp     ! participation function exponential (Lipscomb et al. (2007))
+   REAL(wp) ::   rn_astar         !    equivalent of G* for an exponential participation function
+   LOGICAL  ::   ln_ridging       ! ridging of ice or not                        
+   REAL(wp) ::   rn_hstar         !    thickness that determines the maximal thickness of ridged ice
+   REAL(wp) ::   rn_porordg       !    initial porosity of ridges (0.3 regular value)
+   REAL(wp) ::   rn_fsnwrdg       !    fractional snow loss to the ocean during ridging
+   REAL(wp) ::   rn_fpndrdg       !    fractional pond loss to the ocean during ridging
+   LOGICAL  ::   ln_rafting       ! rafting of ice or not                        
+   REAL(wp) ::   rn_hraft         !    threshold thickness (m) for rafting / ridging 
+   REAL(wp) ::   rn_craft         !    coefficient for smoothness of the hyperbolic tangent in rafting
+   REAL(wp) ::   rn_fsnwrft       !    fractional snow loss to the ocean during rafting
+   REAL(wp) ::   rn_fpndrft       !    fractional pond loss to the ocean during rafting
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedyn_rdgrft.F90 8378 2017-07-26 13:55:59Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION ice_dyn_rdgrft_alloc()
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_dyn_rdgrft_alloc ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( closing_net(jpij), opning(jpij)   , closing_gross(jpij),   &
+         &      apartf(jpij,0:jpl), hrmin(jpij,jpl), hraft(jpij,jpl)    , aridge(jpij,jpl),   &
+         &      hrmax(jpij,jpl), hi_hrdg(jpij,jpl)  , araft (jpij,jpl),  &
+         &      ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), STAT=ice_dyn_rdgrft_alloc )
+
+      IF( lk_mpp                    )   CALL mpp_sum ( ice_dyn_rdgrft_alloc )
+      IF( ice_dyn_rdgrft_alloc /= 0 )   CALL ctl_warn( 'ice_dyn_rdgrft_alloc: failed to allocate arrays' )
+      !
+   END FUNCTION ice_dyn_rdgrft_alloc
+
+
+   SUBROUTINE ice_dyn_rdgrft( kt )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_dyn_rdgrft ***
+      !!
+      !! ** Purpose :   computes the mechanical redistribution of ice thickness
+      !!
+      !! ** Method  :   Steps :
+      !!       1) Thickness categories boundaries, ice / o.w. concentrations
+      !!          Ridge preparation
+      !!       2) Dynamical inputs (closing rate, divu_adv, opning)
+      !!       3) Ridging iteration
+      !!       4) Ridging diagnostics
+      !!       5) Heat, salt and freshwater fluxes
+      !!       6) Compute increments of tate variables and come back to old values
+      !!
+      !! References :   Flato, G. M., and W. D. Hibler III, 1995, JGR, 100, 18,611-18,626.
+      !!                Hibler, W. D. III, 1980, MWR, 108, 1943-1973, 1980.
+      !!                Rothrock, D. A., 1975: JGR, 80, 4514-4519.
+      !!                Thorndike et al., 1975, JGR, 80, 4501-4513. 
+      !!                Bitz et al., JGR, 2001
+      !!                Amundrud and Melling, JGR 2005
+      !!                Babko et al., JGR 2002 
+      !!
+      !!     This routine is based on CICE code and authors William H. Lipscomb,
+      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop index
+      INTEGER  ::   iter, iterate_ridging      ! local integer 
+      INTEGER  ::   ipti                       ! local integer
+      REAL(wp) ::   zfac                       ! local scalar
+      INTEGER , DIMENSION(jpij) ::   iptidx        ! compute ridge/raft or not
+      REAL(wp), DIMENSION(jpij) ::   zdivu_adv     ! divu as implied by transport scheme  (1/s)
+      REAL(wp), DIMENSION(jpij) ::   zdivu, zdelt  ! 1D divu_i & delta_i
+      !
+      INTEGER, PARAMETER ::   jp_itermax = 20    
+      !!-------------------------------------------------------------------
+      ! controls
+      IF( nn_timing == 1 )   CALL timing_start('icedyn_rdgrft')                                                             ! timing
+      IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'ice_dyn_rdgrft: ice ridging and rafting'
+         IF(lwp) WRITE(numout,*)'~~~~~~~~~~~~~~'
+      ENDIF      
+
+      CALL ice_var_zapsmall   ! Zero out categories with very small areas
+
+      !--------------------------------
+      ! 0) Identify grid cells with ice
+      !--------------------------------
+      npti = 0   ;   nptidx(:) = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( SUM(a_i(ji,jj,:)) > 0._wp ) THEN
+               npti           = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+
+      IF( npti > 0 ) THEN
+        
+         ! just needed here
+         CALL tab_2d_1d( npti, nptidx(1:npti), zdivu(1:npti), divu_i(:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), zdelt(1:npti), delta_i(:,:) )
+         ! needed here and in the iteration loop
+         CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d  (1:npti,1:jpl), a_i(:,:,:) )
+         CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d  (1:npti,1:jpl), v_i(:,:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti)      , ato_i(:,:) )
+
+         DO ji = 1, npti
+            !-----------------------------------------------------------------------------!
+            ! 2) Dynamical inputs (closing rate, divu_adv, opning)
+            !-----------------------------------------------------------------------------!
+            !
+            ! 2.1 closing_net
+            !-----------------
+            ! Compute the net rate of closing due to convergence 
+            ! and shear, based on Flato and Hibler (1995).
+            ! 
+            ! The energy dissipation rate is equal to the net closing rate
+            ! times the ice strength.
+            !
+            ! NOTE: The NET closing rate is equal to the rate that open water 
+            !  area is removed, plus the rate at which ice area is removed by 
+            !  ridging, minus the rate at which area is added in new ridges.
+            !  The GROSS closing rate is equal to the first two terms (open
+            !  water closing and thin ice ridging) without the third term
+            !  (thick, newly ridged ice).
+
+            closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp )
+
+            ! 2.2 divu_adv
+            !--------------
+            ! Compute divu_adv, the divergence rate given by the transport/
+            ! advection scheme, which may not be equal to divu as computed 
+            ! from the velocity field.
+            !
+            ! If divu_adv < 0, make sure the closing rate is large enough
+            ! to give asum = 1.0 after ridging.
+            zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_rdtice
+
+            IF( zdivu_adv(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) )
+
+            ! 2.3 opning
+            !------------
+            ! Compute the (non-negative) opening rate that will give asum = 1.0 after ridging.
+            opning(ji) = closing_net(ji) + zdivu_adv(ji)
+         END DO
+
+         !
+         !------------------------------------------------
+         ! 2.1) Identify grid cells with nonzero ridging
+         !------------------------------------------------
+         CALL rdgrft_prep( a_i_2d, v_i_2d, ato_i_1d )
+         ipti = 0 ; iptidx(:) = 0
+         DO ji = 1, npti
+            IF( SUM( ABS(apartf(ji,1:jpl)) ) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN
+               ipti = ipti + 1
+               iptidx     (ipti)   = nptidx     (ji)
+               a_i_2d     (ipti,:) = a_i_2d     (ji,:)  ! adjust to new indices
+               v_i_2d     (ipti,:) = v_i_2d     (ji,:)  ! adjust to new indices
+               ato_i_1d   (ipti)   = ato_i_1d   (ji)    ! adjust to new indices
+               closing_net(ipti)   = closing_net(ji)    ! adjust to new indices
+               zdivu_adv  (ipti)   = zdivu_adv  (ji)    ! adjust to new indices
+               opning     (ipti)   = opning     (ji)    ! adjust to new indices
+            ENDIF
+         END DO
+         nptidx(:) = iptidx(:)
+         npti      = ipti
+
+      ENDIF
+
+      !--------------
+      ! Start ridging
+      !--------------
+      IF( npti > 0 ) THEN
+         
+         !-----------
+         ! 2D <==> 1D
+         !-----------
+         ! fields used but not modified
+         CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d(1:npti), sss_m(:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sst_1d(1:npti), sst_m(:,:) )
+         ! the following fields are modified in this routine
+         !!CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti), ato_i(:,:) )
+         !!CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d(1:npti,1:jpl), a_i(:,:,:) )
+         !!CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d  (1:npti,1:jpl), v_i  (:,:,:) )
+         CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,1:jpl), v_s (:,:,:) )
+         CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i(:,:,:) )
+         CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d(1:npti,1:jpl), oa_i(:,:,:) )
+         IF ( nn_pnd_scheme > 0 ) THEN
+            CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) )
+            CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) )
+         ENDIF
+         DO jl = 1, jpl
+            DO jk = 1, nlay_s
+               CALL tab_2d_1d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) )
+            END DO
+            DO jk = 1, nlay_i
+               CALL tab_2d_1d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) )
+            END DO
+         END DO
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_dyn_1d    (1:npti), sfx_dyn    (:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bri_1d    (1:npti), sfx_bri    (:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_dyn_1d    (1:npti), wfx_dyn    (:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dyn_1d    (1:npti), hfx_dyn    (:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_dyn_1d(1:npti), wfx_snw_dyn(:,:) )
+         IF ( nn_pnd_scheme > 0 ) THEN
+            CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:) )
+         ENDIF
+         
+         !-----------------------------------------------------------------------------!
+         ! 3) Ridging iteration
+         !-----------------------------------------------------------------------------!
+         iter            = 1
+         iterate_ridging = 1      
+         DO WHILE( iterate_ridging > 0 .AND. iter < jp_itermax )
+
+            CALL rdgrft_prep( a_i_2d, v_i_2d, ato_i_1d )
+
+            ! 3.2 Redistribute area, volume, and energy.
+            !-----------------------------------------------------------------------------!
+            CALL rdgrft_shift
+
+            ! 3.4 Do we keep on iterating?
+            !-----------------------------------------------------------------------------!
+            ! Check whether asum = 1.  If not (because the closing and opening
+            ! rates were reduced above), ridge again with new rates.
+            iterate_ridging = 0
+            DO ji = 1, npti
+               zfac = 1._wp - ( ato_i_1d(ji) + SUM( a_i_2d(ji,:) ) )
+               IF( ABS( zfac ) < epsi10 ) THEN
+                  closing_net(ji) = 0._wp
+                  opning     (ji) = 0._wp
+                  ato_i_1d   (ji) = MAX( 0._wp, 1._wp - SUM( a_i_2d(ji,:) ) )
+               ELSE
+                  iterate_ridging  = 1
+                  zdivu_adv  (ji) = zfac * r1_rdtice
+                  closing_net(ji) = MAX( 0._wp, -zdivu_adv(ji) )
+                  opning     (ji) = MAX( 0._wp,  zdivu_adv(ji) )
+               ENDIF
+            END DO
+            !
+            iter = iter + 1
+            IF( iter  >  jp_itermax )    CALL ctl_warn( 'icedyn_rdgrft: non-converging ridging scheme' )
+            !
+         END DO
+
+         !-----------
+         ! 1D <==> 2D
+         !-----------
+         CALL tab_1d_2d( npti, nptidx(1:npti), ato_i_1d(1:npti), ato_i(:,:) )
+         CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i (:,:,:) )
+         CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i (:,:,:) )
+         CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,1:jpl), v_s (:,:,:) )
+         CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i(:,:,:) )
+         CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d(1:npti,1:jpl), oa_i(:,:,:) )
+         IF ( nn_pnd_scheme > 0 ) THEN
+            CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) )
+            CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) )
+         ENDIF
+         DO jl = 1, jpl
+            DO jk = 1, nlay_s
+               CALL tab_1d_2d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) )
+            END DO
+            DO jk = 1, nlay_i
+               CALL tab_1d_2d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) )
+            END DO
+         END DO
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_dyn_1d    (1:npti), sfx_dyn    (:,:) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bri_1d    (1:npti), sfx_bri    (:,:) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_dyn_1d    (1:npti), wfx_dyn    (:,:) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_dyn_1d    (1:npti), hfx_dyn    (:,:) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_dyn_1d(1:npti), wfx_snw_dyn(:,:) )
+         IF ( nn_pnd_scheme > 0 ) THEN
+            CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:) )
+         ENDIF
+
+      ENDIF ! npti > 0
+   
+      CALL ice_var_agg( 1 ) 
+
+      ! controls
+      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+      IF( ln_ctl         )   CALL ice_prt3D   ('icedyn_rdgrft')                                                             ! prints
+      IF( nn_timing == 1 )   CALL timing_stop ('icedyn_rdgrft')                                                             ! timing
+      !
+   END SUBROUTINE ice_dyn_rdgrft
+
+
+   SUBROUTINE rdgrft_prep( pa_i, pv_i, pato_i )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE rdgrft_prep ***
+      !!
+      !! ** Purpose :   preparation for ridging calculations
+      !!
+      !! ** Method  :   Compute the thickness distribution of the ice and open water 
+      !!              participating in ridging and of the resulting ridges.
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(:)  , INTENT(in) ::   pato_i 
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pa_i, pv_i 
+      !!
+      INTEGER  ::   ji, jl                     ! dummy loop indices
+      REAL(wp) ::   z1_gstar, z1_astar, zhmean, zfac   ! local scalar
+      REAL(wp), DIMENSION(jpij)        ::   zasum, z1_asum, zaksum   ! sum of a_i+ato_i and reverse 
+      REAL(wp), DIMENSION(jpij,jpl)    ::   zhi                      ! ice thickness
+      REAL(wp), DIMENSION(jpij,-1:jpl) ::   zGsum                    ! zGsum(n) = sum of areas in categories 0 to n
+      !--------------------------------------------------------------------
+
+      z1_gstar = 1._wp / rn_gstar
+      z1_astar = 1._wp / rn_astar
+
+      !                       ! Ice thickness needed for rafting
+      WHERE( pa_i(1:npti,:) > 0._wp )   ;   zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:)
+      ELSEWHERE                         ;   zhi(1:npti,:) = 0._wp
+      END WHERE
+
+      !-----------------------------------------------------------------
+      ! 1) Participation function: a(h) = b(h).g(h) (apartf)
+      !-----------------------------------------------------------------
+      ! Compute the participation function apartf; this is analogous to
+      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
+      ! area lost from category n due to ridging/closing
+      ! apartf(n)   = total area lost due to ridging/closing
+      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 
+      !
+      ! The expressions for apartf are found by integrating b(h)g(h) between
+      ! the category boundaries.
+      ! apartf is always >= 0 and SUM(apartf(0:jpl))=1
+      !-----------------------------------------------------------------
+      !
+      ! Compute total area of ice plus open water.
+      ! This is in general not equal to one because of divergence during transport
+      zasum(1:npti) = pato_i(1:npti) + SUM( pa_i(1:npti,:), dim=2 )
+      !
+      WHERE( zasum(1:npti) > 0._wp )   ;   z1_asum(1:npti) = 1._wp / zasum(1:npti)
+      ELSEWHERE                        ;   z1_asum(1:npti) = 0._wp
+      END WHERE
+      ! Compute cumulative thickness distribution function
+      ! Compute the cumulative thickness distribution function zGsum,
+      ! where zGsum(n) is the fractional area in categories 0 to n.
+      ! initial value (in h = 0) equals open water area
+      zGsum(1:npti,-1) = 0._wp
+      zGsum(1:npti,0 ) = pato_i(1:npti) * z1_asum(1:npti)
+      DO jl = 1, jpl
+         zGsum(1:npti,jl) = ( pato_i(1:npti) + SUM( pa_i(1:npti,1:jl), dim=2 ) ) * z1_asum(1:npti)  ! sum(1:jl) is ok (and not jpl)
+      END DO
+      !
+      IF( ln_partf_lin ) THEN          !--- Linear formulation (Thorndike et al., 1975)
+         DO jl = 0, jpl    
+            DO ji = 1, npti
+               IF    ( zGsum(ji,jl)   < rn_gstar ) THEN
+                  apartf(ji,jl) = z1_gstar * ( zGsum(ji,jl) - zGsum(ji,jl-1) ) * &
+                     &                       ( 2._wp - ( zGsum(ji,jl-1) + zGsum(ji,jl) ) * z1_gstar )
+               ELSEIF( zGsum(ji,jl-1) < rn_gstar ) THEN
+                  apartf(ji,jl) = z1_gstar * ( rn_gstar     - zGsum(ji,jl-1) ) *  &
+                     &                       ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar        ) * z1_gstar )
+               ELSE
+                  apartf(ji,jl) = 0._wp
+               ENDIF
+            END DO
+         END DO
+         !
+      ELSEIF( ln_partf_exp ) THEN      !--- Exponential, more stable formulation (Lipscomb et al, 2007)
+         !                        
+         zfac = 1._wp / ( 1._wp - EXP(-z1_astar) )
+         DO jl = -1, jpl
+            DO ji = 1, npti
+               zGsum(ji,jl) = EXP( -zGsum(ji,jl) * z1_astar ) * zfac
+            END DO
+         END DO
+         DO jl = 0, jpl
+            DO ji = 1, npti
+               apartf(ji,jl) = zGsum(ji,jl-1) - zGsum(ji,jl)
+            END DO
+         END DO
+         !
+      ENDIF
+
+      !                                !--- Ridging and rafting participation concentrations
+      IF( ln_rafting .AND. ln_ridging ) THEN             !- ridging & rafting
+         DO jl = 1, jpl
+            DO ji = 1, npti
+               aridge(ji,jl) = ( 1._wp + TANH ( rn_craft * ( zhi(ji,jl) - rn_hraft ) ) ) * 0.5_wp * apartf(ji,jl)
+               araft (ji,jl) = apartf(ji,jl) - aridge(ji,jl)
+            END DO
+         END DO
+      ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN   !- ridging alone
+         DO jl = 1, jpl
+            DO ji = 1, npti
+               aridge(ji,jl) = apartf(ji,jl)
+               araft (ji,jl) = 0._wp
+            END DO
+         END DO
+      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN   !- rafting alone   
+         DO jl = 1, jpl
+            DO ji = 1, npti
+               aridge(ji,jl) = 0._wp
+               araft (ji,jl) = apartf(ji,jl)
+            END DO
+         END DO
+      ELSE                                               !- no ridging & no rafting
+         DO jl = 1, jpl
+            DO ji = 1, npti
+               aridge(ji,jl) = 0._wp
+               araft (ji,jl) = 0._wp         
+            END DO
+         END DO
+      ENDIF
+
+      !-----------------------------------------------------------------
+      ! 2) Transfer function
+      !-----------------------------------------------------------------
+      ! Compute max and min ridged ice thickness for each ridging category.
+      ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
+      ! 
+      ! This parameterization is a modified version of Hibler (1980).
+      ! The mean ridging thickness, zhmean, is proportional to hi^(0.5)
+      !  and for very thick ridging ice must be >= hrdg_hi_min*hi
+      !
+      ! The minimum ridging thickness, hrmin, is equal to 2*hi 
+      !  (i.e., rafting) and for very thick ridging ice is
+      !  constrained by hrmin <= (zhmean + hi)/2.
+      ! 
+      ! The maximum ridging thickness, hrmax, is determined by
+      !  zhmean and hrmin.
+      !
+      ! These modifications have the effect of reducing the ice strength
+      ! (relative to the Hibler formulation) when very thick ice is
+      ! ridging.
+      !
+      ! zaksum = net area removed/ total area removed
+      ! where total area removed = area of ice that ridges
+      !         net area removed = total area removed - area of new ridges
+      !-----------------------------------------------------------------
+
+      zfac = 1._wp / hi_hrft
+      zaksum(1:npti) = apartf(1:npti,0)
+      ! Transfer function
+      DO jl = 1, jpl !all categories have a specific transfer function
+         DO ji = 1, npti
+            IF ( apartf(ji,jl) > 0._wp ) THEN
+               zhmean         = MAX( SQRT( rn_hstar * zhi(ji,jl) ), zhi(ji,jl) * hrdg_hi_min )
+               hrmin  (ji,jl) = MIN( 2._wp * zhi(ji,jl), 0.5_wp * ( zhmean + zhi(ji,jl) ) )
+               hrmax  (ji,jl) = 2._wp * zhmean - hrmin(ji,jl)
+               hraft  (ji,jl) = zhi(ji,jl) * zfac
+               hi_hrdg(ji,jl) = zhi(ji,jl) / MAX( zhmean, epsi20 )
+               !
+               ! Normalization factor : zaksum, ensures mass conservation
+               zaksum(ji) = zaksum(ji) + aridge(ji,jl) * ( 1._wp - hi_hrdg(ji,jl) )    &
+                  &                    + araft (ji,jl) * ( 1._wp - hi_hrft )
+            ELSE
+               hrmin  (ji,jl) = 0._wp 
+               hrmax  (ji,jl) = 0._wp 
+               hraft  (ji,jl) = 0._wp 
+               hi_hrdg(ji,jl) = 1._wp
+            ENDIF
+         END DO
+      END DO
+      !
+      ! 3.1 closing_gross
+      !-----------------------------------------------------------------------------!
+      ! Based on the ITD of ridging and ridged ice, convert the net
+      !  closing rate to a gross closing rate.  
+      ! NOTE: 0 < aksum <= 1
+      WHERE( zaksum(1:npti) > 0._wp )   ;   closing_gross(1:npti) = closing_net(1:npti) / zaksum(1:npti)
+      ELSEWHERE                         ;   closing_gross(1:npti) = 0._wp
+      END WHERE
+      
+      DO ji = 1, npti  
+         ! correction to closing rate and opening if closing rate is excessive
+         !---------------------------------------------------------------------
+         ! Reduce the closing rate if more than 100% of the open water 
+         ! would be removed.  Reduce the opening rate proportionately.
+         zfac = ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rdt_ice
+         IF    ( zfac < 0._wp .AND. zfac > - pato_i(ji) ) THEN                  ! would lead to negative ato_i
+            opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_rdtice 
+         ELSEIF( zfac > 0._wp .AND. zfac > ( zasum(ji) - pato_i(ji) ) ) THEN  ! would lead to ato_i > asum
+            opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_rdtice 
+         ENDIF
+      END DO
+      
+      ! correction to closing rate / opening if excessive ice removal
+      !---------------------------------------------------------------
+      ! Reduce the closing rate if more than 100% of any ice category 
+      ! would be removed.  Reduce the opening rate proportionately.
+      DO jl = 1, jpl
+         DO ji = 1, npti
+            zfac = apartf(ji,jl) * closing_gross(ji) * rdt_ice
+!!            IF( zfac > pa_i(ji,jl) .AND. zfac > 0._wp ) THEN
+            IF( zfac > pa_i(ji,jl) ) THEN
+               closing_gross(ji) = closing_gross(ji) * pa_i(ji,jl) / zfac
+            ENDIF
+         END DO
+      END DO      
+      !
+   END SUBROUTINE rdgrft_prep
+
+
+   SUBROUTINE rdgrft_shift
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE rdgrft_shift ***
+      !!
+      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness
+      !!
+      !! ** Method  :   Remove area, volume, and energy from each ridging category
+      !!              and add to thicker ice categories.
+      !!-------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
+      REAL(wp) ::   hL, hR, farea              ! left and right limits of integration and new area going to jl2
+      REAL(wp) ::   vsw                        ! vol of water trapped into ridges
+      REAL(wp) ::   afrdg, afrft               ! fraction of category area ridged/rafted 
+      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1
+      REAL(wp)                  ::   airft1, oirft1, aprft1
+      REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, esrdg  ! area etc of new ridges
+      REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, esrft  ! area etc of rafted ice
+      !
+      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges
+      REAL(wp), DIMENSION(jpij) ::   zswitch, fvol    ! new ridge volume going to jl2
+      REAL(wp), DIMENSION(jpij) ::   z1_ai            ! 1 / a
+      !
+      REAL(wp), DIMENSION(jpij,nlay_i) ::   eirft     ! ice energy of rafting ice
+      REAL(wp), DIMENSION(jpij,nlay_i) ::   eirdg     ! enth*volume of new ridges
+      !!-------------------------------------------------------------------
+
+      !-------------------------------------------------------------------------------
+      ! 1) Compute change in open water area due to closing and opening.
+      !-------------------------------------------------------------------------------
+      DO ji = 1, npti
+         ato_i_1d(ji) = MAX( 0._wp, ato_i_1d(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rdt_ice )
+      END DO
+      
+      !-----------------------------------------------------------------
+      ! 2) compute categories participating to ridging/rafting (jl1) 
+      !-----------------------------------------------------------------
+      DO jl1 = 1, jpl
+
+         CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) )
+
+         DO ji = 1, npti
+
+            !------------------------------------------------
+            ! 2.1) Identify grid cells with nonzero ridging
+            !------------------------------------------------
+            IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN
+
+               z1_ai(ji) = 1._wp / a_i_2d(ji,jl1)
+
+               !--------------------------------------------------------------------
+               ! 2.2) Compute area of ridging ice (airdg1) and of new ridge (airdg2)
+               !--------------------------------------------------------------------
+               airdg1 = aridge(ji,jl1) * closing_gross(ji) * rdt_ice
+               airft1 = araft (ji,jl1) * closing_gross(ji) * rdt_ice
+
+               airdg2(ji) = airdg1 * hi_hrdg(ji,jl1)
+               airft2(ji) = airft1 * hi_hrft
+
+               !---------------------------------------------------------------
+               ! 2.3) Compute ridging /rafting fractions, make sure afrdg <=1 
+               !---------------------------------------------------------------
+               afrdg = airdg1 * z1_ai(ji)
+               afrft = airft1 * z1_ai(ji)
+
+               ! volume and enthalpy (J/m2, >0) of seawater trapped into ridges
+               vsw = v_i_2d(ji,jl1) * afrdg * rn_porordg
+               ersw(ji) = -rhoic * vsw * rcp * sst_1d(ji)   ! clem: if sst>0, then ersw <0 (is that possible?)
+
+               !---------------------------------------------------------------
+               ! 2.4) Compute ridging ice and new ridges (vi, vs, sm, oi, es, ei)
+               !---------------------------------------------------------------
+               virdg1     = v_i_2d (ji,jl1)   * afrdg
+               virdg2(ji) = v_i_2d (ji,jl1)   * afrdg * ( 1. + rn_porordg )
+               vsrdg(ji)  = v_s_2d (ji,jl1)   * afrdg
+               sirdg1     = sv_i_2d(ji,jl1)   * afrdg
+               sirdg2(ji) = sv_i_2d(ji,jl1)   * afrdg + vsw * sss_1d(ji)
+               oirdg1     = oa_i_2d(ji,jl1)   * afrdg
+               oirdg2(ji) = oa_i_2d(ji,jl1)   * afrdg * hi_hrdg(ji,jl1) 
+               esrdg(ji)  = ze_s_2d(ji,1,jl1) * afrdg
+
+               virft(ji)  = v_i_2d (ji,jl1)   * afrft
+               vsrft(ji)  = v_s_2d (ji,jl1)   * afrft
+               sirft(ji)  = sv_i_2d(ji,jl1)   * afrft 
+               oirft1     = oa_i_2d(ji,jl1)   * afrft 
+               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft 
+               esrft(ji)  = ze_s_2d(ji,1,jl1) * afrft
+
+               !MV MP 2016
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  aprdg1     = a_ip_2d(ji,jl1) * afrdg
+                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1)
+                  vprdg (ji) = v_ip_2d(ji,jl1) * afrdg
+                  aprft1     = a_ip_2d(ji,jl1) * afrft
+                  aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft
+                  vprft (ji) = v_ip_2d(ji,jl1) * afrft
+               ENDIF
+               ! END MV MP 2016
+
+               !-----------------------------------------------------------------
+               ! 2.5) Ice-ocean exchanges
+               !-----------------------------------------------------------------
+               wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids
+               sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoic * r1_rdtice
+               hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ersw(ji) * r1_rdtice          ! > 0 [W.m-2] 
+
+               ! Put the snow lost by ridging into the ocean
+               !------------------------------------------------
+               !  Note that esrdg > 0; the ocean must cool to melt snow. If the ocean temp = Tf already, new ice must grow.
+               wfx_snw_dyn_1d(ji) = wfx_snw_dyn_1d(ji) + ( rhosn * vsrdg(ji) * ( 1._wp - rn_fsnwrdg )   &   ! fresh water source for ocean
+                  &                                      + rhosn * vsrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice
+
+               hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ( - esrdg(ji) * ( 1._wp - rn_fsnwrdg )   &                 ! heat sink for ocean (<0, W.m-2)
+                  &                                - esrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice
+
+               ! Put the melt pond water into the ocean
+               !------------------------------------------            
+               IF ( ( nn_pnd_scheme > 0 ) .AND. ln_pnd_fw ) THEN
+                  wfx_pnd_1d(ji) = wfx_pnd_1d(ji) + ( rhofw * vprdg(ji) * ( 1._wp - rn_fpndrdg )   &        ! fresh water source for ocean
+                     &                              + rhofw * vprft(ji) * ( 1._wp - rn_fpndrft ) ) * r1_rdtice
+               ENDIF
+
+               ! virtual salt flux to keep salinity constant
+               !------------------------------------------            
+               IF( nn_icesal /= 2 )  THEN
+                  sirdg2(ji)     = sirdg2(ji)     - vsw * ( sss_1d(ji) - s_i_1d(ji) )        ! ridge salinity = s_i
+                  sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoic * r1_rdtice  &  ! put back sss_m into the ocean
+                     &                            - s_i_1d(ji) * vsw * rhoic * r1_rdtice     ! and get  s_i  from the ocean 
+               ENDIF
+
+
+               !------------------------------------------            
+               ! 2.6) update jl1 (removing ridged/rafted area)
+               !------------------------------------------            
+               a_i_2d (ji,jl1) = a_i_2d (ji,jl1) - airdg1    - airft1
+               v_i_2d (ji,jl1) = v_i_2d (ji,jl1) - virdg1    - virft(ji)
+               v_s_2d (ji,jl1) = v_s_2d (ji,jl1) - vsrdg(ji) - vsrft(ji)
+               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1    - sirft(ji)
+               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1    - oirft1
+               ! MV MP 2016
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1
+                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji)
+               ENDIF
+               ! END MV MP 2016
+               ze_s_2d(ji,1,jl1) = ze_s_2d(ji,1,jl1) - esrdg (ji) - esrft (ji)
+            ENDIF
+
+         END DO ! ji
+
+         ! special loop for e_i because of layers jk
+         DO jk = 1, nlay_i
+            DO ji = 1, npti
+               IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN
+                  ! Compute ridging /rafting fractions
+                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji)
+                  afrft = araft (ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji)
+                  ! Compute ridging ice and new ridges for ei
+                  eirdg(ji,jk) = ze_i_2d (ji,jk,jl1) * afrdg + ersw(ji) * r1_nlay_i
+                  eirft(ji,jk) = ze_i_2d (ji,jk,jl1) * afrft
+                  ! Update jl1
+                  ze_i_2d(ji,jk,jl1) = ze_i_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft ) 
+               ENDIF
+            END DO
+         END DO
+         
+
+         !-------------------------------------------------------------------------------
+         ! 3) Add area, volume, and energy of new ridge to each category jl2
+         !-------------------------------------------------------------------------------
+         DO jl2  = 1, jpl 
+            !
+            DO ji = 1, npti
+
+               IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN
+
+                  ! Compute the fraction of ridged ice area and volume going to thickness category jl2.
+                  IF( hrmin(ji,jl1) <= hi_max(jl2) .AND. hrmax(ji,jl1) > hi_max(jl2-1) ) THEN
+                     !-----------------------------------------------------------------
+                     ! 2.8 Compute quantities used to apportion ice among categories
+                     ! in the n2 loop below
+                     !-----------------------------------------------------------------
+                     hL = MAX( hrmin(ji,jl1), hi_max(jl2-1) )
+                     hR = MIN( hrmax(ji,jl1), hi_max(jl2)   )
+                     farea    = ( hR      - hL      ) / ( hrmax(ji,jl1)                 - hrmin(ji,jl1)                 )
+                     fvol(ji) = ( hR * hR - hL * hL ) / ( hrmax(ji,jl1) * hrmax(ji,jl1) - hrmin(ji,jl1) * hrmin(ji,jl1) )
+                  ELSE
+                     farea    = 0._wp 
+                     fvol(ji) = 0._wp                  
+                  ENDIF
+
+                  ! Compute the fraction of rafted ice area and volume going to thickness category jl2
+                  !!gm see above               IF( hraft(ji) <= hi_max(jl2) .AND. hraft(ji) >  hi_max(jl2-1) ) THEN
+                  IF( hi_max(jl2-1) < hraft(ji,jl1) .AND. hraft(ji,jl1) <= hi_max(jl2)  ) THEN   ;   zswitch(ji) = 1._wp
+                  ELSE                                                                           ;   zswitch(ji) = 0._wp
+                  ENDIF
+                  !
+                  a_i_2d (ji,jl2) = a_i_2d (ji,jl2) + ( airdg2(ji) * farea    + airft2(ji) * zswitch(ji) )
+                  oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ( oirdg2(ji) * farea    + oirft2(ji) * zswitch(ji) )
+                  v_i_2d (ji,jl2) = v_i_2d (ji,jl2) + ( virdg2(ji) * fvol(ji) + virft (ji) * zswitch(ji) )
+                  sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ( sirdg2(ji) * fvol(ji) + sirft (ji) * zswitch(ji) )
+                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  &
+                     &                                    vsrft (ji) * rn_fsnwrft * zswitch(ji) )
+                  ! MV MP 2016
+                  IF ( nn_pnd_scheme > 0 ) THEN
+                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   &
+                        &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   )
+                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         & 
+                        &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   )
+                  ENDIF
+                  ! END MV MP 2016
+                  ze_s_2d(ji,1,jl2) = ze_s_2d(ji,1,jl2) + ( esrdg (ji) * rn_fsnwrdg * fvol(ji)  +  &
+                     &                                      esrft (ji) * rn_fsnwrft * zswitch(ji) )
+                  
+               ENDIF
+
+            END DO
+
+            DO jk = 1, nlay_i
+               DO ji = 1, npti
+                  IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp )   &
+                     &   ze_i_2d(ji,jk,jl2) = ze_i_2d(ji,jk,jl2) + eirdg(ji,jk) * fvol(ji) + eirft(ji,jk) * zswitch(ji)                  
+               END DO
+            END DO
+            !
+         END DO ! jl2
+         !
+      END DO ! jl1
+      !
+      ! In case ridging/rafting lead to very small negative values (sometimes it happens)
+      WHERE( a_i_2d(1:npti,:) < 0._wp )   a_i_2d(1:npti,:) = 0._wp
+      WHERE( v_i_2d(1:npti,:) < 0._wp )   v_i_2d(1:npti,:) = 0._wp
+      !
+   END SUBROUTINE rdgrft_shift
+
+
+   SUBROUTINE ice_strength
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE ice_strength ***
+      !!
+      !! ** Purpose :   computes ice strength used in dynamics routines of ice thickness
+      !!
+      !! ** Method  :   Compute the strength of the ice pack, defined as the energy (J m-2) 
+      !!              dissipated per unit area removed from the ice pack under compression,
+      !!              and assumed proportional to the change in potential energy caused
+      !!              by ridging. Note that only Hibler's formulation is stable and that
+      !!              ice strength has to be smoothed
+      !!----------------------------------------------------------------------
+      INTEGER             ::   ji, jj, jl  ! dummy loop indices
+      INTEGER             ::   ismooth     ! smoothing the resistance to deformation
+      INTEGER             ::   itframe     ! number of time steps for the P smoothing
+      REAL(wp)            ::   zp, z1_3    ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zworka           ! temporary array used here
+      REAL(wp), DIMENSION(jpi,jpj) ::   zstrp1, zstrp2   ! strength at previous time steps
+      !!----------------------------------------------------------------------
+      !                              !--------------------------------------------------!
+      IF( ln_str_H79 ) THEN          ! Ice strength => Hibler (1979) method             !
+      !                              !--------------------------------------------------!
+         strength(:,:) = rn_pstar * SUM( v_i(:,:,:), dim=3 ) * EXP( -rn_crhg * ( 1._wp - SUM( a_i(:,:,:), dim=3 ) ) )
+         ismooth = 1
+         !                           !--------------------------------------------------!
+      ELSE                           ! Zero strength                                    !
+         !                           !--------------------------------------------------!
+         strength(:,:) = 0._wp
+         ismooth = 0
+      ENDIF
+      !                              !--------------------------------------------------!
+      SELECT CASE( ismooth )         ! Smoothing ice strength                           !
+      !                              !--------------------------------------------------!
+      CASE( 1 )               !--- Spatial smoothing
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
+                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
+                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
+                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
+               ELSE
+                  zworka(ji,jj) = 0._wp
+               ENDIF
+            END DO
+         END DO
+         
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               strength(ji,jj) = zworka(ji,jj)
+            END DO
+         END DO
+         CALL lbc_lnk( strength, 'T', 1. )
+         !
+      CASE( 2 )               !--- Temporal smoothing
+         IF ( kt_ice == nit000 ) THEN
+            zstrp1(:,:) = 0._wp
+            zstrp2(:,:) = 0._wp
+         ENDIF
+         !
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+                  itframe = 1 ! number of time steps for the running mean
+                  IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1
+                  IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1
+                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe
+                  zstrp2  (ji,jj) = zstrp1  (ji,jj)
+                  zstrp1  (ji,jj) = strength(ji,jj)
+                  strength(ji,jj) = zp
+               ENDIF
+            END DO
+         END DO
+         CALL lbc_lnk( strength, 'T', 1. )
+         !
+      END SELECT
+      !
+   END SUBROUTINE ice_strength
+
+
+   SUBROUTINE ice_dyn_rdgrft_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_dyn_rdgrft_init ***
+      !!
+      !! ** Purpose :   Physical constants and parameters linked 
+      !!                to the mechanical ice redistribution
+      !!
+      !! ** Method  :   Read the namdyn_rdgrft namelist 
+      !!                and check the parameters values 
+      !!                called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namdyn_rdgrft
+      !!-------------------------------------------------------------------
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namdyn_rdgrft/ ln_str_H79, rn_pstar, rn_crhg, &
+         &                    rn_csrdg  ,                    &
+         &                    ln_partf_lin, rn_gstar,        &
+         &                    ln_partf_exp, rn_astar,        & 
+         &                    ln_ridging, rn_hstar, rn_porordg, rn_fsnwrdg, rn_fpndrdg,  & 
+         &                    ln_rafting, rn_hraft, rn_craft  , rn_fsnwrft, rn_fpndrft
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution
+      READ  ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp )
+      !
+      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution
+      READ  ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namdyn_rdgrft )
+      !
+      IF (lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_dyn_rdgrft_init: ice parameters for ridging/rafting '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namdyn_rdgrft:'
+         WRITE(numout,*) '      ice strength parameterization Hibler (1979)              ln_str_H79   = ', ln_str_H79 
+         WRITE(numout,*) '            1st bulk-rheology parameter                        rn_pstar     = ', rn_pstar
+         WRITE(numout,*) '            2nd bulk-rhelogy parameter                         rn_crhg      = ', rn_crhg
+         WRITE(numout,*) '      Fraction of shear energy contributing to ridging         rn_csrdg     = ', rn_csrdg 
+         WRITE(numout,*) '      linear ridging participation function                    ln_partf_lin = ', ln_partf_lin
+         WRITE(numout,*) '            Fraction of ice coverage contributing to ridging   rn_gstar     = ', rn_gstar
+         WRITE(numout,*) '      Exponential ridging participation function               ln_partf_exp = ', ln_partf_exp
+         WRITE(numout,*) '            Equivalent to G* for an exponential function       rn_astar     = ', rn_astar
+         WRITE(numout,*) '      Ridging of ice sheets or not                             ln_ridging   = ', ln_ridging
+         WRITE(numout,*) '            max ridged ice thickness                           rn_hstar     = ', rn_hstar
+         WRITE(numout,*) '            Initial porosity of ridges                         rn_porordg   = ', rn_porordg
+         WRITE(numout,*) '            Fraction of snow volume conserved during ridging   rn_fsnwrdg   = ', rn_fsnwrdg 
+         WRITE(numout,*) '            Fraction of pond volume conserved during ridging   rn_fpndrdg   = ', rn_fpndrdg 
+         WRITE(numout,*) '      Rafting of ice sheets or not                             ln_rafting   = ', ln_rafting
+         WRITE(numout,*) '            Parmeter thickness (threshold between ridge-raft)  rn_hraft     = ', rn_hraft
+         WRITE(numout,*) '            Rafting hyperbolic tangent coefficient             rn_craft     = ', rn_craft  
+         WRITE(numout,*) '            Fraction of snow volume conserved during rafting   rn_fsnwrft   = ', rn_fsnwrft 
+         WRITE(numout,*) '            Fraction of pond volume conserved during rafting   rn_fpndrft   = ', rn_fpndrft 
+      ENDIF
+      !
+      IF ( ( ln_partf_lin .AND. ln_partf_exp ) .OR. ( .NOT.ln_partf_lin .AND. .NOT.ln_partf_exp ) ) THEN
+         CALL ctl_stop( 'ice_dyn_rdgrft_init: choose one and only one participation function (ln_partf_lin or ln_partf_exp)' )
+      ENDIF
+      !                              ! allocate tke arrays
+      IF( ice_dyn_rdgrft_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_dyn_rdgrft_init: unable to allocate arrays' )
+      !
+  END SUBROUTINE ice_dyn_rdgrft_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icedyn_rdgrft
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90	(revision 8586)
@@ -0,0 +1,150 @@
+MODULE icedyn_rhg
+   !!======================================================================
+   !!                     ***  MODULE  icedyn_rhg  ***
+   !!   Sea-Ice dynamics : master routine for rheology 
+   !!======================================================================
+   !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code 
+   !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid
+   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!    ice_dyn_rhg      : computes ice velocities
+   !!    ice_dyn_rhg_init : initialization and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE ice            ! sea-ice: variables
+   USE icedyn_rhg_evp ! sea-ice: EVP rheology
+   USE icectl         ! sea-ice: control prints
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dyn_rhg        ! called by icestp.F90
+   PUBLIC   ice_dyn_rhg_init   ! called by icestp.F90
+
+   INTEGER ::              nice_rhg   ! choice of the type of rheology
+   !                                        ! associated indices:
+   INTEGER, PARAMETER ::   np_rhgEVP = 1   ! EVP rheology
+!! INTEGER, PARAMETER ::   np_rhgEAP = 2   ! EAP rheology
+
+   ! ** namelist (namrhg) **
+   LOGICAL ::   ln_rhg_EVP       ! EVP rheology
+   !
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedyn_rhg.F90 8378 2017-07-26 13:55:59Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_dyn_rhg( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE ice_dyn_rhg  ***
+      !!               
+      !! ** Purpose :   compute ice velocity
+      !!
+      !! ** Action  : comupte - ice velocity (u_ice, v_ice)
+      !!                      - 3 components of the stress tensor (stress1_i, stress2_i, stress12_i)
+      !!                      - shear, divergence and delta (shear_i, divu_i, delta_i)
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ice time step
+      !!--------------------------------------------------------------------
+      ! controls
+      IF( nn_timing == 1 )   CALL timing_start('icedyn_rhg')                                                             ! timing
+      IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'ice_dyn_rhg: sea-ice rheology'
+         WRITE(numout,*)'~~~~~~~~~~~'
+      ENDIF
+
+      ! --------
+      ! Rheology
+      ! --------   
+      SELECT CASE( nice_rhg )
+      !                                !------------------------!
+      CASE( np_rhgEVP )                ! Elasto-Viscous-Plastic !
+         !                             !------------------------!
+         CALL ice_dyn_rhg_evp( kt, stress1_i, stress2_i, stress12_i, u_ice, v_ice, shear_i, divu_i, delta_i )
+         !         
+      END SELECT
+      !
+      IF( lrst_ice ) THEN                       !* write EVP fields in the restart file
+         IF( ln_rhg_EVP )   CALL rhg_evp_rst( 'WRITE', kt )
+      ENDIF
+      !
+      ! controls
+      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+      IF( ln_ctl         )   CALL ice_prt3D   ('icedyn_rhg')                                                             ! prints
+      IF( nn_timing == 1 )   CALL timing_stop ('icedyn_rhg')                                                             ! timing
+      !
+   END SUBROUTINE ice_dyn_rhg
+
+   SUBROUTINE ice_dyn_rhg_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_dyn_rhg_init  ***
+      !!
+      !! ** Purpose : Physical constants and parameters linked to the ice
+      !!      dynamics
+      !!
+      !! ** Method  :  Read the namdyn_rhg namelist and check the ice-dynamic
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namdyn_rhg
+      !!-------------------------------------------------------------------
+      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namdyn_rhg/  ln_rhg_EVP, rn_creepl, rn_ecc , nn_nevp, rn_relast
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )         ! Namelist namdyn_rhg in reference namelist : Ice dynamics
+      READ  ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist', lwp )
+      !
+      REWIND( numnam_ice_cfg )         ! Namelist namdyn_rhg in configuration namelist : Ice dynamics
+      READ  ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namdyn_rhg )
+      !
+      IF(lwp) THEN                     ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_dyn_rhg_init: ice parameters for ice dynamics '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namdyn_rhg:'
+         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP = ', ln_rhg_EVP
+         WRITE(numout,*) '         creep limit                                       rn_creepl  = ', rn_creepl
+         WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc     = ', rn_ecc
+         WRITE(numout,*) '         number of iterations for subcycling               nn_nevp    = ', nn_nevp
+         WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast  = ', rn_relast
+      ENDIF
+      !
+      !                             !== set the choice of ice advection ==!
+      ioptio = 0 
+      IF( ln_rhg_EVP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEVP    ;   ENDIF
+!!    IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_dyn_rhg_init: choose one and only one ice rheology' )
+      !
+      IF( ln_rhg_EVP )   CALL rhg_evp_rst( 'READ' )  !* read or initialize all required files
+      !
+   END SUBROUTINE ice_dyn_rhg_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif 
+
+   !!======================================================================
+END MODULE icedyn_rhg
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90	(revision 8586)
@@ -0,0 +1,884 @@
+MODULE icedyn_rhg_evp
+   !!======================================================================
+   !!                     ***  MODULE  icedyn_rhg_evp  ***
+   !!   Sea-Ice dynamics : rheology Elasto-Viscous-Plastic
+   !!======================================================================
+   !! History :   -   !  2007-03  (M.A. Morales Maqueda, S. Bouillon) Original code
+   !!            3.0  !  2008-03  (M. Vancoppenolle) LIM3
+   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy 
+   !!            3.3  !  2009-05  (G.Garric) addition of the evp cas
+   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation 
+   !!            3.5  !  2012-08  (R. Benshila)  AGRIF
+   !!            3.6  !  2016-06  (C. Rousset) Rewriting + landfast ice + possibility to use mEVP (Bouillon 2013)
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_dyn_rhg_evp       : computes ice velocities from EVP rheology
+   !!----------------------------------------------------------------------
+   USE phycst         ! Physical constant
+   USE dom_oce        ! Ocean domain
+   USE sbc_oce , ONLY : ln_ice_embd, nn_fsbc, ssh_m
+   USE sbc_ice , ONLY : utau_ice, vtau_ice, snwice_mass, snwice_mass_b
+   USE ice            ! sea-ice: ice variables
+   USE icedyn_rdgrft  ! sea-ice: ice strength
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE prtctl         ! Print control
+   !
+#if defined key_agrif
+   USE agrif_lim3_interp
+#endif
+   USE bdy_oce   , ONLY: ln_bdy 
+   USE bdyice 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_dyn_rhg_evp   ! called by icedyn_rhg.F90
+   PUBLIC   rhg_evp_rst       ! called by icedyn_rhg.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icedyn_rhg_evp.F90 8378 2017-07-26 13:55:59Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_dyn_rhg_evp( kt, pstress1_i, pstress2_i, pstress12_i, u_ice, v_ice, pshear_i, pdivu_i, pdelta_i )
+      !!-------------------------------------------------------------------
+      !!                 ***  SUBROUTINE ice_dyn_rhg_evp  ***
+      !!                          EVP-C-grid
+      !!
+      !! ** purpose : determines sea ice drift from wind stress, ice-ocean
+      !!  stress and sea-surface slope. Ice-ice interaction is described by 
+      !!  a non-linear elasto-viscous-plastic (EVP) law including shear 
+      !!  strength and a bulk rheology (Hunke and Dukowicz, 2002).	
+      !!
+      !!  The points in the C-grid look like this, dear reader
+      !!
+      !!                              (ji,jj)
+      !!                                 |
+      !!                                 |
+      !!                      (ji-1,jj)  |  (ji,jj)
+      !!                             ---------   
+      !!                            |         |
+      !!                            | (ji,jj) |------(ji,jj)
+      !!                            |         |
+      !!                             ---------   
+      !!                     (ji-1,jj-1)     (ji,jj-1)
+      !!
+      !! ** Inputs  : - wind forcing (stress), oceanic currents
+      !!                ice total volume (vt_i) per unit area
+      !!                snow total volume (vt_s) per unit area
+      !!
+      !! ** Action  : - compute u_ice, v_ice : the components of the 
+      !!                sea-ice velocity vector
+      !!              - compute delta_i, shear_i, divu_i, which are inputs
+      !!                of the ice thickness distribution
+      !!
+      !! ** Steps   : 0) compute mask at F point
+      !!              1) Compute ice snow mass, ice strength 
+      !!              2) Compute wind, oceanic stresses, mass terms and
+      !!                 coriolis terms of the momentum equation
+      !!              3) Solve the momentum equation (iterative procedure)
+      !!              4) Recompute delta, shear and divergence
+      !!                 (which are inputs of the ITD) & store stress
+      !!                 for the next time step
+      !!              5) Diagnostics including charge ellipse
+      !!
+      !! ** Notes   : There is the possibility to use mEVP from Bouillon 2013
+      !!              (by uncommenting some lines in part 3 and changing alpha and beta parameters)
+      !!              but this solution appears very unstable (see Kimmritz et al 2016)
+      !!
+      !! References : Hunke and Dukowicz, JPO97
+      !!              Bouillon et al., Ocean Modelling 2009
+      !!              Bouillon et al., Ocean Modelling 2013
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! time step
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pstress1_i, pstress2_i, pstress12_i
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   u_ice, v_ice 
+      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pshear_i, pdivu_i, pdelta_i 
+      !!
+      INTEGER ::   ji, jj       ! dummy loop indices
+      INTEGER ::   jter         ! local integers
+
+      REAL(wp) ::   zrhoco                                                   ! rau0 * rn_cio
+      REAL(wp) ::   zdtevp, z1_dtevp                                         ! time step for subcycling
+      REAL(wp) ::   ecc2, z1_ecc2                                            ! square of yield ellipse eccenticity
+      REAL(wp) ::   zbeta, zalph1, z1_alph1, zalph2, z1_alph2                ! alpha and beta from Bouillon 2009 and 2013
+      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV                            ! ice/snow mass
+      REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2            ! temporary scalars
+      REAL(wp) ::   zTauO, zTauB, zTauE, zvel                                ! temporary scalars
+
+      REAL(wp) ::   zresm                                                    ! Maximal error on ice velocity
+      REAL(wp) ::   zintb, zintn                                             ! dummy argument
+      REAL(wp) ::   zfac_x, zfac_y
+      REAL(wp) ::   zshear, zdum1, zdum2
+      
+      REAL(wp), DIMENSION(jpi,jpj) ::   z1_e1t0, z1_e2t0                ! scale factors
+      REAL(wp), DIMENSION(jpi,jpj) ::   zp_delt                         ! P/delta at T points
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::   zaU   , zaV                     ! ice fraction on U/V points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! ice/snow mass/dt on U/V points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points
+      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                           
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfU   , zfV                     ! internal stresses
+      
+      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear
+      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12                  ! stress tensor components
+      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr           ! check convergence
+      REAL(wp), DIMENSION(jpi,jpj) ::   zpice                           ! array used for the calculation of ice surface slope:
+                                                                             !   ocean surface (ssh_m) if ice is not embedded
+                                                                             !   ice top surface if ice is embedded   
+      REAL(wp), DIMENSION(jpi,jpj) ::   zCorx, zCory                    ! Coriolis stress array
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! Ocean-to-ice stress array
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   zswitchU, zswitchV              ! dummy arrays
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmaskU, zmaskV                  ! mask for ice presence
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfmask, zwf                     ! mask at F points for the ice
+
+      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter
+      REAL(wp), PARAMETER          ::   zmmin  = 1._wp                  ! ice mass (kg/m2) below which ice velocity equals ocean velocity
+      !! --- diags
+      REAL(wp), DIMENSION(jpi,jpj) ::   zswi
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3
+      !! --- SIMIP diags
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig1      ! Average normal stress in sea ice   
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig2      ! Maximum shear stress in sea ice
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dx   ! X-direction sea-surface tilt term (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dy   ! X-direction sea-surface tilt term (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstrx   ! X-direction coriolis stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstry   ! Y-direction coriolis stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstrx   ! X-direction internal stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstry   ! Y-direction internal stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_utau_oi   ! X-direction ocean-ice stress
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_vtau_oi   ! Y-direction ocean-ice stress  
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_ice ! Y-component of ice mass transport (kg/s)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_snw ! X-component of snow mass transport (kg/s)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_snw ! Y-component of snow mass transport (kg/s)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xatrp     ! X-component of area transport (m2/s)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_yatrp     ! Y-component of area transport (m2/s)      
+      !!-------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology'
+
+#if defined key_agrif 
+      CALL agrif_interp_lim3( 'U', 0, nn_nevp )   ! First interpolation of coarse values
+      CALL agrif_interp_lim3( 'V', 0, nn_nevp )
+#endif
+      !
+      !------------------------------------------------------------------------------!
+      ! 0) mask at F points for the ice
+      !------------------------------------------------------------------------------!
+      ! ocean/land mask
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1      ! NO vector opt.
+            zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
+         END DO
+      END DO
+      CALL lbc_lnk( zfmask, 'F', 1._wp )
+
+      ! Lateral boundary conditions on velocity (modify zfmask)
+      zwf(:,:) = zfmask(:,:)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( zfmask(ji,jj) == 0._wp ) THEN
+               zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) )
+            ENDIF
+         END DO
+      END DO
+      DO jj = 2, jpjm1
+         IF( zfmask(1,jj) == 0._wp ) THEN
+            zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+         ENDIF
+         IF( zfmask(jpi,jj) == 0._wp ) THEN
+            zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+         ENDIF
+      END DO
+      DO ji = 2, jpim1
+         IF( zfmask(ji,1) == 0._wp ) THEN
+            zfmask(ji,1  ) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+         ENDIF
+         IF( zfmask(ji,jpj) == 0._wp ) THEN
+            zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+         ENDIF
+      END DO
+      CALL lbc_lnk( zfmask, 'F', 1._wp )
+
+      !------------------------------------------------------------------------------!
+      ! 1) define some variables and initialize arrays
+      !------------------------------------------------------------------------------!
+      zrhoco = rau0 * rn_cio 
+
+      ! ecc2: square of yield ellipse eccenticrity
+      ecc2    = rn_ecc * rn_ecc
+      z1_ecc2 = 1._wp / ecc2
+
+      ! Time step for subcycling
+      zdtevp   = rdt_ice / REAL( nn_nevp )
+      z1_dtevp = 1._wp / zdtevp
+
+      ! alpha parameters (Bouillon 2009)
+      zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp
+      zalph2 = zalph1 * z1_ecc2
+
+      ! alpha and beta parameters (Bouillon 2013)
+      !!zalph1 = 40.
+      !!zalph2 = 40.
+      !!zbeta  = 3000.
+      !!zbeta = REAL( nn_nevp )   ! close to classical EVP of Hunke (2001)
+
+      z1_alph1 = 1._wp / ( zalph1 + 1._wp )
+      z1_alph2 = 1._wp / ( zalph2 + 1._wp )
+
+      ! Initialise stress tensor 
+      zs1 (:,:) = pstress1_i (:,:) 
+      zs2 (:,:) = pstress2_i (:,:)
+      zs12(:,:) = pstress12_i(:,:)
+
+      ! Ice strength
+      CALL ice_strength
+
+      ! scale factors
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj  ) + e1t(ji,jj  ) )
+            z1_e2t0(ji,jj) = 1._wp / ( e2t(ji  ,jj+1) + e2t(ji,jj  ) )
+         END DO
+      END DO
+            
+      !
+      !------------------------------------------------------------------------------!
+      ! 2) Wind / ocean stress, mass terms, coriolis terms
+      !------------------------------------------------------------------------------!
+
+      IF( ln_ice_embd ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+         !                                            
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp     
+         !
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+         !
+         zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0
+         !
+      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
+         zpice(:,:) = ssh_m(:,:)
+      ENDIF
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+
+            ! ice fraction at U-V points
+            zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+            zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+            ! Ice/snow mass at U-V points
+            zm1 = ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
+            zm2 = ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
+            zm3 = ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
+            zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+            zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+            ! Ocean currents at U-V points
+            v_oceU(ji,jj)   = 0.5_wp * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji+1,jj)    &
+               &                       + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)
+            
+            u_oceV(ji,jj)   = 0.5_wp * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj+1)    &
+               &                       + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)
+
+            ! Coriolis at T points (m*f)
+            zmf(ji,jj)      = zm1 * ff_t(ji,jj)
+
+            ! m/dt
+            zmU_t(ji,jj)    = zmassU * z1_dtevp
+            zmV_t(ji,jj)    = zmassV * z1_dtevp
+
+            ! Drag ice-atm.
+            zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
+            zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
+
+            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
+            zspgU(ji,jj)    = - zmassU * grav * ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+            zspgV(ji,jj)    = - zmassV * grav * ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
+
+            ! masks
+            zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
+            zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
+
+            ! switches
+            zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin
+            zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin
+
+         END DO
+      END DO
+      CALL lbc_lnk( zmf, 'T', 1. )
+      !
+      !------------------------------------------------------------------------------!
+      ! 3) Solution of the momentum equation, iterative procedure
+      !------------------------------------------------------------------------------!
+      !
+      !                                               !----------------------!
+      DO jter = 1 , nn_nevp                           !    loop over jter    !
+         !                                            !----------------------!        
+         IF(ln_ctl) THEN   ! Convergence test
+            DO jj = 1, jpjm1
+               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step
+               zv_ice(:,jj) = v_ice(:,jj)
+            END DO
+         ENDIF
+
+         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
+         DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points
+            DO ji = 1, jpim1
+
+               ! shear at F points
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+                  &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+            END DO
+         END DO
+         CALL lbc_lnk( zds, 'F', 1. )
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1 ! no vector loop
+
+               ! shear**2 at T points (doc eq. A16)
+               zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+                  &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+                  &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+              
+               ! divergence at T points
+               zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+                  &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+                  &    ) * r1_e1e2t(ji,jj)
+               zdiv2 = zdiv * zdiv
+               
+               ! tension at T points
+               zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+                  &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+                  &   ) * r1_e1e2t(ji,jj)
+               zdt2 = zdt * zdt
+               
+               ! delta at T points
+               zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
+
+               ! P/delta at T points
+               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl )
+               
+               ! stress at T points
+               zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv - zdelta ) ) * z1_alph1
+               zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 ) ) * z1_alph2
+             
+            END DO
+         END DO
+         CALL lbc_lnk( zp_delt, 'T', 1. )
+
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               ! P/delta at F points
+               zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
+               
+               ! stress at F points
+               zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 ) * 0.5_wp ) * z1_alph2
+
+            END DO
+         END DO
+         CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
+ 
+
+         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1               
+               !                   !--- U points
+               zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
+                  &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
+                  &                    ) * r1_e2u(ji,jj)                                                                      &
+                  &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
+                  &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
+                  &                  ) * r1_e1e2u(ji,jj)
+                  !
+                  !                !--- V points
+               zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
+                  &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
+                  &                    ) * r1_e1v(ji,jj)                                                                      &
+                  &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
+                  &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
+                  &                  ) * r1_e1e2v(ji,jj)
+                  !
+                  !                !--- u_ice at V point
+               u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                     + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)
+                  !
+                  !                !--- v_ice at U point
+               v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     &
+                  &                     + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)
+               !
+            END DO
+         END DO
+         !
+         ! --- Computation of ice velocity --- !
+         !  Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta are chosen wisely and large nn_nevp
+         !  Bouillon et al. 2009 (eq 34-35) => stable
+         IF( MOD(jter,2) == 0 ) THEN ! even iterations
+            !
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                     !                 !--- tau_io/(v_oce - v_ice)
+                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+                     !                 !--- Ocean-to-Ice stress
+                  ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+                     !
+                     !                 !--- tau_bottom/v_ice
+                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) )
+                  zTauB = - tau_icebfr(ji,jj) / zvel
+                     !
+                     !                 !--- Coriolis at V-points (energy conserving formulation)
+                  zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+                     !
+                     !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+                     !
+                     !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                     !
+                     !                 !--- ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * v_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )                  &  ! v_ice = v_oce if mass < zmmin
+                     &            ) * zmaskV(ji,jj)
+                     !
+                  ! Bouillon 2013
+                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  &
+                  !!   &           + zfV(ji,jj) + zCory(ji,jj) + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  &
+                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj)
+                  !
+               END DO
+            END DO
+            CALL lbc_lnk( v_ice, 'V', -1. )
+            !
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'V' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_dyn( 'V' )
+            !
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                               
+                  ! tau_io/(u_oce - u_ice)
+                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+
+                  ! Ocean-to-Ice stress
+                  ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+
+                  ! tau_bottom/u_ice
+                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) )
+                  zTauB = - tau_icebfr(ji,jj) / zvel
+
+                  ! Coriolis at U-points (energy conserving formulation)
+                  zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+                  
+                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+
+                  ! landfast switch => 0 = static friction ; 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+
+                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )                  &  ! v_ice = v_oce if mass < zmmin 
+                     &            ) * zmaskU(ji,jj)
+                  ! Bouillon 2013
+                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  &
+                  !!   &           + zfU(ji,jj) + zCorx(ji,jj) + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  &
+                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj)
+               END DO
+            END DO
+            CALL lbc_lnk( u_ice, 'U', -1. )
+            !
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'U' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_dyn( 'U' )
+            !
+         ELSE ! odd iterations
+            !
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+
+                  ! tau_io/(u_oce - u_ice)
+                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+
+                  ! Ocean-to-Ice stress
+                  ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+
+                  ! tau_bottom/u_ice
+                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) )
+                  zTauB = - tau_icebfr(ji,jj) / zvel
+
+                  ! Coriolis at U-points (energy conserving formulation)
+                  zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+
+                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+
+                  ! landfast switch => 0 = static friction ; 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+
+                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )                  &  ! v_ice = v_oce if mass < zmmin
+                     &            ) * zmaskU(ji,jj)
+                  ! Bouillon 2013
+                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  &
+                  !!   &           + zfU(ji,jj) + zCorx(ji,jj) + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  &
+                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj)
+               END DO
+            END DO
+            CALL lbc_lnk( u_ice, 'U', -1. )
+            !
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'U' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_dyn( 'U' )
+            !
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+         
+                  ! tau_io/(v_oce - v_ice)
+                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+
+                  ! Ocean-to-Ice stress
+                  ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+
+                  ! tau_bottom/v_ice
+                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) )
+                  ztauB = - tau_icebfr(ji,jj) / zvel
+                  
+                  ! Coriolis at V-points (energy conserving formulation)
+                  zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+
+                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+
+                  ! landfast switch => 0 = static friction (tau_icebfr > zTauE); 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  
+                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * v_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )                  &  ! v_ice = v_oce if mass < zmmin
+                     &            ) * zmaskV(ji,jj)
+                  ! Bouillon 2013
+                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  &
+                  !!   &           + zfV(ji,jj) + zCory(ji,jj) + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  &
+                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj)
+               END DO
+            END DO
+            CALL lbc_lnk( v_ice, 'V', -1. )
+            !
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'V' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_dyn( 'V' )
+            !
+         ENDIF
+         
+         IF(ln_ctl) THEN   ! Convergence test
+            DO jj = 2 , jpjm1
+               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
+            END DO
+            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) )
+            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
+         ENDIF
+         !
+         !                                                ! ==================== !
+      END DO                                              !  end loop over jter  !
+      !                                                   ! ==================== !
+      !
+      !------------------------------------------------------------------------------!
+      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
+      !------------------------------------------------------------------------------!
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+
+            ! shear at F points
+            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+         END DO
+      END DO           
+      CALL lbc_lnk( zds, 'F', 1. )
+      
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1 ! no vector loop
+            
+            ! tension**2 at T points
+            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+               &   ) * r1_e1e2t(ji,jj)
+            zdt2 = zdt * zdt
+            
+            ! shear**2 at T points (doc eq. A16)
+            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+            
+            ! shear at T points
+            pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
+
+            ! divergence at T points
+            pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+               &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+               &             ) * r1_e1e2t(ji,jj)
+            
+            ! delta at T points
+            zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )  
+            rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0
+            pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch
+
+         END DO
+      END DO
+      CALL lbc_lnk_multi( pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. )
+      
+      ! --- Store the stress tensor for the next time step --- !
+      pstress1_i (:,:) = zs1 (:,:)
+      pstress2_i (:,:) = zs2 (:,:)
+      pstress12_i(:,:) = zs12(:,:)
+      !
+
+      !------------------------------------------------------------------------------!
+      ! 5) diagnostics
+      !------------------------------------------------------------------------------!
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zswi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
+         END DO
+      END DO
+
+      ! --- divergence, shear and strength --- !
+      IF( iom_use('idive')  )   CALL iom_put( "idive"  , pdivu_i(:,:)   * zswi(:,:) )   ! divergence
+      IF( iom_use('ishear') )   CALL iom_put( "ishear" , pshear_i(:,:)  * zswi(:,:) )   ! shear
+      IF( iom_use('icestr') )   CALL iom_put( "icestr" , strength(:,:) * zswi(:,:) )   ! Ice strength
+
+      ! --- charge ellipse --- !
+      IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') ) THEN
+         !
+         ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) )
+         !         
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zdum1 = ( zswi(ji-1,jj) * pstress12_i(ji-1,jj) + zswi(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
+                  &      zswi(ji  ,jj) * pstress12_i(ji  ,jj) + zswi(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
+                  &    / MAX( 1._wp, zswi(ji-1,jj) + zswi(ji,jj-1) + zswi(ji,jj) + zswi(ji-1,jj-1) )
+
+               zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress  
+
+               zdum2 = zswi(ji,jj) / MAX( 1._wp, strength(ji,jj) )
+
+!!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002)
+!!               zsig2(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) - zshear ) ! principal stress (x-direction, see Hunke & Dukowicz 2002)
+!!               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress
+!!                                                                                                               ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11))
+               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015
+               zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                    ! shear stress
+               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 )
+            END DO
+         END DO
+         CALL lbc_lnk_multi( zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. )
+         !
+         IF( iom_use('isig1') )   CALL iom_put( "isig1" , zsig1 )
+         IF( iom_use('isig2') )   CALL iom_put( "isig2" , zsig2 )
+         IF( iom_use('isig3') )   CALL iom_put( "isig3" , zsig3 )
+         !
+         DEALLOCATE( zsig1 , zsig2 , zsig3 )
+      ENDIF
+      
+      ! --- SIMIP --- !
+      IF ( iom_use( 'normstr'  ) .OR. iom_use( 'sheastr'  ) .OR. iom_use( 'dssh_dx'  ) .OR. iom_use( 'dssh_dy'  ) .OR. &
+         & iom_use( 'corstrx'  ) .OR. iom_use( 'corstry'  ) .OR. iom_use( 'intstrx'  ) .OR. iom_use( 'intstry'  ) .OR. &
+         & iom_use( 'utau_oi'  ) .OR. iom_use( 'vtau_oi'  ) .OR. iom_use( 'xmtrpice' ) .OR. iom_use( 'ymtrpice' ) .OR. &
+         & iom_use( 'xmtrpsnw' ) .OR. iom_use( 'ymtrpsnw' ) .OR. iom_use( 'xatrp'    ) .OR. iom_use( 'yatrp'    ) ) THEN
+
+         ALLOCATE( zdiag_sig1     (jpi,jpj) , zdiag_sig2     (jpi,jpj) , zdiag_dssh_dx  (jpi,jpj) , zdiag_dssh_dy  (jpi,jpj) ,  &
+            &      zdiag_corstrx  (jpi,jpj) , zdiag_corstry  (jpi,jpj) , zdiag_intstrx  (jpi,jpj) , zdiag_intstry  (jpi,jpj) ,  &
+            &      zdiag_utau_oi  (jpi,jpj) , zdiag_vtau_oi  (jpi,jpj) , zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) ,  &
+            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp    (jpi,jpj) , zdiag_yatrp    (jpi,jpj) )
+         
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
+               
+               ! Stress tensor invariants (normal and shear stress N/m)
+               zdiag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * rswitch                                 ! normal stress
+               zdiag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * rswitch   ! shear stress
+               
+               ! Stress terms of the momentum equation (N/m2)
+               zdiag_dssh_dx(ji,jj) = zspgU(ji,jj) * rswitch    ! sea surface slope stress term
+               zdiag_dssh_dy(ji,jj) = zspgV(ji,jj) * rswitch
+               
+               zdiag_corstrx(ji,jj) = zCorx(ji,jj) * rswitch    ! Coriolis stress term
+               zdiag_corstry(ji,jj) = zCory(ji,jj) * rswitch
+               
+               zdiag_intstrx(ji,jj) = zfU(ji,jj)   * rswitch    ! internal stress term
+               zdiag_intstry(ji,jj) = zfV(ji,jj)   * rswitch
+               
+               zdiag_utau_oi(ji,jj) = ztaux_oi(ji,jj) * rswitch  ! oceanic stress
+               zdiag_vtau_oi(ji,jj) = ztauy_oi(ji,jj) * rswitch
+               
+               ! 2D ice mass, snow mass, area transport arrays (X, Y)
+               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * rswitch
+               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch
+               
+               zdiag_xmtrp_ice(ji,jj) = rhoic * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
+               zdiag_ymtrp_ice(ji,jj) = rhoic * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
+               
+               zdiag_xmtrp_snw(ji,jj) = rhosn * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
+               zdiag_ymtrp_snw(ji,jj) = rhosn * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
+               
+               zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )         ! area transport,      X-component
+               zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )         !        ''            Y-   ''
+               
+            END DO
+         END DO
+         
+         CALL lbc_lnk_multi(   zdiag_sig1   , 'T',  1., zdiag_sig2   , 'T',  1.,   &
+            &                  zdiag_dssh_dx, 'U', -1., zdiag_dssh_dy, 'V', -1.,   &
+            &                  zdiag_corstrx, 'U', -1., zdiag_corstry, 'V', -1.,   & 
+            &                  zdiag_intstrx, 'U', -1., zdiag_intstry, 'V', -1.    )
+         
+         CALL lbc_lnk_multi(   zdiag_utau_oi, 'U', -1., zdiag_vtau_oi, 'V', -1.    )
+         
+         CALL lbc_lnk_multi(   zdiag_xmtrp_ice, 'U', -1., zdiag_xmtrp_snw, 'U', -1.,   &
+            &                  zdiag_xatrp    , 'U', -1., zdiag_ymtrp_ice, 'V', -1.,   &
+            &                  zdiag_ymtrp_snw, 'V', -1., zdiag_yatrp    , 'V', -1.    )
+         
+         IF ( iom_use( 'normstr'  ) )   CALL iom_put( 'normstr'  ,  zdiag_sig1(:,:)      )   ! Normal stress
+         IF ( iom_use( 'sheastr'  ) )   CALL iom_put( 'sheastr'  ,  zdiag_sig2(:,:)      )   ! Shear stress
+         IF ( iom_use( 'dssh_dx'  ) )   CALL iom_put( 'dssh_dx'  ,  zdiag_dssh_dx(:,:)   )   ! Sea-surface tilt term in force balance (x)
+         IF ( iom_use( 'dssh_dy'  ) )   CALL iom_put( 'dssh_dy'  ,  zdiag_dssh_dy(:,:)   )   ! Sea-surface tilt term in force balance (y)
+         IF ( iom_use( 'corstrx'  ) )   CALL iom_put( 'corstrx'  ,  zdiag_corstrx(:,:)   )   ! Coriolis force term in force balance (x)
+         IF ( iom_use( 'corstry'  ) )   CALL iom_put( 'corstry'  ,  zdiag_corstry(:,:)   )   ! Coriolis force term in force balance (y)
+         IF ( iom_use( 'intstrx'  ) )   CALL iom_put( 'intstrx'  ,  zdiag_intstrx(:,:)   )   ! Internal force term in force balance (x)
+         IF ( iom_use( 'intstry'  ) )   CALL iom_put( 'intstry'  ,  zdiag_intstry(:,:)   )   ! Internal force term in force balance (y)
+         IF ( iom_use( 'utau_oi'  ) )   CALL iom_put( 'utau_oi'  ,  zdiag_utau_oi(:,:)   )   ! Ocean stress term in force balance (x)
+         IF ( iom_use( 'vtau_oi'  ) )   CALL iom_put( 'vtau_oi'  ,  zdiag_vtau_oi(:,:)   )   ! Ocean stress term in force balance (y)
+         IF ( iom_use( 'xmtrpice' ) )   CALL iom_put( 'xmtrpice' ,  zdiag_xmtrp_ice(:,:) )   ! X-component of sea-ice mass transport (kg/s)
+         IF ( iom_use( 'ymtrpice' ) )   CALL iom_put( 'ymtrpice' ,  zdiag_ymtrp_ice(:,:) )   ! Y-component of sea-ice mass transport 
+         IF ( iom_use( 'xmtrpsnw' ) )   CALL iom_put( 'xmtrpsnw' ,  zdiag_xmtrp_snw(:,:) )   ! X-component of snow mass transport (kg/s)
+         IF ( iom_use( 'ymtrpsnw' ) )   CALL iom_put( 'ymtrpsnw' ,  zdiag_ymtrp_snw(:,:) )   ! Y-component of snow mass transport
+         IF ( iom_use( 'xatrp'    ) )   CALL iom_put( 'xatrp'    ,  zdiag_xatrp(:,:)     )   ! X-component of ice area transport
+         IF ( iom_use( 'yatrp'    ) )   CALL iom_put( 'yatrp'    ,  zdiag_yatrp(:,:)     )   ! Y-component of ice area transport
+
+         DEALLOCATE( zdiag_sig1      , zdiag_sig2      , zdiag_dssh_dx   , zdiag_dssh_dy   ,  &
+            &        zdiag_corstrx   , zdiag_corstry   , zdiag_intstrx   , zdiag_intstry   ,  &
+            &        zdiag_utau_oi   , zdiag_vtau_oi   , zdiag_xmtrp_ice , zdiag_ymtrp_ice ,  &
+            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp     , zdiag_yatrp     )
+
+      ENDIF
+      !
+   END SUBROUTINE ice_dyn_rhg_evp
+
+   SUBROUTINE rhg_evp_rst( cdrw, kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE rhg_evp_rst  ***
+      !!                     
+      !! ** Purpose :   Read or write RHG file in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
+      !
+      INTEGER  ::   iter            ! local integer
+      INTEGER  ::   id1, id2, id3   ! local integers
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize
+         !                                   ! ---------------
+         IF( ln_rstart ) THEN                   !* Read the restart file
+            !
+            id1 = iom_varid( numrir, 'stress1_i' , ldstop = .FALSE. )
+            id2 = iom_varid( numrir, 'stress2_i' , ldstop = .FALSE. )
+            id3 = iom_varid( numrir, 'stress12_i', ldstop = .FALSE. )
+            !
+            IF( MIN( id1, id2, id3 ) > 0 ) THEN      ! fields exist
+               CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  )
+               CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
+               CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
+            ELSE                                     ! start rheology from rest
+               IF(lwp) WRITE(numout,*) '   ==>>   previous run without rheology, set stresses to 0'
+               stress1_i (:,:) = 0._wp
+               stress2_i (:,:) = 0._wp
+               stress12_i(:,:) = 0._wp
+            ENDIF
+         ELSE                                   !* Start from rest
+            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set stresses to 0'
+            stress1_i (:,:) = 0._wp
+            stress2_i (:,:) = 0._wp
+            stress12_i(:,:) = 0._wp
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- rhg-rst ----'
+         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1
+         !
+         CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  )
+         CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  )
+         CALL iom_rstput( iter, nitrst, numriw, 'stress12_i', stress12_i )
+         !
+      ENDIF
+      !
+   END SUBROUTINE rhg_evp_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!==============================================================================
+END MODULE icedyn_rhg_evp
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90	(revision 8586)
@@ -0,0 +1,318 @@
+MODULE iceforcing
+   !!======================================================================
+   !!                       ***  MODULE  iceforcing  ***
+   !! Sea-Ice :   air-ice forcing fields
+   !!=====================================================================
+   !! History :  4.0  ! 2017-08  (C. Rousset) Original code
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                     ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ice            ! sea-ice: variables
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice   fields
+   USE usrdef_sbc     ! Surface boundary condition: user defined
+   USE sbcblk         ! Surface boundary condition: bulk
+   USE sbccpl         ! Surface boundary condition: coupled interface
+   USE icealb         ! sae-ice: albedo
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ice_forcing_tau   ! called by icestp.F90
+   PUBLIC ice_forcing_flx   ! called by icestp.F90
+   PUBLIC ice_forcing_init  ! called by icestp.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , UCL NEMO Consortium (2017)
+   !! $Id: icestp.F90 8319 2017-07-11 15:00:44Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_forcing_tau( kt, ksbc, utau_ice, vtau_ice )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_forcing_tau  ***
+      !!
+      !! ** Purpose : provide surface boundary condition for sea ice (momentum)
+      !!
+      !! ** Action  : It provides the following fields:
+      !!              utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2]
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   ksbc    ! type of sbc flux ( 1 = user defined formulation, 
+                                       !                    3 = bulk formulation,
+                                       !                    4 = Pure Coupled formulation)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   utau_ice, vtau_ice 
+      !!
+      INTEGER  ::   ji, jj                 ! dummy loop index
+      REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice 
+      !!-------------------------------------------------------------------
+
+      IF( nn_timing == 1 )   CALL timing_start('ice_forcing')
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'ice_forcing_tau: Surface boundary condition for sea ice (momentum)'
+         WRITE(numout,*)'~~~~~~~~~~~~~~~'
+      ENDIF
+
+      SELECT CASE( ksbc )
+         CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation
+         CASE( jp_blk     )   ;    CALL blk_ice_tau                              ! Bulk formulation
+         CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation
+      END SELECT
+
+      IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation
+                                   CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
+               vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
+            END DO
+         END DO
+         CALL lbc_lnk_multi( utau_ice, 'U', -1., vtau_ice, 'V', -1. )
+      ENDIF
+
+      IF( nn_timing == 1 )   CALL timing_stop('ice_forcing')
+      !
+   END SUBROUTINE ice_forcing_tau
+
+   
+   SUBROUTINE ice_forcing_flx( kt, ksbc )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_forcing_flx  ***
+      !!
+      !! ** Purpose : provide surface boundary condition for sea ice (flux)
+      !!
+      !! ** Action  : It provides the following fields used in sea ice model:
+      !!                fr1_i0  , fr2_i0                         = 1sr & 2nd fraction of qsr penetration in ice  [%]
+      !!                emp_oce , emp_ice                        = E-P over ocean and sea ice                    [Kg/m2/s]
+      !!                sprecip                                  = solid precipitation                           [Kg/m2/s]
+      !!                evap_ice                                 = sublimation                                   [Kg/m2/s]
+      !!                qsr_tot , qns_tot                        = solar & non solar heat flux (total)           [W/m2]
+      !!                qsr_ice , qns_ice                        = solar & non solar heat flux over ice          [W/m2]
+      !!                dqns_ice                                 = non solar  heat sensistivity                  [W/m2]
+      !!                qemp_oce, qemp_ice, qprec_ice, qevap_ice = sensible heat (associated with evap & precip) [W/m2]
+      !!            + some fields that are not used outside this module: 
+      !!                qla_ice                                  = latent heat flux over ice                     [W/m2]
+      !!                dqla_ice                                 = latent heat sensistivity                      [W/m2]
+      !!                tprecip                                  = total  precipitation                          [Kg/m2/s]
+      !!                alb_ice                                  = albedo above sea ice
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ocean time step
+      INTEGER, INTENT(in) ::   ksbc   ! flux formulation (user defined, bulk or Pure Coupled)
+      !
+      INTEGER  ::   ji, jj, jl                                ! dummy loop index
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zalb              ! 2D workspace
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ice_forcing')
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'ice_forcing_flx: Surface boundary condition for sea ice (flux)'
+         WRITE(numout,*)'~~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! --- cloud-sky and overcast-sky ice albedos --- !
+      CALL ice_alb( t_su, h_i, h_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os )
+
+      ! albedo depends on cloud fraction because of non-linear spectral effects
+!!gm cldf_ice is a real, DOCTOR naming rule: start with cd means CHARACTER passed in argument !
+      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+      
+      SELECT CASE( ksbc )      !==  fluxes over sea ice  ==!
+      !
+      CASE( jp_usr )                !--- user defined formulation
+                                CALL usrdef_sbc_ice_flx( kt )
+         !
+      CASE( jp_blk )                !--- bulk formulation
+                                CALL blk_ice_flx( t_su, alb_ice )    ! 
+         IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su )
+         IF( nn_iceflx /= 2 )   CALL ice_flx_dist( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_iceflx )
+         !
+      CASE ( jp_purecpl )           !--- coupled formulation
+                                CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su )
+         IF( nn_iceflx == 2 )   CALL ice_flx_dist( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_iceflx )
+         !
+      END SELECT
+
+      IF( iom_use('icealb') ) THEN    !--- output ice albedo
+         WHERE( at_i_b <= epsi06 )   ;   zalb(:,:) = rn_alb_oce
+         ELSEWHERE                   ;   zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b
+         END WHERE
+         CALL iom_put( "icealb" , zalb(:,:) )   ! ice albedo
+      ENDIF
+
+      IF( iom_use('albedo') ) THEN  !--- surface albedo
+         zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b )
+         CALL iom_put( "albedo" , zalb(:,:) )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('ice_forcing')
+      !
+   END SUBROUTINE ice_forcing_flx
+
+
+   SUBROUTINE ice_flx_dist( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_iceflx )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_flx_dist  ***
+      !!
+      !! ** Purpose :   update the ice surface boundary condition by averaging 
+      !!              and/or redistributing fluxes on ice categories
+      !!
+      !! ** Method  :   average then redistribute
+      !!
+      !! ** Action  :   depends on k_iceflx
+      !!                = -1  Do nothing (needs N(cat) fluxes)
+      !!                =  0  Average N(cat) fluxes then apply the average over the N(cat) ice 
+      !!                =  1  Average N(cat) fluxes then redistribute over the N(cat) ice
+      !!                                                 using T-ice and albedo sensitivity
+      !!                =  2  Redistribute a single flux over categories
+      !!-------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   k_iceflx   ! redistributor
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqns_ice   ! non solar flux
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pevap_ice  ! sublimation
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity
+      !
+      INTEGER  ::   jl      ! dummy loop index
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::   z1_at_i   ! inverse of concentration
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_qsr_m   ! Mean solar heat flux over all categories
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_qns_m   ! Mean non solar heat flux over all categories
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_evap_m  ! Mean sublimation over all categories
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_dqn_m   ! Mean d(qns)/dT over all categories
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_devap_m ! Mean d(evap)/dT over all categories
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zalb_m    ! Mean albedo over all categories
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztem_m    ! Mean temperature over all categories
+      !!----------------------------------------------------------------------
+      !
+      WHERE ( at_i (:,:) > 0._wp )   ; z1_at_i(:,:) = 1._wp / at_i (:,:)
+      ELSEWHERE                      ; z1_at_i(:,:) = 0._wp
+      END WHERE
+      
+      SELECT CASE( k_iceflx )       !==  averaged on all ice categories  ==!
+      !
+      CASE( 0 , 1 )
+         !
+         ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) )  
+         !
+         z_qns_m  (:,:) = SUM( a_i(:,:,:) * pqns_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:)
+         z_qsr_m  (:,:) = SUM( a_i(:,:,:) * pqsr_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:)
+         z_dqn_m  (:,:) = SUM( a_i(:,:,:) * pdqn_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:)
+         z_evap_m (:,:) = SUM( a_i(:,:,:) * pevap_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
+         z_devap_m(:,:) = SUM( a_i(:,:,:) * pdevap_ice(:,:,:) , dim=3 ) * z1_at_i(:,:)
+         DO jl = 1, jpl
+            pqns_ice  (:,:,jl) = z_qns_m (:,:)
+            pqsr_ice  (:,:,jl) = z_qsr_m (:,:)
+            pdqn_ice  (:,:,jl) = z_dqn_m  (:,:)
+            pevap_ice (:,:,jl) = z_evap_m(:,:)
+            pdevap_ice(:,:,jl) = z_devap_m(:,:)
+         END DO
+         !
+         DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m )  
+         !
+      END SELECT
+      !
+      SELECT CASE( k_iceflx )       !==  redistribution on all ice categories  ==!
+      !
+      CASE( 1 , 2 )
+         !
+         ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) )  
+         !
+         zalb_m(:,:) = SUM( a_i(:,:,:) * palb_ice(:,:,:) , dim=3 ) * z1_at_i(:,:)
+         ztem_m(:,:) = SUM( a_i(:,:,:) * ptn_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
+         DO jl = 1, jpl
+            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
+            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
+            pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )
+         END DO
+         !
+         DEALLOCATE( zalb_m, ztem_m )  
+         !
+      END SELECT
+      !
+   END SUBROUTINE ice_flx_dist
+
+   SUBROUTINE ice_forcing_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_forcing_init  ***
+      !!
+      !! ** Purpose : Physical constants and parameters linked to the ice
+      !!      dynamics
+      !!
+      !! ** Method  :  Read the namforcing namelist and check the ice-dynamic
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namforcing
+      !!-------------------------------------------------------------------
+      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namforcing/ rn_cio, rn_blow_s, nn_iceflx
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )         ! Namelist namforcing in reference namelist : Ice dynamics
+      READ  ( numnam_ice_ref, namforcing, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namforcing in reference namelist', lwp )
+      !
+      REWIND( numnam_ice_cfg )         ! Namelist namforcing in configuration namelist : Ice dynamics
+      READ  ( numnam_ice_cfg, namforcing, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namforcing in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namforcing )
+      !
+      IF(lwp) THEN                     ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_forcing_init: ice parameters for ice dynamics '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namforcing:'
+         WRITE(numout,*) '      drag coefficient for oceanic stress              rn_cio    = ', rn_cio
+         WRITE(numout,*) '      coefficient for ice-lead partition of snowfall   rn_blow_s = ', rn_blow_s
+         WRITE(numout,*) '      Multicategory heat flux formulation              nn_iceflx = ', nn_iceflx
+      ENDIF
+      !
+      IF(lwp) WRITE(numout,*)
+      SELECT CASE( nn_iceflx )         ! ESIM Multi-category heat flux formulation
+      CASE( -1  )
+         IF(lwp) WRITE(numout,*) '   ESIM: use per-category fluxes (nn_iceflx = -1) '
+         IF( ln_cpl )   CALL ctl_stop( 'ice_thd_init : the chosen nn_iceflx for ESIM in coupled mode must be 0 or 2' )
+      CASE(  0  )
+         IF(lwp) WRITE(numout,*) '   ESIM: use average per-category fluxes (nn_iceflx = 0) '
+      CASE(  1  )
+         IF(lwp) WRITE(numout,*) '   ESIM: use average then redistribute per-category fluxes (nn_iceflx = 1) '
+         IF( ln_cpl )   CALL ctl_stop( 'ice_thd_init : the chosen nn_iceflx for ESIM in coupled mode must be 0 or 2' )
+      CASE(  2  )
+         IF(lwp) WRITE(numout,*) '   ESIM: Redistribute a single flux over categories (nn_iceflx = 2) '
+         IF( .NOT. ln_cpl )   CALL ctl_stop( 'ice_thd_init : the chosen nn_iceflx for ESIM in forced mode cannot be 2' )
+      CASE DEFAULT
+         CALL ctl_stop( 'ice_thd_init: ESIM option, nn_iceflx, should be between -1 and 2' )
+      END SELECT
+      !
+   END SUBROUTINE ice_forcing_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE iceforcing
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90	(revision 8586)
@@ -0,0 +1,583 @@
+MODULE iceistate
+   !!======================================================================
+   !!                     ***  MODULE  iceistate  ***
+   !!   sea-ice : Initialization of ice variables
+   !!======================================================================
+   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
+   !!            3.0  ! 2007    (M. Vancoppenolle)  Rewrite for ice cats
+   !!            3.0  ! 2009-11 (M. Vancoppenolle)  Enhanced version for ice cats
+   !!            3.0  ! 2011-02 (G. Madec)  dynamical allocation
+   !!             -   ! 2014    (C. Rousset)  add N/S initializations
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_istate       :  initialization of diagnostics ice variables
+   !!   ice_istate_init  :  initialization of ice state and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constant
+   USE oce            ! dynamics and tracers variables
+   USE dom_oce        ! ocean domain
+   USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd 
+   USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b
+   USE eosbn2         ! equation of state
+   USE domvvl         ! Variable volume
+   USE ice            ! sea-ice variables
+   USE icevar         ! ice_var_salprof
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE fldread        ! read input fields
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_istate        ! called by icestp.F90
+   PUBLIC   ice_istate_init   ! called by icestp.F90
+
+   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read
+   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point
+   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snow thicknes (m)    at T-point
+   INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction (%) at T-point
+   INTEGER , PARAMETER ::   jp_tsu = 4           ! index of ice surface temp (K)    at T-point
+   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point
+   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read)
+   !
+   ! ** namelist (namini) **
+   LOGICAL  ::   ln_iceini        ! initialization or not
+   LOGICAL  ::   ln_iceini_file   ! Ice initialization state from 2D netcdf file
+   REAL(wp) ::   rn_thres_sst     ! threshold water temperature for initial sea ice
+   REAL(wp) ::   rn_hts_ini_n     ! initial snow thickness in the north
+   REAL(wp) ::   rn_hts_ini_s     ! initial snow thickness in the south
+   REAL(wp) ::   rn_hti_ini_n     ! initial ice thickness in the north
+   REAL(wp) ::   rn_hti_ini_s     ! initial ice thickness in the south
+   REAL(wp) ::   rn_ati_ini_n     ! initial leads area in the north
+   REAL(wp) ::   rn_ati_ini_s     ! initial leads area in the south
+   REAL(wp) ::   rn_smi_ini_n     ! initial salinity 
+   REAL(wp) ::   rn_smi_ini_s     ! initial salinity
+   REAL(wp) ::   rn_tmi_ini_n     ! initial temperature
+   REAL(wp) ::   rn_tmi_ini_s     ! initial temperature
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: iceistate.F90 8378 2017-07-26 13:55:59Z clem $
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_istate
+      !!-------------------------------------------------------------------
+      !!                    ***  ROUTINE ice_istate  ***
+      !!
+      !! ** Purpose :   defined the sea-ice initial state
+      !!
+      !! ** Method  :   This routine will put some ice where ocean
+      !!                is at the freezing point, then fill in ice 
+      !!                state variables using prescribed initial 
+      !!                values in the namelist            
+      !!
+      !! ** Steps   :   1) Set initial surface and basal temperatures
+      !!                2) Recompute or read sea ice state variables
+      !!                3) Fill in the ice thickness distribution using gaussian
+      !!                4) Fill in space-dependent arrays for state variables
+      !!                5) snow-ice mass computation
+      !!                6) store before fields
+      !!
+      !! ** Notes   : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even
+      !!              where there is no ice (clem: I do not know why, is it mandatory?) 
+      !!--------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      REAL(wp) ::   ztmelts, zdh
+      INTEGER  ::   i_hemis, i_fill, jl0
+      REAL(wp) ::   zarg, zV, zconv, zdv
+      INTEGER , DIMENSION(4)           ::   itest
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zswitch    ! ice indicator
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zh_i_ini, za_i_ini                         !data by cattegories to fill
+      !--------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ice_istate: sea-ice initialization '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      !--------------------------------------------------------------------
+      ! 1) Set surface and bottom temperatures to initial values
+      !--------------------------------------------------------------------
+      !
+      ! init surface temperature
+      DO jl = 1, jpl
+         t_su  (:,:,jl) = rt0 * tmask(:,:,1)
+         tn_ice(:,:,jl) = rt0 * tmask(:,:,1)
+      END DO
+
+      ! init basal temperature (considered at freezing point)
+      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
+      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
+
+      IF( ln_iceini ) THEN
+         !-----------------------------------------------------------
+         ! 2) Compute or read sea ice variables ===> single category
+         !-----------------------------------------------------------
+         !
+         !                             !---------------!
+         IF( ln_iceini_file )THEN      ! Read a file   !
+            !                          !---------------!
+            !
+            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1)
+            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1)
+            zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1)
+            zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1)
+            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1)
+            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1)
+            !
+            WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 
+            ELSEWHERE                       ; zswitch(:,:) = 0._wp
+            END WHERE
+            zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)
+            !
+         !                             !---------------!
+         ELSE                          ! Read namelist !
+            !                          !---------------!
+
+           ! no ice if sst <= t-freez + ttest
+            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 
+            ELSEWHERE                                                                  ; zswitch(:,:) = tmask(:,:,1)
+            END WHERE
+
+            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
+            WHERE( ff_t(:,:) >= 0._wp )
+               zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:)
+               zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:)
+               zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:)
+               zts_u_ini(:,:) = rn_tmi_ini_n * zswitch(:,:)
+               zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:)
+               ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:)
+            ELSEWHERE
+               zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:)
+               zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:)
+               zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:)
+               zts_u_ini(:,:) = rn_tmi_ini_s * zswitch(:,:)
+               zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:)
+               ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:)
+            END WHERE
+            zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)
+            !
+         ENDIF
+         
+         !------------------------------------------------------------------
+         ! 3) Distribute ice concentration and thickness into the categories
+         !------------------------------------------------------------------
+         ! a gaussian distribution for ice concentration is used
+         ! then we check whether the distribution fullfills
+         ! volume and area conservation, positivity and ice categories bounds
+         zh_i_ini(:,:,:) = 0._wp 
+         za_i_ini(:,:,:) = 0._wp
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN
+
+                  ! find which category (jl0) the input ice thickness falls into
+                  jl0 = jpl
+                  DO jl = 1, jpl
+                     IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN
+                        jl0 = jl
+                        CYCLE
+                     ENDIF
+                  END DO
+                  !
+                  itest(:) = 0
+                  i_fill   = jpl + 1                                            !------------------------------------
+                  DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )   ! iterative loop on i_fill categories
+                     !                                                          !------------------------------------
+                     i_fill = i_fill - 1
+                     !
+                     zh_i_ini(ji,jj,:) = 0._wp 
+                     za_i_ini(ji,jj,:) = 0._wp
+                     itest(:) = 0
+                     !
+                     IF ( i_fill == 1 ) THEN      !-- case very thin ice: fill only category 1
+                        zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj)
+                        za_i_ini(ji,jj,1) = zat_i_ini(ji,jj)
+                     ELSE                         !-- case ice is thicker: fill categories >1
+                        ! thickness
+                        DO jl = 1, i_fill-1
+                           zh_i_ini(ji,jj,jl) = hi_mean(jl)
+                        END DO
+                        !
+                        ! concentration
+                        za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl))
+                        DO jl = 1, i_fill - 1
+                           IF( jl /= jl0 )THEN
+                              zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) )
+                              za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2)
+                           ENDIF
+                        END DO
+
+                        ! last category
+                        za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) )
+                        zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) )
+                        zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 
+
+                        ! clem: correction if concentration of upper cat is greater than lower cat
+                        !       (it should be a gaussian around jl0 but sometimes it is not)
+                        IF ( jl0 /= jpl ) THEN
+                           DO jl = jpl, jl0+1, -1
+                              IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN
+                                 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl)
+                                 zh_i_ini(ji,jj,jl    ) = 0._wp
+                                 za_i_ini(ji,jj,jl    ) = 0._wp
+                                 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  &
+                                    &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 )
+                              END IF
+                           ENDDO
+                        ENDIF
+                        !
+                     ENDIF
+
+                     ! Compatibility tests
+                     zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) )           ! Test 1: area conservation
+                     IF ( zconv < epsi06 ) itest(1) = 1
+                     
+                     zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   &         ! Test 2: volume conservation
+                        &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) )
+                     IF ( zconv < epsi06 ) itest(2) = 1
+                     
+                     IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1           ! Test 3: thickness of the last category is in-bounds ?
+                     
+                     itest(4) = 1
+                     DO jl = 1, i_fill
+                        IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0                        ! Test 4: positivity of ice concentrations
+                     END DO
+                     !                                                          !----------------------------
+                  END DO                                                        ! end iteration on categories
+                  !                                                             !----------------------------
+                  !
+                  IF( lwp .AND. SUM(itest) /= 4 ) THEN 
+                     WRITE(numout,*)
+                     WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! '
+                     WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
+                     WRITE(numout,*)
+                     WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:)
+                     WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj)
+                     WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj)
+                  ENDIF
+               
+               ENDIF
+               !
+            END DO   
+         END DO   
+
+         !---------------------------------------------------------------------
+         ! 4) Fill in sea ice arrays
+         !---------------------------------------------------------------------
+
+         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
+         DO jl = 1, jpl ! loop over categories
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  a_i(ji,jj,jl)  = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration
+                  h_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness
+                  s_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity
+                  o_i(ji,jj,jl)  = 0._wp                                                     ! age (0 day)
+                  t_su(ji,jj,jl) = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
+
+                  IF( zht_i_ini(ji,jj) > 0._wp )THEN
+                    h_s(ji,jj,jl)= h_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth
+                  ELSE
+                    h_s(ji,jj,jl)= 0._wp
+                  ENDIF
+
+                  ! This case below should not be used if (h_s/h_i) is ok in namelist
+                  ! In case snow load is in excess that would lead to transformation from snow to ice
+                  ! Then, transfer the snow excess into the ice (different from icethd_dh)
+                  zdh = MAX( 0._wp, ( rhosn * h_s(ji,jj,jl) + ( rhoic - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 ) 
+                  ! recompute h_i, h_s avoiding out of bounds values
+                  h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh )
+                  h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
+
+                  ! ice volume, salt content, age content
+                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
+                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
+                  sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
+                  oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
+               END DO
+            END DO
+         END DO
+
+         ! for constant salinity in time
+         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
+            CALL ice_var_salprof
+            sv_i = s_i * v_i
+         ENDIF
+            
+         ! Snow temperature and heat content
+         DO jk = 1, nlay_s
+            DO jl = 1, jpl ! loop over categories
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0
+                     ! Snow energy of melting
+                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+
+                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
+                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         ! Ice salinity, temperature and heat content
+         DO jk = 1, nlay_i
+            DO jl = 1, jpl ! loop over categories
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     t_i (ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
+                     sz_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin
+                     ztmelts          = - tmut * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
+
+                     ! heat content per unit volume
+                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
+                        +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+                        -   rcp     * ( ztmelts - rt0 ) )
+
+                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         tn_ice (:,:,:) = t_su (:,:,:)
+
+         ! MV MP 2016
+         ! Melt pond volume and fraction
+         IF ( ln_pnd ) THEN
+            DO jl = 1, jpl
+               a_ip_frac(:,:,jl) = 0.2 *  zswitch(:,:)
+               h_ip     (:,:,jl) = 0.05 * zswitch(:,:)
+               a_ip(:,:,jl)      = a_ip_frac(:,:,jl) * a_i (:,:,jl) 
+               v_ip(:,:,jl)      = h_ip     (:,:,jl) * a_ip(:,:,jl)
+            END DO
+         ELSE
+            a_ip(:,:,:)      = 0._wp
+            v_ip(:,:,:)      = 0._wp
+            a_ip_frac(:,:,:) = 0._wp
+            h_ip     (:,:,:) = 0._wp
+         ENDIF
+         ! END MV MP 2016
+
+      ELSE ! if ln_iceini=false
+         a_i  (:,:,:) = 0._wp
+         v_i  (:,:,:) = 0._wp
+         v_s  (:,:,:) = 0._wp
+         sv_i (:,:,:) = 0._wp
+         oa_i (:,:,:) = 0._wp
+         h_i  (:,:,:) = 0._wp
+         h_s  (:,:,:) = 0._wp
+         s_i  (:,:,:) = 0._wp
+         o_i  (:,:,:) = 0._wp
+
+         e_i(:,:,:,:) = 0._wp
+         e_s(:,:,:,:) = 0._wp
+
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
+            END DO
+            DO jk = 1, nlay_s
+               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
+            END DO
+         END DO
+
+         a_ip(:,:,:)      = 0._wp
+         v_ip(:,:,:)      = 0._wp
+         a_ip_frac(:,:,:) = 0._wp
+         h_ip     (:,:,:) = 0._wp
+
+      ENDIF ! ln_iceini
+      
+      at_i (:,:) = 0.0_wp
+      DO jl = 1, jpl
+         at_i (:,:) = at_i (:,:) + a_i (:,:,jl)
+      END DO
+      !
+      ! --- set ice velocities --- !
+      u_ice (:,:)     = 0._wp
+      v_ice (:,:)     = 0._wp
+      !
+      !----------------------------------------------
+      ! 5) Snow-ice mass (case ice is fully embedded)
+      !----------------------------------------------
+      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhosn * v_s(:,:,:) + rhoic * v_i(:,:,:), dim=3  )   ! snow+ice mass
+      snwice_mass_b(:,:) = snwice_mass(:,:)
+      !
+      IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area
+
+         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
+         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+
+         IF( .NOT.ln_linssh ) THEN
+            
+            WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + sshn(:,:)*tmask(:,:,1) / ht_0(:,:)
+            ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE
+         
+            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors                
+               e3t_n(:,:,jk) = e3t_0(:,:,jk) * z2d(:,:)
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+               e3t_a(:,:,jk) = e3t_n(:,:,jk)
+            END DO
+            
+            ! Reconstruction of all vertical scale factors at now and before time-steps
+            ! =========================================================================
+            ! Horizontal scale factor interpolations
+            ! --------------------------------------
+            CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+            CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+            CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+            ! Vertical scale factor interpolations
+            ! ------------------------------------
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+            CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+            CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+            ! t- and w- points depth
+            ! ----------------------
+            !!gm not sure of that....
+            gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+            gdepw_n(:,:,1) = 0.0_wp
+            gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+            DO jk = 2, jpk
+               gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk  )
+               gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
+               gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn (:,:)
+            END DO
+         ENDIF
+      ENDIF
+      
+      !------------------------------------
+      ! 6) store fields at before time-step
+      !------------------------------------
+      ! it is only necessary for the 1st interpolation by Agrif
+      a_i_b  (:,:,:)   = a_i  (:,:,:)
+      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)
+      v_i_b  (:,:,:)   = v_i  (:,:,:)
+      v_s_b  (:,:,:)   = v_s  (:,:,:)
+      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)
+      sv_i_b (:,:,:)   = sv_i (:,:,:)
+      oa_i_b (:,:,:)   = oa_i (:,:,:)
+      u_ice_b(:,:)     = u_ice(:,:)
+      v_ice_b(:,:)     = v_ice(:,:)
+
+!!!clem
+!!      ! Output the initial state and forcings
+!!      CALL dia_wri_state( 'output.init', nit000 )
+!!!      
+
+   END SUBROUTINE ice_istate
+
+   SUBROUTINE ice_istate_init
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_istate_init  ***
+      !!        
+      !! ** Purpose : Definition of initial state of the ice 
+      !!
+      !! ** Method : Read the namini namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input : 
+      !!        Namelist namini
+      !!
+      !! history :
+      !!  8.5  ! 03-08 (C. Ethe) original code 
+      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
+      !!-----------------------------------------------------------------------------
+      !
+      INTEGER :: ios,ierr,inum_ice                 ! Local integer output status for namelist read
+      INTEGER :: ji,jj
+      INTEGER :: ifpr, ierror
+      !
+      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files
+      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi
+      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read
+      !
+      NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  &
+         &             rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, &
+         &             rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             &
+         &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir
+      !!-----------------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namini in reference namelist : Ice initial state
+      READ  ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namini in configuration namelist : Ice initial state
+      READ  ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namini )
+
+      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts
+      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu
+      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi
+      !
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_istate_init: ice parameters inititialisation '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namini:'
+         WRITE(numout,*) '      initialization with ice (T) or not (F)                 ln_iceini       = ', ln_iceini
+         WRITE(numout,*) '      ice initialization from a netcdf file                  ln_iceini_file  = ', ln_iceini_file
+         WRITE(numout,*) '      max delta ocean temp. above Tfreeze with initial ice   rn_thres_sst    = ', rn_thres_sst
+         WRITE(numout,*) '      initial snow thickness in the north                    rn_hts_ini_n    = ', rn_hts_ini_n
+         WRITE(numout,*) '      initial snow thickness in the south                    rn_hts_ini_s    = ', rn_hts_ini_s 
+         WRITE(numout,*) '      initial ice thickness  in the north                    rn_hti_ini_n    = ', rn_hti_ini_n
+         WRITE(numout,*) '      initial ice thickness  in the south                    rn_hti_ini_s    = ', rn_hti_ini_s
+         WRITE(numout,*) '      initial ice concentr.  in the north                    rn_ati_ini_n    = ', rn_ati_ini_n
+         WRITE(numout,*) '      initial ice concentr.  in the north                    rn_ati_ini_s    = ', rn_ati_ini_s
+         WRITE(numout,*) '      initial  ice salinity  in the north                    rn_smi_ini_n    = ', rn_smi_ini_n
+         WRITE(numout,*) '      initial  ice salinity  in the south                    rn_smi_ini_s    = ', rn_smi_ini_s
+         WRITE(numout,*) '      initial  ice/snw temp  in the north                    rn_tmi_ini_n    = ', rn_tmi_ini_n
+         WRITE(numout,*) '      initial  ice/snw temp  in the south                    rn_tmi_ini_s    = ', rn_tmi_ini_s
+      ENDIF
+
+      IF( ln_iceini_file ) THEN                      ! Ice initialization using input file
+         !
+         ! set si structure
+         ALLOCATE( si(jpfldi), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'Ice_ini in iceistate: unable to allocate si structure' )   ;   RETURN
+         ENDIF
+
+         DO ifpr = 1, jpfldi
+            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
+            ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
+         END DO
+
+         ! fill si with slf_i and control print
+         CALL fld_fill( si, slf_i, cn_dir, 'ice_istate', 'ice istate ini', 'numnam_ice' )
+
+         CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step
+
+      ENDIF
+
+   END SUBROUTINE ice_istate_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE iceistate
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90	(revision 8586)
@@ -0,0 +1,701 @@
+MODULE iceitd
+   !!======================================================================
+   !!                       ***  MODULE iceitd ***
+   !!   sea-ice : ice thickness distribution
+   !!======================================================================
+   !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code
+   !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3
+   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age
+   !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_itd_init   : read ice thicknesses mean and min from namelist
+   !!   ice_itd_rem    : redistribute ice thicknesses after thermo growth and melt
+   !!   ice_itd_reb    : rebin ice thicknesses into bounded categories
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE phycst         ! physical constants 
+   USE ice1D          ! sea-ice: thermodynamic variables
+   USE ice            ! sea-ice: variables
+   USE icectl         ! sea-ice: conservation tests
+   USE icetab         ! sea-ice: convert 1D<=>2D
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE prtctl         ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_itd_init  ! called in icestp
+   PUBLIC   ice_itd_rem   ! called in icethd
+   PUBLIC   ice_itd_reb   ! called in icecor
+
+   ! ** namelist (namitd) **
+   REAL(wp) ::   rn_himean   ! mean thickness of the domain
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: iceitd.F90 8420 2017-08-08 12:18:46Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_itd_rem( kt )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE ice_itd_rem ***
+      !!
+      !! ** Purpose :   computes the redistribution of ice thickness
+      !!                after thermodynamic growth of ice thickness
+      !!
+      !! ** Method  :   Linear remapping 
+      !!
+      !! References :   W.H. Lipscomb, JGR 2001
+      !!------------------------------------------------------------------
+      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
+      !
+      INTEGER  ::   ji, jj, jl, jcat     ! dummy loop index
+      INTEGER  ::   ipti                 ! local integer
+      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
+      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      -
+      REAL(wp) ::   zx3        
+      REAL(wp) ::   zslope          ! used to compute local thermodynamic "speeds"
+
+      INTEGER , DIMENSION(jpij)       ::   iptidx          ! compute remapping or not
+      INTEGER , DIMENSION(jpij,jpl-1) ::   jdonor          ! donor category index
+      REAL(wp), DIMENSION(jpij,jpl)   ::   zdhice          ! ice thickness increment
+      REAL(wp), DIMENSION(jpij,jpl)   ::   g0, g1          ! coefficients for fitting the line of the ITD
+      REAL(wp), DIMENSION(jpij,jpl)   ::   hL, hR          ! left and right boundary for the ITD for each thickness
+      REAL(wp), DIMENSION(jpij,jpl-1) ::   zdaice, zdvice  ! local increment of ice area and volume
+      REAL(wp), DIMENSION(jpij)       ::   zhb0, zhb1      ! category boundaries for thinnes categories
+      REAL(wp), DIMENSION(jpij,0:jpl) ::   zhbnew          ! new boundaries of ice categories
+      !!------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution' 
+
+      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
+
+      !-----------------------------------------------------------------------------------------------
+      !  1) Identify grid cells with ice
+      !-----------------------------------------------------------------------------------------------
+      npti = 0   ;   nptidx(:) = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( at_i(ji,jj) > epsi10 ) THEN
+               npti         = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+      
+      !-----------------------------------------------------------------------------------------------
+      !  2) Compute new category boundaries
+      !-----------------------------------------------------------------------------------------------
+      IF( npti > 0 ) THEN
+
+         zdhice(:,:) = 0._wp
+         zhbnew(:,:) = 0._wp
+
+         CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i   )
+         CALL tab_3d_2d( npti, nptidx(1:npti), h_ib_2d(1:npti,1:jpl), h_i_b )
+         CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d  (1:npti,1:jpl), a_i    )
+         CALL tab_3d_2d( npti, nptidx(1:npti), a_ib_2d (1:npti,1:jpl), a_i_b  )
+
+         DO jl = 1, jpl
+            ! Compute thickness change in each ice category
+            DO ji = 1, npti
+               zdhice(ji,jl) = h_i_2d(ji,jl) - h_ib_2d(ji,jl)
+            END DO
+         END DO
+         
+         ! --- New boundaries for category 1:jpl-1 --- !
+         DO jl = 1, jpl - 1
+            !
+            DO ji = 1, npti
+               !
+               ! --- New boundary: Hn* = Hn + Fn*dt --- !
+               !     Fn*dt = ( fn + (fn+1 - fn)/(hn+1 - hn) * (Hn - hn) ) * dt = zdhice + zslope * (Hmax - h_i_b)
+               !
+               IF    ( a_ib_2d(ji,jl) >  epsi10 .AND. a_ib_2d(ji,jl+1) >  epsi10 ) THEN   ! a(jl+1) & a(jl) /= 0
+                  zslope           = ( zdhice(ji,jl+1) - zdhice(ji,jl) ) / ( h_ib_2d(ji,jl+1) - h_ib_2d(ji,jl) )
+                  zhbnew(ji,jl) = hi_max(jl) + zdhice(ji,jl) + zslope * ( hi_max(jl) - h_ib_2d(ji,jl) )
+               ELSEIF( a_ib_2d(ji,jl) >  epsi10 .AND. a_ib_2d(ji,jl+1) <= epsi10 ) THEN   ! a(jl+1)=0 => Hn* = Hn + fn*dt
+                  zhbnew(ji,jl) = hi_max(jl) + zdhice(ji,jl)
+               ELSEIF( a_ib_2d(ji,jl) <= epsi10 .AND. a_ib_2d(ji,jl+1) >  epsi10 ) THEN   ! a(jl)=0 => Hn* = Hn + fn+1*dt
+                  zhbnew(ji,jl) = hi_max(jl) + zdhice(ji,jl+1)
+               ELSE                                                                       ! a(jl+1) & a(jl) = 0 
+                  zhbnew(ji,jl) = hi_max(jl)
+               ENDIF
+               !
+               ! --- 2 conditions for remapping --- !
+               ! 1) hn(t+1)+espi < Hn* < hn+1(t+1)-epsi               
+               !    Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 
+               !          in ice_itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+               IF( a_i_2d(ji,jl  ) > epsi10 .AND. h_i_2d(ji,jl  ) > ( zhbnew(ji,jl) - epsi10 ) )   nptidx(ji) = 0
+               IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi10 ) )   nptidx(ji) = 0
+               
+               ! 2) Hn-1 < Hn* < Hn+1  
+               IF( zhbnew(ji,jl) < hi_max(jl-1) )   nptidx(ji) = 0
+               IF( zhbnew(ji,jl) > hi_max(jl+1) )   nptidx(ji) = 0
+               
+            END DO
+         END DO
+         !
+         ! --- New boundaries for category jpl --- !
+         DO ji = 1, npti
+            IF( a_i_2d(ji,jpl) > epsi10 ) THEN
+               zhbnew(ji,jpl) = MAX( hi_max(jpl-1), 3._wp * h_i_2d(ji,jpl) - 2._wp * zhbnew(ji,jpl-1) )
+            ELSE
+               zhbnew(ji,jpl) = hi_max(jpl)  
+            ENDIF
+            
+            ! --- 1 additional condition for remapping (1st category) --- !
+            ! H0+epsi < h1(t) < H1-epsi 
+            !    h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            !    in ice_itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+            IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi10 ) )   nptidx(ji) = 0
+            IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi10 ) )   nptidx(ji) = 0
+         END DO
+         !
+         !-----------------------------------------------------------------------------------------------
+         !  3) Identify cells where remapping
+         !-----------------------------------------------------------------------------------------------
+         ipti = 0 ; iptidx(:) = 0
+         DO ji = 1, npti
+            IF( nptidx(ji) /= 0 ) THEN
+               ipti = ipti + 1
+               iptidx(ipti)   = nptidx(ji)
+               zhbnew(ipti,:) = zhbnew(ji,:)  ! adjust zhbnew to new indices
+            ENDIF
+         END DO
+         nptidx(:) = iptidx(:)
+         npti      = ipti
+         !
+      ENDIF
+   
+      !-----------------------------------------------------------------------------------------------
+      !  4) Compute g(h) 
+      !-----------------------------------------------------------------------------------------------
+      IF( npti > 0 ) THEN
+         !
+         zhb0(:) = hi_max(0)   ;   zhb1(:) = hi_max(1)
+         g0(:,:) = 0._wp       ;   g1(:,:) = 0._wp 
+         hL(:,:) = 0._wp       ;   hR(:,:) = 0._wp 
+         !
+         DO jl = 1, jpl
+            !
+            CALL tab_2d_1d( npti, nptidx(1:npti), h_ib_1d(1:npti), h_i_b(:,:,jl) )
+            CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,jl)   )
+            CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i(:,:,jl)    )
+            CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d  (1:npti), v_i(:,:,jl)    )
+            !
+            IF( jl == 1 ) THEN
+               !  
+               ! --- g(h) for category 1 --- !
+               CALL ice_itd_glinear( zhb0(1:npti)  , zhb1(1:npti)  , h_ib_1d(1:npti)  , a_i_1d(1:npti)  ,  &   ! in
+                  &                  g0  (1:npti,1), g1  (1:npti,1), hL      (1:npti,1), hR    (1:npti,1)   )   ! out
+                  !
+               ! Area lost due to melting of thin ice
+               DO ji = 1, npti
+                  !
+                  IF( a_i_1d(ji) > epsi10 ) THEN
+                     !
+                     zdh0 =  h_i_1d(ji) - h_ib_1d(ji)                
+                     IF( zdh0 < 0.0 ) THEN      !remove area from category 1
+                        zdh0 = MIN( -zdh0, hi_max(1) )
+                        !Integrate g(1) from 0 to dh0 to estimate area melted
+                        zetamax = MIN( zdh0, hR(ji,1) ) - hL(ji,1)
+                        !
+                        IF( zetamax > 0.0 ) THEN
+                           zx1    = zetamax
+                           zx2    = 0.5 * zetamax * zetamax 
+                           zda0   = g1(ji,1) * zx2 + g0(ji,1) * zx1                        ! ice area removed
+                           zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i                
+                           zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting 
+                           !     of thin ice (zdamax > 0)
+                           ! Remove area, conserving volume
+                           h_i_1d(ji) = h_i_1d(ji) * a_i_1d(ji) / ( a_i_1d(ji) - zda0 )
+                           a_i_1d(ji)  = a_i_1d(ji) - zda0
+                           v_i_1d(ji)  = a_i_1d(ji) * h_i_1d(ji) ! clem-useless ?
+                        ENDIF
+                        !
+                     ELSE ! if ice accretion zdh0 > 0
+                        ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1)
+                        zhbnew(ji,0) = MIN( zdh0, hi_max(1) ) 
+                     ENDIF
+                     !
+                  ENDIF
+                  !
+               END DO
+               !
+               CALL tab_1d_2d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,jl)   )
+               CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i(:,:,jl)    )
+               CALL tab_1d_2d( npti, nptidx(1:npti), v_i_1d  (1:npti), v_i(:,:,jl)    )
+               !
+            ENDIF ! jl=1
+            !
+            ! --- g(h) for each thickness category --- !  
+            CALL ice_itd_glinear( zhbnew(1:npti,jl-1), zhbnew(1:npti,jl), h_i_1d(1:npti)   , a_i_1d(1:npti)   ,  &   ! in
+               &                  g0    (1:npti,jl  ), g1    (1:npti,jl), hL     (1:npti,jl), hR    (1:npti,jl)   )   ! out
+            !
+         END DO
+         
+         !-----------------------------------------------------------------------------------------------
+         !  5) Compute area and volume to be shifted across each boundary (Eq. 18)
+         !-----------------------------------------------------------------------------------------------
+         DO jl = 1, jpl - 1
+            !
+            DO ji = 1, npti
+               !
+               ! left and right integration limits in eta space
+               IF (zhbnew(ji,jl) > hi_max(jl)) THEN ! Hn* > Hn => transfer from jl to jl+1
+                  zetamin = MAX( hi_max(jl)   , hL(ji,jl) ) - hL(ji,jl)   ! hi_max(jl) - hL 
+                  zetamax = MIN( zhbnew(ji,jl), hR(ji,jl) ) - hL(ji,jl)   ! hR - hL
+                  jdonor(ji,jl) = jl
+               ELSE                                 ! Hn* <= Hn => transfer from jl+1 to jl
+                  zetamin = 0.0
+                  zetamax = MIN( hi_max(jl), hR(ji,jl+1) ) - hL(ji,jl+1)  ! hi_max(jl) - hL
+                  jdonor(ji,jl) = jl + 1
+               ENDIF
+               zetamax = MAX( zetamax, zetamin ) ! no transfer if etamax < etamin
+               !
+               zx1  = zetamax - zetamin
+               zwk1 = zetamin * zetamin
+               zwk2 = zetamax * zetamax
+               zx2  = 0.5 * ( zwk2 - zwk1 )
+               zwk1 = zwk1 * zetamin
+               zwk2 = zwk2 * zetamax
+               zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 )
+               jcat = jdonor(ji,jl)
+               zdaice(ji,jl) = g1(ji,jcat)*zx2 + g0(ji,jcat)*zx1
+               zdvice(ji,jl) = g1(ji,jcat)*zx3 + g0(ji,jcat)*zx2 + zdaice(ji,jl)*hL(ji,jcat)
+               !
+            END DO
+         END DO
+         
+         !----------------------------------------------------------------------------------------------
+         ! 6) Shift ice between categories
+         !----------------------------------------------------------------------------------------------
+         CALL ice_itd_shiftice ( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) )
+         
+         !----------------------------------------------------------------------------------------------
+         ! 7) Make sure h_i >= minimum ice thickness hi_min
+         !----------------------------------------------------------------------------------------------
+         CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,1)   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i(:,:,1)    )
+         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip(:,:,1)   )
+         
+         DO ji = 1, npti
+            IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN
+               a_i_1d (ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 
+               ! MV MP 2016
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin
+               ENDIF
+               ! END MV MP 2016
+               h_i_1d(ji) = rn_himin
+            ENDIF
+         END DO
+         !
+         CALL tab_1d_2d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,1)   )
+         CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i(:,:,1)    )
+         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip(:,:,1)   )
+         !
+      ENDIF
+      !
+      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
+      !
+   END SUBROUTINE ice_itd_rem
+
+
+   SUBROUTINE ice_itd_glinear( HbL, Hbr, phice, paice, pg0, pg1, phL, phR )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE ice_itd_glinear ***
+      !!
+      !! ** Purpose :   build g(h) satisfying area and volume constraints (Eq. 6 and 9)
+      !!
+      !! ** Method  :   g(h) is linear and written as: g(eta) = g1(eta) + g0
+      !!                with eta = h - HL
+      !!------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in   ) ::   HbL, HbR      ! left and right category boundaries
+      REAL(wp), DIMENSION(:), INTENT(in   ) ::   phice, paice  ! ice thickness and concentration
+      REAL(wp), DIMENSION(:), INTENT(inout) ::   pg0, pg1      ! coefficients in linear equation for g(eta)
+      REAL(wp), DIMENSION(:), INTENT(inout) ::   phL, phR      ! min and max value of range over which g(h) > 0
+      !
+      INTEGER  ::   ji           ! horizontal indices
+      REAL(wp) ::   z1_3 , z2_3  ! 1/3 , 2/3
+      REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL)
+      REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL)
+      REAL(wp) ::   zdhr         ! 1 / (hR - hL)
+      REAL(wp) ::   zwk1, zwk2   ! temporary variables
+      !!------------------------------------------------------------------
+      !
+      z1_3 = 1._wp / 3._wp
+      z2_3 = 2._wp / 3._wp
+      !
+      DO ji = 1, npti
+         !
+         IF( paice(ji) > epsi10  .AND. phice(ji) > 0._wp )  THEN
+            !
+            ! Initialize hL and hR
+            phL(ji) = HbL(ji)
+            phR(ji) = HbR(ji)
+            !
+            ! Change hL or hR if hice falls outside central third of range,
+            ! so that hice is in the central third of the range [HL HR]
+            zh13 = z1_3 * ( 2._wp * phL(ji) +         phR(ji) )
+            zh23 = z1_3 * (         phL(ji) + 2._wp * phR(ji) )
+            !
+            IF    ( phice(ji) < zh13 ) THEN   ;   phR(ji) = 3._wp * phice(ji) - 2._wp * phL(ji) ! move HR to the left
+            ELSEIF( phice(ji) > zh23 ) THEN   ;   phL(ji) = 3._wp * phice(ji) - 2._wp * phR(ji) ! move HL to the right
+            ENDIF
+            !
+            ! Compute coefficients of g(eta) = g0 + g1*eta
+            zdhr = 1._wp / (phR(ji) - phL(ji))
+            zwk1 = 6._wp * paice(ji) * zdhr
+            zwk2 = ( phice(ji) - phL(ji) ) * zdhr
+            pg0(ji) = zwk1 * ( z2_3 - zwk2 )                    ! Eq. 14
+            pg1(ji) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5_wp )   ! Eq. 14
+            !
+         ELSE  ! remap_flag = .false. or a_i < epsi10 
+            phL(ji) = 0._wp
+            phR(ji) = 0._wp
+            pg0(ji) = 0._wp
+            pg1(ji) = 0._wp
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE ice_itd_glinear
+
+
+   SUBROUTINE ice_itd_shiftice( kdonor, pdaice, pdvice )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE ice_itd_shiftice ***
+      !!
+      !! ** Purpose :   shift ice across category boundaries, conserving everything
+      !!              ( area, volume, energy, age*vol, and mass of salt )
+      !!------------------------------------------------------------------
+      INTEGER , DIMENSION(:,:), INTENT(in) ::   kdonor   ! donor category index
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pdaice   ! ice area transferred across boundary
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pdvice   ! ice volume transferred across boundary
+      !
+      INTEGER  ::   ji, jj, jl, jk     ! dummy loop indices
+      INTEGER  ::   ii, ij, jl2, jl1   ! local integers
+      REAL(wp) ::   ztrans             ! ice/snow transferred
+      REAL(wp), DIMENSION(jpij)     ::   zworka, zworkv   ! workspace
+      REAL(wp), DIMENSION(jpij,jpl) ::   zaTsfn           !  -    -
+      !!------------------------------------------------------------------
+         
+      CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i  )
+      CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i  )
+      CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i  )
+      CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,1:jpl), v_s  )
+      CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d(1:npti,1:jpl), oa_i )
+      CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i )
+      CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip )
+      CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip )
+      CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su )
+
+      !----------------------------------------------------------------------------------------------
+      ! 1) Define a variable equal to a_i*T_su
+      !----------------------------------------------------------------------------------------------
+      DO jl = 1, jpl
+         DO ji = 1, npti
+            zaTsfn(ji,jl) = a_i_2d(ji,jl) * t_su_2d(ji,jl)
+         END DO
+      END DO
+      
+      !-------------------------------------------------------------------------------
+      ! 2) Transfer volume and energy between categories
+      !-------------------------------------------------------------------------------
+      DO jl = 1, jpl - 1
+         DO ji = 1, npti
+            !
+            jl1 = kdonor(ji,jl)
+            !
+            IF( jl1 > 0 ) THEN
+               !
+               IF ( jl1 == jl  ) THEN   ;   jl2 = jl1+1
+               ELSE                     ;   jl2 = jl 
+               ENDIF
+               !
+               IF( v_i_2d(ji,jl1) >= epsi10 ) THEN   ;   zworkv(ji) = pdvice(ji,jl) / v_i_2d(ji,jl1)
+               ELSE                                  ;   zworkv(ji) = 0._wp
+               ENDIF
+               IF( a_i_2d(ji,jl1) >= epsi10 ) THEN   ;   zworka(ji) = pdaice(ji,jl) / a_i_2d(ji,jl1)
+               ELSE                                  ;   zworka(ji) = 0._wp
+               ENDIF
+               !
+               a_i_2d(ji,jl1) = a_i_2d(ji,jl1) - pdaice(ji,jl)       ! Ice areas
+               a_i_2d(ji,jl2) = a_i_2d(ji,jl2) + pdaice(ji,jl)
+               !
+               v_i_2d(ji,jl1) = v_i_2d(ji,jl1) - pdvice(ji,jl)       ! Ice volumes
+               v_i_2d(ji,jl2) = v_i_2d(ji,jl2) + pdvice(ji,jl)
+               !
+               ztrans         = v_s_2d(ji,jl1) * zworkv(ji)          ! Snow volumes
+               v_s_2d(ji,jl1) = v_s_2d(ji,jl1) - ztrans
+               v_s_2d(ji,jl2) = v_s_2d(ji,jl2) + ztrans 
+               !          
+               !                                                     ! Ice age 
+               ztrans          = oa_i_2d(ji,jl1) * pdaice(ji,jl)  !!clem: should be * zworka(ji) but it does not work ????
+               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - ztrans
+               oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ztrans
+               !
+               ztrans          = sv_i_2d(ji,jl1) * zworkv(ji)        ! Ice salinity
+               !
+               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - ztrans
+               sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ztrans
+               !
+               !                                                     ! Surface temperature
+               ztrans          = t_su_2d(ji,jl1) * pdaice(ji,jl)     !!clem: should be * zworka(ji) but it does not work ????
+               zaTsfn(ji,jl1)  = zaTsfn(ji,jl1) - ztrans
+               zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans
+               !  
+               ! MV MP 2016 
+               IF ( nn_pnd_scheme > 0 ) THEN
+                  !                                                  ! Pond fraction
+                  ztrans          = a_ip_2d(ji,jl1) * pdaice(ji,jl) !!clem: should be * zworka(ji) but it does not work
+                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans
+                  a_ip_2d(ji,jl2) = a_ip_2d(ji,jl2) + ztrans
+                  !                                                  ! Pond volume (also proportional to da/a)
+                  ztrans          = v_ip_2d(ji,jl1) * pdaice(ji,jl) !!clem: should be * zworka(ji) but it does not work
+                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans
+                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans
+               ENDIF
+               ! END MV MP 2016
+               !
+            ENDIF   ! jl1 >0
+         END DO
+         !
+         DO jk = 1, nlay_s         !--- Snow heat content
+            !
+            DO ji = 1, npti
+               ii = MOD( nptidx(ji) - 1, jpi ) + 1
+               ij = ( nptidx(ji) - 1 ) / jpi + 1
+               !
+               jl1 = kdonor(ji,jl)
+               !
+               IF( jl1 > 0 ) THEN
+                  IF(jl1 == jl) THEN  ;  jl2 = jl+1
+                  ELSE                ;  jl2 = jl
+                  ENDIF
+                  !
+                  ztrans            = e_s(ii,ij,jk,jl1) * zworkv(ji)
+                  e_s(ii,ij,jk,jl1) = e_s(ii,ij,jk,jl1) - ztrans
+                  e_s(ii,ij,jk,jl2) = e_s(ii,ij,jk,jl2) + ztrans
+               ENDIF
+            END DO
+         END DO
+
+         DO jk = 1, nlay_i         !--- Ice heat content
+            DO ji = 1, npti
+               ii = MOD( nptidx(ji) - 1, jpi ) + 1
+               ij = ( nptidx(ji) - 1 ) / jpi + 1
+               !
+               jl1 = kdonor(ji,jl)
+               !
+               IF( jl1 > 0 ) THEN
+                  IF(jl1 == jl) THEN  ;  jl2 = jl+1
+                  ELSE                ;  jl2 = jl
+                  ENDIF
+                  !
+                  ztrans            = e_i(ii,ij,jk,jl1) * zworkv(ji)
+                  e_i(ii,ij,jk,jl1) = e_i(ii,ij,jk,jl1) - ztrans
+                  e_i(ii,ij,jk,jl2) = e_i(ii,ij,jk,jl2) + ztrans
+               ENDIF
+            END DO
+         END DO
+         !
+      END DO                   ! boundaries, 1 to jpl-1
+      
+      !-------------------------------------------------------------------------------
+      ! 3) Update ice thickness and temperature
+      !-------------------------------------------------------------------------------
+      WHERE( a_i_2d(1:npti,:) >= epsi20 )
+         h_i_2d(1:npti,:)  =  v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 
+         t_su_2d(1:npti,:)  =  zaTsfn(1:npti,:) / a_i_2d(1:npti,:) 
+      ELSEWHERE
+         h_i_2d(1:npti,:)  = 0._wp
+         t_su_2d(1:npti,:)  = rt0
+      END WHERE
+      !
+      CALL tab_2d_3d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i  )
+      CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i  )
+      CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i  )
+      CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,1:jpl), v_s  )
+      CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d(1:npti,1:jpl), oa_i )
+      CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i )
+      CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip )
+      CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip )
+      CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su )
+      !
+   END SUBROUTINE ice_itd_shiftice
+   
+
+   SUBROUTINE ice_itd_reb( kt )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE ice_itd_reb ***
+      !!
+      !! ** Purpose : rebin - rebins thicknesses into defined categories
+      !!
+      !! ** Method  : If a category thickness is out of bounds, shift part (for down to top)
+      !!              or entire (for top to down) area, volume, and energy
+      !!              to the neighboring category
+      !!------------------------------------------------------------------
+      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
+      INTEGER ::   ji, jj, jl   ! dummy loop indices
+      !
+      INTEGER , DIMENSION(jpij,jpl-1) ::   jdonor           ! donor category index
+      REAL(wp), DIMENSION(jpij,jpl-1) ::   zdaice, zdvice   ! ice area and volume transferred
+      !!------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 
+
+      jdonor(:,:) = 0
+      zdaice(:,:) = 0._wp
+      zdvice(:,:) = 0._wp
+      !
+      !                       !---------------------------------------
+      DO jl = 1, jpl-1        ! identify thicknesses that are too big
+         !                    !---------------------------------------
+         npti = 0   ;   nptidx(:) = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( a_i(ji,jj,jl) > epsi10 .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
+                  npti = npti + 1
+                  nptidx( npti ) = (jj - 1) * jpi + ji                  
+               ENDIF
+            END DO
+         END DO
+         !
+!!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i(:,:,jl)   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i(:,:,jl)    )
+         CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d  (1:npti), v_i(:,:,jl)    )
+         !
+         DO ji = 1, npti
+            jdonor(ji,jl)  = jl 
+            ! how much of a_i you send in cat sup is somewhat arbitrary
+!!clem: these do not work properly after a restart (I do not know why)
+!!          zdaice(ji,jl)  = a_i_1d(ji) * ( h_i_1d(ji) - hi_max(jl) + epsi10 ) / h_i_1d(ji)  
+!!          zdvice(ji,jl)  = v_i_1d(ji) - ( a_i_1d(ji) - zdaice(ji,jl) ) * ( hi_max(jl) - epsi10 )
+!!clem: these do not work properly after a restart (I do not know why)
+!!            zdaice(ji,jl)  = a_i_1d(ji)
+!!            zdvice(ji,jl)  = v_i_1d(ji)
+!!clem: these are from UCL and work ok
+            zdaice(ji,jl)  = a_i_1d(ji) * 0.5_wp
+            zdvice(ji,jl)  = v_i_1d(ji) - zdaice(ji,jl) * ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+         END DO
+         !
+         IF( npti > 0 ) THEN
+            CALL ice_itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) )  ! Shift jl=>jl+1
+            ! Reset shift parameters
+            jdonor(1:npti,jl) = 0
+            zdaice(1:npti,jl) = 0._wp
+            zdvice(1:npti,jl) = 0._wp
+         ENDIF
+         !
+      END DO
+
+      !                       !-----------------------------------------
+      DO jl = jpl-1, 1, -1    ! Identify thicknesses that are too small
+         !                    !-----------------------------------------
+         npti = 0 ; nptidx(:) = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( a_i(ji,jj,jl+1) > epsi10 .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
+                  npti = npti + 1
+                  nptidx( npti ) = (jj - 1) * jpi + ji                  
+               ENDIF
+            END DO
+         END DO
+         !
+         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i(:,:,jl+1)    ) ! jl+1 is ok
+         CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d  (1:npti), v_i(:,:,jl+1)    ) ! jl+1 is ok
+         DO ji = 1, npti
+            jdonor(ji,jl) = jl + 1
+            zdaice(ji,jl) = a_i_1d(ji) 
+            zdvice(ji,jl) = v_i_1d(ji)
+         END DO
+         !
+         IF( npti > 0 ) THEN
+            CALL ice_itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) )  ! Shift jl+1=>jl
+            ! Reset shift parameters
+            jdonor(1:npti,jl) = 0
+            zdaice(1:npti,jl) = 0._wp
+            zdvice(1:npti,jl) = 0._wp
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE ice_itd_reb
+
+   SUBROUTINE ice_itd_init
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE ice_itd_init ***
+      !!
+      !! ** Purpose :   Initializes the ice thickness distribution
+      !! ** Method  :   ...
+      !! ** input   :   Namelist namitd
+      !!-------------------------------------------------------------------
+      INTEGER  ::   jl    ! dummy loop index
+      INTEGER  ::   ios   ! Local integer output status for namelist read
+      REAL(wp) ::   zhmax, znum, zden, zalpha   !   -      -
+      !!
+      NAMELIST/namitd/ rn_himean, rn_himin
+      !!------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )      ! Namelist namitd in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )      ! Namelist namitd in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namitd )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_itd_init: Initialization of ice cat distribution '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namitd: '
+         WRITE(numout,*) '      mean ice thickness in the domain               rn_himean = ', rn_himean
+         WRITE(numout,*) '      minimum ice thickness                          rn_himin  = ', rn_himin 
+      ENDIF
+      !
+      !-----------------------------------!
+      !  Thickness categories boundaries  !
+      !-----------------------------------!
+      !
+      zalpha = 0.05_wp              ! max of each category (from h^(-alpha) function)
+      zhmax  = 3._wp * rn_himean
+      DO jl = 1, jpl
+         znum = jpl * ( zhmax+1 )**zalpha
+         zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp )
+         hi_max(jl) = ( znum / zden )**(1./zalpha) - 1
+      END DO
+      !
+      DO jl = 1, jpl                ! mean thickness by category
+         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+      END DO
+      !
+      hi_max(jpl) = 99._wp          ! set to a big value to ensure that all ice is thinner than hi_max(jpl)
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   ===>>>   resulting thickness category boundaries :'
+      IF(lwp) WRITE(numout,*) '            hi_max(:)= ', hi_max(0:jpl)
+      !
+   END SUBROUTINE ice_itd_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE iceitd
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90	(revision 8586)
@@ -0,0 +1,289 @@
+MODULE icerst
+   !!======================================================================
+   !!                     ***  MODULE  icerst  ***
+   !!   sea-ice :  write/read the ice restart file
+   !!======================================================================
+   !! History:   3.0  ! 2005-04 (M. Vancoppenolle) Original code
+   !!             -   ! 2008-03 (C. Ethe) restart files in using IOM interface
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_rst_opn   : open  restart file
+   !!   ice_rst_write : write restart file 
+   !!   ice_rst_read  : read  restart file 
+   !!----------------------------------------------------------------------
+   USE ice            ! sea-ice variables
+   USE dom_oce        ! ocean domain
+   USE sbc_oce , ONLY : nn_fsbc
+   USE icectl
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_rst_opn     ! called by icestp
+   PUBLIC   ice_rst_write   ! called by icestp
+   PUBLIC   ice_rst_read    ! called by ice_init
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icerst.F90 8411 2017-08-07 16:09:12Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_rst_opn( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ice_rst_opn  ***
+      !!
+      !! ** purpose  :   open restart file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      !
+      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
+      CHARACTER(len=50)   ::   clname   ! ice output restart file name
+      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file 
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
+
+      ! in order to get better performances with NetCDF format, we open and define the ice restart file 
+      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice 
+      ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
+      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    &
+         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+            clpath = TRIM(cn_icerst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE DEFAULT
+                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
+                  WRITE(numout,*) '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE
+                  WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_ice = .TRUE.
+         ENDIF
+      ENDIF
+      !
+      IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
+   END SUBROUTINE ice_rst_opn
+
+
+   SUBROUTINE ice_rst_write( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ice_rst_write  ***
+      !!
+      !! ** purpose  :   write restart file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER ::   jk ,jl   ! dummy loop indices
+      INTEGER ::   iter
+      CHARACTER(len=25) ::   znam
+      CHARACTER(len=2)  ::   zchar, zchar1
+      REAL(wp), DIMENSION(jpi,jpj) :: z2d
+      !!----------------------------------------------------------------------
+
+      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
+
+      IF( iter == nitrst ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ice_rst_write : write ice restart file  kt =', kt
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
+      ENDIF
+
+      ! Write in numriw (if iter == nitrst)
+      ! ------------------ 
+      !                                                                        ! calendar control
+      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step 
+      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date
+
+!!gm   It is possible and easy to define a 3D domain size (jpi,jpj,jpl) or use a SIZE( tab, DIM=3) in iom_rtput )
+!!gm         ===>>> just a simple   iom_rstput( iter, nitrst, numriw, 'v_i', v_i )  etc...
+!!gm   "just" ask Sebatien
+
+      ! Prognostic variables 
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I2.2)') jl
+         znam = 'v_i'//'_htc'//zchar
+         z2d(:,:) = v_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_i
+         znam = 'v_s'//'_htc'//zchar
+         z2d(:,:) = v_s(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_s
+         znam = 'sv_i'//'_htc'//zchar
+         z2d(:,:) = sv_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! sv_i
+         znam = 'oa_i'//'_htc'//zchar
+         z2d(:,:) = oa_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! oa_i
+         znam = 'a_i'//'_htc'//zchar
+         z2d(:,:) = a_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! a_i
+         znam = 't_su'//'_htc'//zchar
+         z2d(:,:) = t_su(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! t_su
+      END DO
+
+      ! MV MP 2016
+      IF ( nn_pnd_scheme > 0 ) THEN
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            znam = 'a_ip'//'_htc'//zchar
+            z2d(:,:) = a_ip(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! a_ip
+            znam = 'v_ip'//'_htc'//zchar
+            z2d(:,:) = v_ip(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_ip
+         END DO
+      ENDIF
+      ! END MV MP 2016
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I2.2)') jl
+         znam = 'tempt_sl1'//'_htc'//zchar
+         z2d(:,:) = e_s(:,:,1,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! e_s
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I2.2)') jk
+            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
+            z2d(:,:) = e_i(:,:,jk,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! e_i
+         END DO
+      END DO
+
+      CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) ! u_ice
+      CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) ! v_ice
+      
+      ! close restart file
+      ! ------------------
+      IF( iter == nitrst ) THEN
+         CALL iom_close( numriw )
+         lrst_ice = .FALSE.
+      ENDIF
+      !
+   END SUBROUTINE ice_rst_write
+
+
+   SUBROUTINE ice_rst_read
+      !!----------------------------------------------------------------------
+      !!                    ***  ice_rst_read  ***
+      !!
+      !! ** purpose  :   read restart file
+      !!----------------------------------------------------------------------
+      INTEGER  :: jk, jl
+      REAL(wp) :: zfice, ziter
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d
+      CHARACTER(len=25) ::   znam
+      CHARACTER(len=2)  ::   zchar, zchar1
+      INTEGER           ::   jlibalt = jprstlib
+      LOGICAL           ::   llok
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_rst_read: read ice NetCDF restart file'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
+
+      CALL iom_get( numrir, 'nn_fsbc', zfice )
+      CALL iom_get( numrir, 'kt_ice' , ziter )    
+      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
+      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
+
+      ! Control of date
+      IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
+         &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  &
+         &                   '   verify the file or rerun with the value 0 for the',        &
+         &                   '   control of time parameter  nrstdt' )
+      IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
+         &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
+         &                   '   verify the file or rerun with the value 0 for the',         &
+         &                   '   control of time parameter  nrstdt' )
+
+      ! Prognostic variables 
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I2.2)') jl
+         znam = 'v_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         v_i(:,:,jl) = z2d(:,:)
+         znam = 'v_s'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         v_s(:,:,jl) = z2d(:,:) 
+         znam = 'sv_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         sv_i(:,:,jl) = z2d(:,:)
+         znam = 'oa_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         oa_i(:,:,jl) = z2d(:,:)
+         znam = 'a_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         a_i(:,:,jl) = z2d(:,:)
+         znam = 't_su'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         t_su(:,:,jl) = z2d(:,:)
+      END DO
+
+      ! MV MP 2016
+      IF ( nn_pnd_scheme > 0 ) THEN
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            znam = 'a_ip'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            a_ip(:,:,jl) = z2d(:,:)
+            znam = 'v_ip'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            v_ip(:,:,jl) = z2d(:,:)
+         END DO
+      ENDIF
+      ! END MV MP 2016
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I2.2)') jl
+         znam = 'tempt_sl1'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         e_s(:,:,1,jl) = z2d(:,:)
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I2.2)') jk
+            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            e_i(:,:,jk,jl) = z2d(:,:)
+         END DO
+      END DO
+
+      CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice )
+      CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice )
+
+   END SUBROUTINE ice_rst_read
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :       Empty module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icerst
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90	(revision 8586)
@@ -0,0 +1,440 @@
+MODULE icestp
+   !!======================================================================
+   !!                       ***  MODULE  icestp  ***
+   !! Surface module :  update the ocean surface boundary condition over ice
+   !!                   covered area using ESIM sea-ice model
+   !!=====================================================================
+   !! History :  2.0  ! 2006-12  (M. Vancoppenolle) Original code
+   !!            3.0  ! 2008-02  (C. Talandier)  Surface module from icestp.F90
+   !!             -   ! 2008-04  (G. Madec)  sltyle and ice_ctl routine
+   !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
+   !!            3.4  ! 2011-01  (A Porter)  dynamical allocation
+   !!             -   ! 2012-10  (C. Rousset)  add ice_dia
+   !!            3.6  ! 2014-07  (M. Vancoppenolle, G. Madec, O. Marti) revise coupled interface
+   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_stp       : sea-ice model time-stepping and update ocean SBC over ice-covered area
+   !!   ice_init      : initialize sea-ice
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE c1d            ! 1D vertical configuration
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamical 1D variables
+   !
+   USE phycst         ! Define parameters for the routines
+   USE eosbn2         ! equation of state
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice   fields
+   !
+   USE iceforcing     ! sea-ice: Surface boundary condition       !!gm why not icesbc module name
+   USE icedyn         ! sea-ice: dynamics
+   USE icethd         ! sea-ice: thermodynamics
+   USE limmp          ! sea-ice: melt ponds
+   USE icecor         ! sea-ice: corrections
+   USE iceupdate      ! sea-ice: sea surface boundary condition update
+   USE icedia         ! sea-ice: budget diagnostics
+   USE icewri         ! sea-ice: outputs
+   USE icerst         ! sea-ice: restarts
+   USE icevar         ! sea-ice: operations
+   USE icectl         ! sea-ice: control
+   USE iceistate      ! sea-ice: initial state
+   USE iceitd         ! sea-ice: remapping thickness distribution
+   USE icealb         ! sea-ice: albedo
+   !
+   USE bdy_oce , ONLY : ln_bdy   ! flag for bdy
+   USE bdyice         ! unstructured open boundary data for sea-ice
+# if defined key_agrif
+   USE agrif_ice
+   USE agrif_lim3_update
+   USE agrif_lim3_interp
+# endif
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE timing         ! Timing
+   USE prtctl         ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_stp    ! called by sbcmod.F90
+   PUBLIC   ice_init   ! called by sbcmod.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icestp.F90 8319 2017-07-11 15:00:44Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_stp( kt, ksbc )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_stp  ***
+      !!
+      !! ** Purpose :   sea-ice model time-stepping and update ocean surface
+      !!              boundary condition over ice-covered area
+      !!
+      !! ** Method  :   ice model time stepping
+      !!              - call the ice dynamics routine
+      !!              - call the ice advection/diffusion routine
+      !!              - call the ice thermodynamics routine
+      !!              - call the routine that computes mass and
+      !!                heat fluxes at the ice/ocean interface
+      !!              - save the outputs
+      !!              - save the outputs for restart when necessary
+      !!
+      !! ** Action  : - time evolution of the LIM sea-ice model
+      !!              - update all sbc variables below sea-ice:
+      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   ksbc    ! flux formulation (user defined, bulk, or Pure Coupled)
+      !
+      INTEGER ::   jl   ! dummy loop index
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ice_stp')
+      !
+      !                                      !-----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN   ! --- Ice time step --- !
+         !                                   !-----------------------!
+         !
+         kt_ice = kt                              ! -- Ice model time step
+         !
+# if defined key_agrif
+         IF( .NOT. Agrif_Root() )  lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1
+# endif
+         u_oce(:,:) = ssu_m(:,:)                  ! -- mean surface ocean current
+         v_oce(:,:) = ssv_m(:,:)
+         !
+         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) )   ! -- freezing temperature [Kelvin] (set to rt0 over land)
+         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+         !
+         CALL store_fields                        ! -- Store now ice values
+         !
+         !------------------------------------------------!
+         ! --- Dynamical coupling with the atmosphere --- !
+         !------------------------------------------------!
+         ! It provides the following fields used in sea ice model:
+         !    utau_ice, vtau_ice = surface ice stress [N/m2]
+         !------------------------------------------------!
+                                        CALL ice_forcing_tau( kt, ksbc, utau_ice, vtau_ice )          
+         !-------------------------------------!
+         ! --- ice dynamics and advection  --- !
+         !-------------------------------------!
+         CALL diag_set0             ! set diag of mass, heat and salt fluxes to 0
+         CALL ice_rst_opn( kt )     ! Open Ice restart file (if necessary) 
+         !
+         IF( ln_icedyn .AND. .NOT.lk_c1d )   &
+            &                           CALL ice_dyn( kt )            ! -- Ice dynamics
+         !
+         !                          !==  lateral boundary conditions  ==!
+#if defined key_agrif
+         IF( .NOT. Agrif_Root()     )   CALL agrif_interp_lim3('T')   ! -- AGRIF 
+#endif
+         IF( ln_icethd .AND. ln_bdy )   CALL bdy_ice( kt )            ! -- bdy ice thermo
+         !
+         !
+         !                          !==  previous lead fraction and ice volume for flux calculations
+         CALL ice_var_glo2eqv            ! h_i and h_s for ice albedo calculation
+         CALL ice_var_agg(1)             ! at_i for coupling 
+         CALL store_fields               ! Store now ice values
+
+         !------------------------------------------------------!
+         ! --- Thermodynamical coupling with the atmosphere --- !
+         !------------------------------------------------------!
+         ! It provides the following fields used in sea ice model:
+         !    fr1_i0  , fr2_i0     = 1sr & 2nd fraction of qsr penetration in ice  [%]
+         !    emp_oce , emp_ice    = E-P over ocean and sea ice                    [Kg/m2/s]
+         !    sprecip              = solid precipitation                           [Kg/m2/s]
+         !    evap_ice             = sublimation                                   [Kg/m2/s]
+         !    qsr_tot , qns_tot    = solar & non solar heat flux (total)           [W/m2]
+         !    qsr_ice , qns_ice    = solar & non solar heat flux over ice          [W/m2]
+         !    dqns_ice             = non solar  heat sensistivity                  [W/m2]
+         !    qemp_oce, qemp_ice,  = sensible heat (associated with evap & precip) [W/m2]
+         !    qprec_ice, qevap_ice
+         !------------------------------------------------------!
+                                        CALL ice_forcing_flx( kt, ksbc )
+         !----------------------------!
+         ! --- ice thermodynamics --- !
+         !----------------------------!
+         IF( ln_icethd )                CALL ice_thd( kt )            ! -- Ice thermodynamics      
+         !
+         IF ( ln_pnd )                  CALL lim_mp( kt )             ! -- Melt ponds
+         !
+         IF( ln_icethd )                CALL ice_cor( kt , 2 )        ! -- Corrections
+# if defined key_agrif
+         IF( .NOT. Agrif_Root() )       CALL agrif_update_lim3( kt )
+# endif
+         CALL ice_var_glo2eqv        ! necessary calls (at least for coupling)
+         CALL ice_var_agg( 2 )       ! necessary calls (at least for coupling)
+                                     !
+!! clem: one should switch the calculation of the fluxes onto the parent grid but the following calls do not work
+!!       moreover it should only be called at the update frequency (as in agrif_lim3_update.F90)
+!!# if defined key_agrif
+!!         IF( .NOT. Agrif_Root() )     CALL Agrif_ChildGrid_To_ParentGrid()
+!!# endif
+                                        CALL ice_update_flx( kt )     ! -- Update ocean surface mass, heat and salt fluxes
+!!# if defined key_agrif
+!!         IF( .NOT. Agrif_Root() )     CALL Agrif_ParentGrid_To_ChildGrid()
+!!# endif
+         IF( ln_icediahsb )             CALL ice_dia( kt )            ! -- Diagnostics outputs 
+         !
+                                        CALL ice_wri( kt )            ! -- Ice outputs 
+         !
+         IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file 
+         !
+         IF( ln_icectl )                CALL ice_ctl( kt )            ! -- alerts in case of model crash
+         !
+      ENDIF   ! End sea-ice time step only
+
+      !-------------------------!
+      ! --- Ocean time step --- !
+      !-------------------------!
+      IF( ln_icedyn )                   CALL ice_update_tau( kt, ub(:,:,1), vb(:,:,1) )   ! -- update surface ocean stresses
+!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('ice_stp')
+      !
+   END SUBROUTINE ice_stp
+
+
+   SUBROUTINE ice_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_init  ***
+      !!
+      !! ** purpose :   Initialize sea-ice parameters
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, ierr
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ice_init: Arrays allocation & Initialization off all routines & init state' 
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      !
+      !                                ! Open the reference and configuration namelist files and namelist output file
+      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
+      !
+      CALL par_init                ! set some ice run parameters
+      !
+      !                                ! Allocate the ice arrays (sbc_ice already allocated in sbc_init)
+      ierr =        ice_alloc        ()      ! ice variables
+      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing 
+      ierr = ierr + ice1D_alloc      ()      ! thermodynamics
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays')
+      !
+      CALL ice_itd_init                ! ice thickness distribution initialization
+      !
+      CALL lim_mp_init                 ! set melt ponds parameters (clem: important to be located here)
+      !
+      !                                ! Initial sea-ice state
+      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst
+         CALL ice_istate_init
+         CALL ice_istate
+      ELSE                                    ! start from a restart file
+         CALL ice_rst_read
+      ENDIF
+      CALL ice_var_glo2eqv
+      CALL ice_var_agg(2)
+      !
+      CALL ice_forcing_init            ! set ice-ocean and ice-atm. coupling parameters
+      !
+      IF( ln_icedyn ) THEN
+         CALL ice_dyn_init             ! set ice dynamics parameters
+      ENDIF
+      !
+      IF( ln_icethd ) THEN
+         CALL ice_thd_init             ! set ice thermodynics parameters
+      ENDIF   
+      !
+      CALL ice_update_init             ! ice surface boundary condition
+      !
+      CALL ice_alb_init                ! ice surface albedo
+      !
+      CALL ice_dia_init                ! initialization for diags
+      !
+      fr_i  (:,:)   = at_i(:,:)        ! initialisation of sea-ice fraction
+      tn_ice(:,:,:) = t_su(:,:,:)      ! initialisation of surface temp for coupled simu
+      !
+      !                                ! set max concentration in both hemispheres
+      WHERE( gphit(:,:) > 0._wp )   ;   rn_amax_2d(:,:) = rn_amax_n  ! NH
+      ELSEWHERE                     ;   rn_amax_2d(:,:) = rn_amax_s  ! SH
+      END WHERE
+
+      IF( ln_rstart )   CALL iom_close( numrir )  ! close input ice restart file
+      !
+   END SUBROUTINE ice_init
+
+
+   SUBROUTINE par_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE par_init ***
+      !!
+      !! ** Purpose :   Definition generic parameters for ice model
+      !!
+      !! ** Method  :   Read namelist and check the parameter
+      !!                values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist nampar
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/nampar/ jpl, nlay_i, nlay_s, nn_monocat, ln_icedyn, ln_icethd, rn_amax_n, rn_amax_s,  &
+         &             cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )      ! Namelist nampar in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )      ! Namelist nampar in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, nampar )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'par_init: ice parameters shared among all the routines'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '   Namelist nampar: '
+         WRITE(numout,*) '      number of ice  categories                              jpl    = ', jpl
+         WRITE(numout,*) '      number of ice  layers                                  nlay_i = ', nlay_i
+         WRITE(numout,*) '      number of snow layers                                  nlay_s = ', nlay_s
+         WRITE(numout,*) '      virtual ITD mono-category param (1-4) or not (0)   nn_monocat = ', nn_monocat
+         WRITE(numout,*) '      Ice dynamics       (T) or not (F)                   ln_icedyn = ', ln_icedyn
+         WRITE(numout,*) '      Ice thermodynamics (T) or not (F)                   ln_icethd = ', ln_icethd
+         WRITE(numout,*) '      maximum ice concentration for NH                              = ', rn_amax_n 
+         WRITE(numout,*) '      maximum ice concentration for SH                              = ', rn_amax_s
+      ENDIF
+      !
+      !                                        !--- check consistency
+      IF ( jpl > 1 .AND. nn_monocat == 1 ) THEN
+         nn_monocat = 0
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen'
+      ENDIF
+      IF ( jpl == 1 .AND. nn_monocat == 0 ) THEN
+         CALL ctl_stop( 'STOP', 'par_init : if jpl=1 then nn_monocat should be between 1 and 4' )
+      ENDIF
+      !
+      IF( ln_bdy .AND. ln_icediachk )   CALL ctl_warn('par_init: online conservation check does not work with BDY')
+      !
+      rdt_ice   = REAL(nn_fsbc) * rdt          !--- sea-ice timestep and inverse
+      r1_rdtice = 1._wp / rdt_ice
+      IF( lwp ) WRITE(numout,*) '   ice timestep rdt_ice = ', rdt_ice
+      !
+      r1_nlay_i = 1._wp / REAL( nlay_i, wp )   !--- inverse of nlay_i and nlay_s
+      r1_nlay_s = 1._wp / REAL( nlay_s, wp )
+      !
+   END SUBROUTINE par_init
+
+
+   SUBROUTINE store_fields
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE store_fields  ***
+      !!
+      !! ** purpose :  store ice variables at "before" time step
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl      ! dummy loop index
+      !!----------------------------------------------------------------------
+      !
+      a_i_b (:,:,:)   = a_i (:,:,:)     ! ice area
+      v_i_b (:,:,:)   = v_i (:,:,:)     ! ice volume
+      v_s_b (:,:,:)   = v_s (:,:,:)     ! snow volume
+      sv_i_b(:,:,:)   = sv_i(:,:,:)     ! salt content
+      oa_i_b(:,:,:)   = oa_i(:,:,:)     ! areal age content
+      e_s_b (:,:,:,:) = e_s (:,:,:,:)   ! snow thermal energy
+      e_i_b (:,:,:,:) = e_i (:,:,:,:)   ! ice thermal energy
+      WHERE( a_i_b(:,:,:) >= epsi20 )
+         h_i_b(:,:,:) = v_i_b (:,:,:) / a_i_b(:,:,:)   ! ice thickness
+         h_s_b(:,:,:) = v_s_b (:,:,:) / a_i_b(:,:,:)   ! snw thickness
+      ELSEWHERE
+         h_i_b(:,:,:) = 0._wp
+         h_s_b(:,:,:) = 0._wp
+      END WHERE
+      
+      ! ice velocities & total concentration
+      at_i_b(:,:)  = SUM( a_i_b(:,:,:), dim=3 )
+      u_ice_b(:,:) = u_ice(:,:)
+      v_ice_b(:,:) = v_ice(:,:)
+      !
+   END SUBROUTINE store_fields
+
+
+   SUBROUTINE diag_set0
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE diag_set0  ***
+      !!
+      !! ** purpose :  set ice-ocean and ice-atm. fluxes to zeros at the beggining
+      !!               of the time step
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj      ! dummy loop index
+      !!----------------------------------------------------------------------
+      sfx    (:,:) = 0._wp   ;
+      sfx_bri(:,:) = 0._wp   ;   sfx_lam(:,:) = 0._wp
+      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp
+      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp
+      sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp
+      sfx_res(:,:) = 0._wp   ;   sfx_sub(:,:) = 0._wp
+      !
+      wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp
+      wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp
+      wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp
+      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp
+      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp
+      wfx_spr(:,:) = 0._wp   ;   wfx_lam(:,:) = 0._wp  
+      wfx_snw_dyn(:,:) = 0._wp ; wfx_snw_sum(:,:) = 0._wp
+      wfx_snw_sub(:,:) = 0._wp ; wfx_ice_sub(:,:) = 0._wp
+      wfx_snw_sni(:,:) = 0._wp 
+      ! MV MP 2016
+      wfx_pnd(:,:) = 0._wp
+      ! END MV MP 2016
+
+      hfx_thd(:,:) = 0._wp   ;
+      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp
+      hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp
+      hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp
+      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp
+      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp
+      hfx_err_rem(:,:) = 0._wp
+      hfx_err_dif(:,:) = 0._wp
+      wfx_err_sub(:,:) = 0._wp
+      !
+      afx_tot(:,:) = 0._wp   ;
+      !
+      diag_heat(:,:) = 0._wp ;   diag_sice(:,:) = 0._wp
+      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp
+
+      ! SIMIP diagnostics
+      diag_fc_bo(:,:)    = 0._wp ; diag_fc_su(:,:)    = 0._wp
+
+      tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here)
+      
+   END SUBROUTINE diag_set0
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE ice_stp ( kt, ksbc )     ! Dummy routine
+      INTEGER, INTENT(in) ::   kt, ksbc
+      WRITE(*,*) 'ice_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE ice_stp
+   SUBROUTINE ice_init                 ! Dummy routine
+   END SUBROUTINE ice_init
+#endif
+
+   !!======================================================================
+END MODULE icestp
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icetab.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icetab.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icetab.F90	(revision 8586)
@@ -0,0 +1,119 @@
+MODULE icetab
+   !!======================================================================
+   !!                       ***  MODULE icetab   ***
+   !!   sea-ice : transform 1D (2D) array to a 2D (1D) table
+   !!======================================================================
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   tab_3d_2d  : 3-D <==> 2-D
+   !!   tab_2d_3d  : 2-D <==> 3-D
+   !!   tab_2d_1d  : 2-D <==> 1-D
+   !!   tab_1d_2d  : 1-D <==> 2-D
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE ice, ONLY : jpl
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tab_3d_2d
+   PUBLIC   tab_2d_1d
+   PUBLIC   tab_2d_3d
+   PUBLIC   tab_1d_2d
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icetab.F90 8369 2017-07-25 14:38:38Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tab_3d_2d( ndim1d, tab_ind, tab1d, tab2d )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   ndim1d   ! 1d size
+      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind  ! input index
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in   ) ::   tab2d    ! input 2D field
+      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(  out) ::   tab1d    ! output 1D field
+      !
+      INTEGER ::   jl, jn, jid, jjd
+      !!----------------------------------------------------------------------
+      DO jl = 1, jpl
+         DO jn = 1, ndim1d
+            jid          = MOD( tab_ind(jn) - 1 , jpi ) + 1
+            jjd          =    ( tab_ind(jn) - 1 ) / jpi + 1
+            tab1d(jn,jl) = tab2d(jid,jjd,jl)
+         END DO
+      END DO
+   END SUBROUTINE tab_3d_2d
+
+
+   SUBROUTINE tab_2d_1d( ndim1d, tab_ind, tab1d, tab2d )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   ndim1d   ! 1d size
+      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind  ! input index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   tab2d    ! input 2D field
+      REAL(wp), DIMENSION(ndim1d) , INTENT(  out) ::   tab1d    ! output 1D field
+      !
+      INTEGER ::   jn , jid, jjd
+      !!----------------------------------------------------------------------
+      DO jn = 1, ndim1d
+         jid        = MOD( tab_ind(jn) - 1 , jpi ) + 1
+         jjd        =    ( tab_ind(jn) - 1 ) / jpi + 1
+         tab1d( jn) = tab2d( jid, jjd)
+      END DO
+   END SUBROUTINE tab_2d_1d
+
+
+   SUBROUTINE tab_2d_3d( ndim1d, tab_ind, tab1d, tab2d )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   ndim1d    ! 1D size
+      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind   ! input index
+      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(in   ) ::   tab1d     ! input 1D field
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   tab2d     ! output 2D field
+      !
+      INTEGER ::   jl, jn, jid, jjd
+      !!----------------------------------------------------------------------
+      DO jl = 1, jpl
+         DO jn = 1, ndim1d
+            jid               = MOD( tab_ind(jn) - 1 ,  jpi ) + 1
+            jjd               =    ( tab_ind(jn) - 1 ) / jpi  + 1
+            tab2d(jid,jjd,jl) = tab1d(jn,jl)
+         END DO
+      END DO
+   END SUBROUTINE tab_2d_3d
+
+
+   SUBROUTINE tab_1d_2d( ndim1d, tab_ind, tab1d, tab2d )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   ndim1d    ! 1D size
+      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind   ! input index
+      REAL(wp), DIMENSION(ndim1d) , INTENT(in   ) ::   tab1d     ! input 1D field
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   tab2d     ! output 2D field
+      !
+      INTEGER ::   jn , jid, jjd
+      !!----------------------------------------------------------------------
+      DO jn = 1, ndim1d
+         jid             = MOD( tab_ind(jn) - 1 ,  jpi ) + 1
+         jjd             =    ( tab_ind(jn) - 1 ) / jpi  + 1
+         tab2d(jid, jjd) = tab1d( jn)
+      END DO
+   END SUBROUTINE tab_1d_2d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icetab
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90	(revision 8586)
@@ -0,0 +1,587 @@
+MODULE icethd
+   !!======================================================================
+   !!                  ***  MODULE icethd   ***
+   !!   sea-ice : master routine for thermodynamics
+   !!======================================================================
+   !! History :  LIM  ! 2000-01 (M.A. Morales Maqueda, H. Goosse, T. Fichefet) LIM-1
+   !!            2.0  ! 2002-07 (C. Ethe, G. Madec)  LIM-2 (F90 rewriting)
+   !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations
+   !!             -   ! 2007-04 (M. Vancoppenolle) add ice_thd_glohec, ice_thd_con_dh and ice_thd_con_dif
+   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw
+   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas)
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_thd       : thermodynamics of sea ice
+   !!   ice_thd_init  : initialisation of sea-ice thermodynamics
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain variables
+   USE ice            ! sea-ice: variables
+!!gm list trop longue ==>>> why not passage en argument d'appel ?
+   USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl
+   USE sbc_ice , ONLY : qsr_oce, qns_oce, qemp_oce, qsr_ice, qns_ice, dqns_ice, evap_ice, qprec_ice, qevap_ice, &
+      &                 fr1_i0, fr2_i0
+   USE ice1D          ! sea-ice: thermodynamics variables
+   USE icethd_zdf     ! sea-ice: vertical heat diffusion
+   USE icethd_dh      ! sea-ice: ice-snow growth and melt
+   USE icethd_da      ! sea-ice: lateral melting
+   USE icethd_sal     ! sea-ice: salinity
+   USE icethd_ent     ! sea-ice: enthalpy redistribution
+   USE icethd_do      ! sea-ice: growth in open water
+   USE iceitd         ! sea-ice: remapping thickness distribution
+   USE icetab         ! sea-ice: 1D <==> 2D transformation
+   USE icevar         ! sea-ice: operations
+   USE icectl         ! sea-ice: control print
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_thd         ! called by limstp module
+   PUBLIC   ice_thd_init    ! called by ice_init
+
+   !!** namelist (namthd) **
+   LOGICAL ::   ln_icedH         ! activate ice thickness change from growing/melting (T) or not (F)
+   LOGICAL ::   ln_icedA         ! activate lateral melting param. (T) or not (F)
+   LOGICAL ::   ln_icedO         ! activate ice growth in open-water (T) or not (F)
+   LOGICAL ::   ln_icedS         ! activate gravity drainage and flushing (T) or not (F)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd.F90 8420 2017-08-08 12:18:46Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_thd( kt )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_thd  ***       
+      !!  
+      !! ** Purpose : This routine manages ice thermodynamics
+      !!         
+      !! ** Action : - Initialisation of some variables
+      !!             - Some preliminary computation (oceanic heat flux
+      !!               at the ice base, snow acc.,heat budget of the leads)
+      !!             - selection of the icy points and put them in an array
+      !!             - call ice_thd_zdf  for vertical heat diffusion
+      !!             - call ice_thd_dh   for vertical ice growth and melt
+      !!             - call ice_thd_ent  for enthalpy remapping
+      !!             - call ice_thd_sal  for ice desalination
+      !!             - call ice_thd_temp to  retrieve temperature from ice enthalpy
+      !!             - call ice_thd_lam  for extra lateral ice melt if monocat
+      !!             - call ice_thd_da   for lateral ice melt
+      !!             - back to the geographic grid
+      !!             - call ice_thd_rem  for remapping thickness distribution
+      !!             - call ice_thd_do   for ice growth in leads
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt    ! number of iteration
+      !
+      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg
+      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04)
+      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient
+      REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io, zfric   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)
+      !
+      !!-------------------------------------------------------------------
+      ! controls
+      IF( nn_timing == 1 )   CALL timing_start('icethd')                                                             ! timing
+      IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_thd: sea-ice thermodynamics'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      
+      CALL ice_var_glo2eqv
+
+      !---------------------------------------------!
+      ! computation of friction velocity at T points
+      !---------------------------------------------!
+      IF( ln_icedyn ) THEN
+         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
+         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1
+               zfric(ji,jj) = rn_cio * ( 0.5_wp *  &
+                  &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
+                  &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  &
+                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
+                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      CALL lbc_lnk( zfric, 'T',  1. )
+      !
+      ftr_ice(:,:,:) = 0._wp  ! initialization (part of solar radiation transmitted through the ice)
+
+      !--------------------------------------------------------------------!
+      ! Partial computation of forcing for the thermodynamic sea ice model
+      !--------------------------------------------------------------------!
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
+            !
+            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
+            !           !  practically no "direct lateral ablation"
+            !           
+            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
+            !           !  temperature and turbulent mixing (McPhee, 1992)
+            !
+            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
+            zqld =  tmask(ji,jj,1) * rdt_ice *  &
+               &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  &
+               &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
+
+            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
+            ! includes supercooling potential energy (>0) or "above-freezing" energy (<0)
+            zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+
+            ! --- Above-freezing sensible heat content (J/m2 grid)
+            zqfr_neg = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * MIN( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ), 0._wp )
+
+            ! --- Sensible ocean-to-ice heat flux (W/m2)
+            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
+            fhtur(ji,jj) = rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2
+
+            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
+            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
+            !                        the freezing point, so that we do not have SST < T_freeze
+            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
+
+            !-- Energy Budget of the leads (J.m-2), source of lateral accretion. Must be < 0 to form ice
+            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
+
+            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 
+            IF( zqld > 0._wp ) THEN
+               fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90
+               qlead(ji,jj) = 0._wp
+            ELSE
+               fhld (ji,jj) = 0._wp
+            ENDIF
+            !
+            ! Net heat flux on top of the ice-ocean [W.m-2]
+            ! ---------------------------------------------
+            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
+         END DO
+      END DO
+      
+      ! In case we bypass open-water ice formation
+      IF( .NOT. ln_icedO )  qlead(:,:) = 0._wp
+      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere
+      IF( .NOT. ln_icedH ) THEN
+         hfx_in(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
+         fhtur (:,:) = 0._wp
+         fhld  (:,:) = 0._wp
+      ENDIF
+
+      ! ---------------------------------------------------------------------
+      ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2]
+      ! ---------------------------------------------------------------------
+      !     First  step here              :  non solar + precip - qlead - qturb
+      !     Second step in icethd_dh      :  heat remaining if total melt (zq_rema) 
+      !     Third  step in iceupdate.F90  :  heat from ice-ocean mass exchange (zf_mass) + solar
+      hfx_out(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:)  &  ! Non solar heat flux received by the ocean               
+         &           - qlead(:,:) * r1_rdtice                                &  ! heat flux taken from the ocean where there is open water ice formation
+         &           - at_i (:,:) * fhtur(:,:)                               &  ! heat flux taken by turbulence
+         &           - at_i (:,:) *  fhld(:,:)                                  ! heat flux taken during bottom growth/melt 
+                                                                                !    (fhld should be 0 while bott growth)
+      !-------------------------------------------------------------------------------------------!
+      ! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories
+      !-------------------------------------------------------------------------------------------!
+      DO jl = 1, jpl
+
+         ! select ice covered grid points
+         npti = 0 ; nptidx(:) = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
+                  npti         = npti  + 1
+                  nptidx(npti) = (jj - 1) * jpi + ji
+               ENDIF
+            END DO
+         END DO
+
+         IF( lk_mpp )         CALL mpp_ini_ice( npti , numout )
+
+         IF( npti > 0 ) THEN  ! If there is no ice, do nothing.
+            !                                                                
+                              CALL ice_thd_1d2d( jl, 1 )            ! --- Move to 1D arrays --- !
+            !                                                       ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- !
+            !
+            s_i_new   (1:npti) = 0._wp ; dh_s_tot (1:npti) = 0._wp  ! --- some init --- !  (important to have them here) 
+            dh_i_surf (1:npti) = 0._wp ; dh_i_bott(1:npti) = 0._wp
+            dh_snowice(1:npti) = 0._wp ; dh_i_sub (1:npti) = 0._wp
+            !
+            IF( ln_icedH ) THEN                                     ! --- growing/melting --- !
+                              CALL ice_thd_zdf                             ! Ice/Snow Temperature profile
+                              CALL ice_thd_dh                              ! Ice/Snow thickness   
+                              CALL ice_thd_ent( e_i_1d(1:npti,:) )         ! Ice enthalpy remapping
+            ENDIF
+            !
+                              CALL ice_thd_sal( ln_icedS )          ! --- Ice salinity --- !    
+            !
+                              CALL ice_thd_temp                     ! --- temperature update --- !
+            !
+!!gm please create a new logical (l_thd_lam or a better explicit name) set one for all in icestp.F90 module
+!!gm        l_thd_lam = ln_icedH .AND. ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 )
+!!gm        by the way, the different options associated with nn_monocat =1 to 4  are quite impossible to identify
+!!gm        more comment to add when ready the namelist, with an explicit print in the ocean.output
+            IF( ln_icedH ) THEN
+               IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
+                              CALL ice_thd_lam                      ! --- extra lateral melting if monocat --- !
+               END IF
+            END IF
+            !
+            IF( ln_icedA )    CALL ice_thd_da                       ! --- lateral melting --- !
+            !
+                              CALL ice_thd_1d2d( jl, 2 )            ! --- Change units of e_i, e_s from J/m3 to J/m2 --- !
+            !                                                       ! --- & Move to 2D arrays --- !
+            !
+            IF( lk_mpp )      CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
+         ENDIF
+         !
+      END DO
+      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting)
+      oa_i(:,:,:) = o_i(:,:,:) * a_i(:,:,:)
+
+      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
+      !
+                           CALL ice_var_zapsmall           ! --- remove very small ice concentration (<1e-10) --- !
+      !                                                    !     & make sure at_i=SUM(a_i) & ato_i=1 where at_i=0
+      !                   
+      IF( jpl > 1 )        CALL ice_itd_rem( kt )          ! --- Transport ice between thickness categories --- !
+      !
+      IF( ln_icedO )       CALL ice_thd_do                 ! --- frazil ice growing in leads --- !
+      !
+      ! controls
+      IF( ln_icectl      )   CALL ice_prt    (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints
+      IF( ln_ctl         )   CALL ice_prt3D  ('icethd')                                        ! prints
+      IF( nn_timing == 1 )   CALL timing_stop('icethd')                                        ! timing
+      !
+   END SUBROUTINE ice_thd 
+
+ 
+   SUBROUTINE ice_thd_temp
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_temp *** 
+      !!                 
+      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy
+      !!
+      !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jk   ! dummy loop indices
+      REAL(wp) ::   ztmelts, zbbb, zccc  ! local scalar 
+      !!-------------------------------------------------------------------
+      ! Recover ice temperature
+      DO jk = 1, nlay_i
+         DO ji = 1, npti
+            ztmelts       = -tmut * sz_i_1d(ji,jk)
+            ! Conversion q(S,T) -> T (second order equation)
+            zbbb          = ( rcp - cpic ) * ztmelts + e_i_1d(ji,jk) * r1_rhoic - lfus
+            zccc          = SQRT( MAX( zbbb * zbbb - 4._wp * cpic * lfus * ztmelts, 0._wp ) )
+            t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_cpic
+            
+            ! mask temperature
+            rswitch       = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 
+            t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
+         END DO 
+      END DO 
+      !
+   END SUBROUTINE ice_thd_temp
+
+
+   SUBROUTINE ice_thd_lam
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_lam *** 
+      !!                 
+      !! ** Purpose :   Lateral melting in case monocategory
+      !!                          ( dA = A/2h dh )
+      !!-----------------------------------------------------------------------
+      INTEGER  ::   ji                 ! dummy loop indices
+      REAL(wp) ::   zhi_bef            ! ice thickness before thermo
+      REAL(wp) ::   zdh_mel, zda_mel   ! net melting
+      REAL(wp) ::   zvi, zvs           ! ice/snow volumes 
+      !!-----------------------------------------------------------------------
+      !
+      DO ji = 1, npti
+         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) )
+         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN
+            zvi          = a_i_1d(ji) * h_i_1d(ji)
+            zvs          = a_i_1d(ji) * h_s_1d(ji)
+            ! lateral melting = concentration change
+            zhi_bef     = h_i_1d(ji) - zdh_mel
+            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
+            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
+            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
+            ! adjust thickness
+            h_i_1d(ji) = zvi / a_i_1d(ji)            
+            h_s_1d(ji) = zvs / a_i_1d(ji)            
+            ! retrieve total concentration
+            at_i_1d(ji) = a_i_1d(ji)
+         END IF
+      END DO
+      !
+   END SUBROUTINE ice_thd_lam
+
+
+   SUBROUTINE ice_thd_1d2d( kl, kn )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_1d2d *** 
+      !!                 
+      !! ** Purpose :   move arrays from 1d to 2d and the reverse
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kl   ! index of the ice category 
+      INTEGER, INTENT(in) ::   kn   ! 1= from 2D to 1D   ;   2= from 1D to 2D
+      !
+      INTEGER ::   jk   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      SELECT CASE( kn )
+      !                    !---------------------!
+      CASE( 1 )            !==  from 2D to 1D  ==!
+         !                 !---------------------!
+         CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i             )
+         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl)     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,kl)     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d(1:npti), h_s(:,:,kl)     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti), t_su(:,:,kl)     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,kl)     )
+         DO jk = 1, nlay_s
+            CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d(1:npti,jk), t_s(:,:,jk,kl)   )
+            CALL tab_2d_1d( npti, nptidx(1:npti), e_s_1d(1:npti,jk), e_s(:,:,jk,kl)   )
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d(1:npti,jk), t_i(:,:,jk,kl)   )
+            CALL tab_2d_1d( npti, nptidx(1:npti), e_i_1d(1:npti,jk), e_i(:,:,jk,kl)   )
+            CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl)   )
+         END DO
+         !
+         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d(1:npti), qprec_ice        )
+         CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_1d  (1:npti), qsr_ice (:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), fr1_i0_1d   (1:npti), fr1_i0           )
+         CALL tab_2d_1d( npti, nptidx(1:npti), fr2_i0_1d   (1:npti), fr2_i0           )
+         CALL tab_2d_1d( npti, nptidx(1:npti), qns_ice_1d  (1:npti), qns_ice (:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), ftr_ice_1d  (1:npti), ftr_ice (:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), evap_ice_1d (1:npti), evap_ice(:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d (1:npti), dqns_ice(:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d     (1:npti), t_bo             )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d  (1:npti), sprecip          ) 
+         CALL tab_2d_1d( npti, nptidx(1:npti), fhtur_1d    (1:npti), fhtur            )
+         CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d     (1:npti), fhld             )
+         !
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_sum_1d(1:npti), wfx_snw_sum   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_sub_1d    (1:npti), wfx_sub       )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_sub_1d(1:npti), wfx_snw_sub   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_ice_sub_1d(1:npti), wfx_ice_sub   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_err_sub_1d(1:npti), wfx_err_sub   )
+         !
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_bog_1d (1:npti), wfx_bog          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_bom_1d (1:npti), wfx_bom          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_sum_1d (1:npti), wfx_sum          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_sni_1d (1:npti), wfx_sni          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_res_1d (1:npti), wfx_res          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam          )
+         !
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bom_1d (1:npti), sfx_bom          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_sum_1d (1:npti), sfx_sum          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_sni_1d (1:npti), sfx_sni          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bri_1d (1:npti), sfx_bri          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_res_1d (1:npti), sfx_res          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_sub_1d (1:npti), sfx_sub          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_lam_1d (1:npti), sfx_lam          )
+         !
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res          )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out          )
+         !
+         ! SIMIP diagnostics
+         CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo   )
+         CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su   )
+         ! ocean surface fields
+         CALL tab_2d_1d( npti, nptidx(1:npti), sst_1d(1:npti), sst_m )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d(1:npti), sss_m )
+
+         ! --- Change units of e_i, e_s from J/m2 to J/m3 --- !
+         DO jk = 1, nlay_i
+            WHERE( h_i_1d(1:npti)>0._wp ) e_i_1d(1:npti,jk) = e_i_1d(1:npti,jk) / (h_i_1d(1:npti) * a_i_1d(1:npti)) * nlay_i
+         END DO
+         DO jk = 1, nlay_s
+            WHERE( h_s_1d(1:npti)>0._wp ) e_s_1d(1:npti,jk) = e_s_1d(1:npti,jk) / (h_s_1d(1:npti) * a_i_1d(1:npti)) * nlay_s
+         END DO
+         !
+         !                 !---------------------!
+      CASE( 2 )            !==  from 1D to 2D  ==!
+         !                 !---------------------!
+         ! --- Change units of e_i, e_s from J/m3 to J/m2 --- !
+         DO jk = 1, nlay_i
+            e_i_1d(1:npti,jk) = e_i_1d(1:npti,jk) * h_i_1d(1:npti) * a_i_1d(1:npti) * r1_nlay_i
+         END DO
+         DO jk = 1, nlay_s
+            e_s_1d(1:npti,jk) = e_s_1d(1:npti,jk) * h_s_1d(1:npti) * a_i_1d(1:npti) * r1_nlay_s
+         END DO
+         !
+         ! Change thickness to volume (replaces routine ice_var_eqv2glo)
+         v_i_1d(1:npti)  = h_i_1d(1:npti) * a_i_1d(1:npti)
+         v_s_1d(1:npti)  = h_s_1d(1:npti) * a_i_1d(1:npti)
+         sv_i_1d(1:npti) = s_i_1d(1:npti) * v_i_1d(1:npti)
+         
+         CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i             )
+         CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl)     )
+         CALL tab_1d_2d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,kl)     )
+         CALL tab_1d_2d( npti, nptidx(1:npti), h_s_1d(1:npti), h_s(:,:,kl)     )
+         CALL tab_1d_2d( npti, nptidx(1:npti), t_su_1d(1:npti), t_su(:,:,kl)     )
+         CALL tab_1d_2d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,kl)     )
+         DO jk = 1, nlay_s
+            CALL tab_1d_2d( npti, nptidx(1:npti), t_s_1d(1:npti,jk), t_s(:,:,jk,kl) )
+            CALL tab_1d_2d( npti, nptidx(1:npti), e_s_1d(1:npti,jk), e_s(:,:,jk,kl) )
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_1d_2d( npti, nptidx(1:npti), t_i_1d(1:npti,jk), t_i(:,:,jk,kl) )
+            CALL tab_1d_2d( npti, nptidx(1:npti), e_i_1d(1:npti,jk), e_i(:,:,jk,kl) )
+            CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl) )
+         END DO
+         !
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sum_1d(1:npti), wfx_snw_sum )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_sub_1d    (1:npti), wfx_sub     )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sub_1d(1:npti), wfx_snw_sub )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_ice_sub_1d(1:npti), wfx_ice_sub )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_err_sub_1d(1:npti), wfx_err_sub )
+         !
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_bog_1d (1:npti), wfx_bog        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_bom_1d (1:npti), wfx_bom        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_sum_1d (1:npti), wfx_sum        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_sni_1d (1:npti), wfx_sni        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_res_1d (1:npti), wfx_res        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam        )
+         !
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bom_1d (1:npti), sfx_bom        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_sum_1d (1:npti), sfx_sum        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_sni_1d (1:npti), sfx_sni        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bri_1d (1:npti), sfx_bri        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_res_1d (1:npti), sfx_res        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_sub_1d (1:npti), sfx_sub        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_lam_1d (1:npti), sfx_lam        )
+         !
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res        )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out        )
+         !
+         CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d(1:npti), qns_ice(:,:,kl) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), ftr_ice_1d(1:npti), ftr_ice(:,:,kl) )
+         !
+         ! SIMIP diagnostics         
+         CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d      (1:npti), t_si(:,:,kl) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo   )
+         CALL tab_1d_2d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su   )
+         ! extensive variables
+         CALL tab_1d_2d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i (:,:,kl) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), v_s_1d (1:npti), v_s (:,:,kl) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) )
+         !
+      END SELECT
+      !
+   END SUBROUTINE ice_thd_1d2d
+
+
+   SUBROUTINE ice_thd_init
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_init *** 
+      !!                 
+      !! ** Purpose :   Physical constants and parameters associated with
+      !!                ice thermodynamics
+      !!
+      !! ** Method  :   Read the namthd namelist and check the parameters
+      !!                called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namthd
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namthd in reference namelist : Ice thermodynamics
+      READ  ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namthd in configuration namelist : Ice thermodynamics
+      READ  ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namthd )
+      !
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*) 'ice_thd_init: Ice Thermodynamics'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namthd:'
+         WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)   ln_icedH  = ', ln_icedH
+         WRITE(numout,*) '      activate lateral melting (T) or not (F)                 ln_icedA  = ', ln_icedA
+         WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)        ln_icedO  = ', ln_icedO
+         WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)   ln_icedS  = ', ln_icedS
+     ENDIF
+      !
+                       CALL ice_thd_zdf_init   ! set ice heat diffusion parameters
+      IF( ln_icedA )   CALL ice_thd_da_init    ! set ice lateral melting parameters
+      IF( ln_icedO )   CALL ice_thd_do_init    ! set ice growth in open water parameters
+                       CALL ice_thd_sal_init   ! set ice salinity parameters
+      !
+      IF( ln_icedS .AND. nn_icesal == 1 ) THEN
+         ln_icedS = .FALSE.
+         CALL ctl_warn('ln_icedS is set to false since constant ice salinity is chosen (nn_icesal=1)')
+      ENDIF
+      !
+   END SUBROUTINE ice_thd_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy module          NO  ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90	(revision 8586)
@@ -0,0 +1,203 @@
+MODULE icethd_da
+   !!======================================================================
+   !!                       ***  MODULE icethd_da ***
+   !!   sea-ice : lateral melting
+   !!======================================================================
+   !! History :  4.0  ! 2016-03 (C. Rousset)  original code
+   !!---------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_thd_da        : sea ice lateral melting
+   !!   ice_thd_da_init   : sea ice lateral melting initialization
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE phycst         ! physical constants (ocean directory)
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamic 1D variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_thd_da        ! called by icethd.F90
+   PUBLIC   ice_thd_da_init   ! called by icestp.F90
+
+   ! ** namelist (namthd_da) **
+   REAL(wp) ::   rn_beta     ! coef. beta for lateral melting param.
+   REAL(wp) ::   rn_dmin     ! minimum floe diameter for lateral melting param.
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd_da.F90 5123 2015-03-04 16:06:03Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_thd_da
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_thd_da  ***    
+      !!   
+      !! ** Purpose :   computes sea ice lateral melting
+      !!
+      !! ** Method  :   dA/dt = - P * W   [s-1]
+      !!                   W = melting velocity [m.s-1]
+      !!                   P = perimeter of ice-ocean lateral interface normalized by grid cell area [m.m-2]
+      !!
+      !!                   W = m1 * (Tw -Tf)**m2                    --- originally from Josberger 1979 ---
+      !!                      (Tw - Tf) = elevation of water temp above freezing
+      !!                      m1 and m2 = (1.6e-6 , 1.36) best fit from field experiment near the coast of Prince Patrick Island
+      !!                                                                                           (Perovich 1983) => static ice
+      !!                      m1 and m2 = (3.0e-6 , 1.36) best fit from MIZEX 84 experiment
+      !!                                                                                (Maykut and Perovich 1987) => moving ice
+      !!
+      !!                   P = N * pi * D                           --- from Rothrock and Thorndike 1984 ---
+      !!                      D = mean floe caliper diameter
+      !!                      N = number of floes = ice area / floe area(average) = A / (Cs * D**2)
+      !!                         A = ice concentration
+      !!                         Cs = deviation from a square (square:Cs=1 ; circle:Cs=pi/4 ; floe:Cs=0.66)
+      !!
+      !!                   D = Dmin * ( Astar / (Astar-A) )**beta   --- from Lupkes et al., 2012 (eq. 26-27) ---
+      !!                                                             
+      !!                      Astar = 1 / ( 1 - (Dmin/Dmax)**(1/beta) )
+      !!                      Dmin = minimum floe diameter (recommended to be 8m +- 20%)
+      !!                      Dmax = maximum floe diameter (recommended to be 300m,
+      !!                                                    but it does not impact melting much except for Dmax<100m)
+      !!                      beta = 1.0 +-20% (recommended value)
+      !!                           = 0.3 best fit for western Fram Strait and Antarctica
+      !!                           = 1.4 best fit for eastern Fram Strait
+      !!
+      !! ** Tunable parameters  :   We propose to tune the lateral melting via 2 parameters
+      !!                               Dmin [6-10m]   => 6  vs 8m = +40% melting at the peak (A~0.5)
+      !!                                                 10 vs 8m = -20% melting
+      !!                               beta [0.8-1.2] => decrease = more melt and melt peaks toward higher concentration
+      !!                                                                  (A~0.5 for beta=1 ; A~0.8 for beta=0.2)
+      !!                                                 0.3 = best fit for western Fram Strait and Antarctica
+      !!                                                 1.4 = best fit for eastern Fram Strait
+      !!
+      !! ** Note   :   Former and more simple formulations for floe diameters can be found in Mai (1995), 
+      !!               Birnbaum and Lupkes (2002), Lupkes and Birnbaum (2005). They are reviewed in Lupkes et al 2012
+      !!               A simpler implementation for CICE can be found in Bitz et al (2001) and Tsamados et al (2015)
+      !!
+      !! ** References
+      !!    Bitz, C. M., Holland, M. M., Weaver, A. J., & Eby, M. (2001).
+      !!              Simulating the ice‐thickness distribution in a coupled climate model.
+      !!              Journal of Geophysical Research: Oceans, 106(C2), 2441-2463.
+      !!    Josberger, E. G. (1979).
+      !!              Laminar and turbulent boundary layers adjacent to melting vertical ice walls in salt water
+      !!              (No. SCIENTIFIC-16). WASHINGTON UNIV SEATTLE DEPT OF ATMOSPHERIC SCIENCES.
+      !!    Lüpkes, C., Gryanik, V. M., Hartmann, J., & Andreas, E. L. (2012).
+      !!              A parametrization, based on sea ice morphology, of the neutral atmospheric drag coefficients
+      !!              for weather prediction and climate models.
+      !!              Journal of Geophysical Research: Atmospheres, 117(D13).
+      !!    Maykut, G. A., & Perovich, D. K. (1987).
+      !!              The role of shortwave radiation in the summer decay of a sea ice cover.
+      !!              Journal of Geophysical Research: Oceans, 92(C7), 7032-7044.
+      !!    Perovich, D. K. (1983).
+      !!              On the summer decay of a sea ice cover. (Doctoral dissertation, University of Washington).
+      !!    Rothrock, D. A., & Thorndike, A. S. (1984).
+      !!              Measuring the sea ice floe size distribution.
+      !!              Journal of Geophysical Research: Oceans, 89(C4), 6477-6486.
+      !!    Tsamados, M., Feltham, D., Petty, A., Schroeder, D., & Flocco, D. (2015).
+      !!              Processes controlling surface, bottom and lateral melt of Arctic sea ice in a state of the art sea ice model.
+      !!              Phil. Trans. R. Soc. A, 373(2052), 20140167.
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji     ! dummy loop indices
+      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda
+      REAL(wp), PARAMETER ::   zdmax = 300._wp
+      REAL(wp), PARAMETER ::   zcs   = 0.66_wp
+      REAL(wp), PARAMETER ::   zm1   = 3.e-6_wp
+      REAL(wp), PARAMETER ::   zm2   = 1.36_wp
+      !
+      REAL(wp), DIMENSION(jpij) ::   zda_tot
+      !!---------------------------------------------------------------------
+      !
+      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) )
+      DO ji = 1, npti   
+         ! --- Calculate reduction of total sea ice concentration --- !
+         zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta         ! Mean floe caliper diameter [m]
+         !
+         zperi  = at_i_1d(ji) * rpi / ( zcs * zdfloe )                             ! Mean perimeter of the floe [m.m-2]
+         !                                                                         !    = N*pi*D = (A/cs*D^2)*pi*D
+         zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s]
+         !
+         zda_tot(ji) = MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) )                 ! sea ice concentration decrease (>0)
+      
+         ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- !
+         IF( a_i_1d(ji) > 0._wp ) THEN
+            ! decrease of concentration for the category jl
+            !    each category contributes to melting in proportion to its concentration
+            zda = MIN( a_i_1d(ji), zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) )
+            
+            ! Contribution to salt flux
+            sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoic *  h_i_1d(ji) * zda * s_i_1d(ji) * r1_rdtice
+            
+            ! Contribution to heat flux into the ocean [W.m-2], (<0)  
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_rdtice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  &
+                                                                + h_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) ) 
+            
+            ! Contribution to mass flux
+            wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_rdtice * ( rhoic * h_i_1d(ji) + rhosn * h_s_1d(ji) )
+            
+            ! new concentration
+            a_i_1d(ji) = a_i_1d(ji) - zda
+
+            ! ensure that h_i = 0 where a_i = 0
+            IF( a_i_1d(ji) == 0._wp ) THEN
+               h_i_1d(ji) = 0._wp
+               h_s_1d(ji) = 0._wp
+            ENDIF
+         ENDIF
+      END DO
+      !
+   END SUBROUTINE ice_thd_da
+
+   SUBROUTINE ice_thd_da_init
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_da_init *** 
+      !!                 
+      !! ** Purpose :   Physical constants and parameters associated with
+      !!                ice thermodynamics
+      !!
+      !! ** Method  :   Read the namthd_da namelist and check the parameters
+      !!                called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namthd_da
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namthd_da/ rn_beta, rn_dmin
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namthd_da in reference namelist : Ice thermodynamics
+      READ  ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namthd_da in configuration namelist : Ice thermodynamics
+      READ  ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namthd_da )
+      !
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*) 'ice_thd_da_init: Ice lateral melting'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namthd_da:'
+         WRITE(numout,*) '      Coef. beta for lateral melting param.               rn_beta = ', rn_beta
+         WRITE(numout,*) '      Minimum floe diameter for lateral melting param.    rn_dmin = ', rn_dmin
+      ENDIF
+      !
+   END SUBROUTINE ice_thd_da_init
+  
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy Module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd_da
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_dh.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_dh.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_dh.F90	(revision 8586)
@@ -0,0 +1,678 @@
+MODULE icethd_dh
+   !!======================================================================
+   !!                       ***  MODULE icethd_dh ***
+   !!   seaice : thermodynamic growth and melt 
+   !!======================================================================
+   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D
+   !!                 ! 2005-06 (M. Vancoppenolle) 3D version 
+   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!            3.5  ! 2012-10 (G. Madec & co) salt flux + bug fixes 
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_thd_dh        : vertical sea-ice growth and melt
+   !!   ice_thd_snwblow   : distribute snow fall between ice and ocean
+  !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamics variables
+   USE icethd_sal     ! sea-ice: salinity profiles
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_thd_dh        ! called by ice_thd
+   PUBLIC   ice_thd_snwblow   ! called in sbcblk/sbcclio/sbccpl and here
+
+   INTERFACE ice_thd_snwblow
+      MODULE PROCEDURE ice_thd_snwblow_1d, ice_thd_snwblow_2d
+   END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd_dh.F90 8420 2017-08-08 12:18:46Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_thd_dh
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE ice_thd_dh  ***
+      !!
+      !! ** Purpose :   compute ice and snow thickness changes due to growing/melting
+      !!
+      !! ** Method  :   Ice/Snow surface melting arises from imbalance in surface fluxes
+      !!              Bottom accretion/ablation arises from flux budget
+      !!              Snow thickness can increase by precipitation and decrease by sublimation
+      !!              If snow load excesses Archmiede limit, snow-ice is formed by
+      !!              the flooding of sea-water in the snow
+      !!
+      !!                 1) Compute available flux of heat for surface ablation
+      !!                 2) Compute snow and sea ice enthalpies
+      !!                 3) Surface ablation and sublimation
+      !!                 4) Bottom accretion/ablation
+      !!                 5) Case of Total ablation
+      !!                 6) Snow ice formation
+      !!
+      !! References : Bitz and Lipscomb, 1999, J. Geophys. Res.
+      !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646   
+      !!              Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let. 
+      !!              Vancoppenolle et al.,2009, Ocean Modelling
+      !!------------------------------------------------------------------
+      INTEGER  ::   ji, jk       ! dummy loop indices
+      INTEGER  ::   iter         ! local integer
+
+      REAL(wp) ::   ztmelts      ! local scalar
+      REAL(wp) ::   zdum       
+      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
+      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity
+      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity
+      REAL(wp) ::   zswi2        ! switch for computation of bottom salinity
+      REAL(wp) ::   zgrr         ! bottom growth rate
+      REAL(wp) ::   zt_i_new     ! bottom formation temperature
+      REAL(wp) ::   z1_rho       ! 1/(rhosn+rau0-rhoic)
+
+      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean
+      REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg)
+      REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg)
+      REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg)
+      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean
+
+      REAL(wp), DIMENSION(jpij) ::   zqprec      ! energy of fallen snow                       (J.m-3)
+      REAL(wp), DIMENSION(jpij) ::   zq_su       ! heat for surface ablation                   (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zq_bo       ! heat for bottom ablation                    (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
+
+      REAL(wp), DIMENSION(jpij) ::   zdh_s_mel   ! snow melt 
+      REAL(wp), DIMENSION(jpij) ::   zdh_s_pre   ! snow precipitation 
+      REAL(wp), DIMENSION(jpij) ::   zdh_s_sub   ! snow sublimation
+
+      REAL(wp), DIMENSION(jpij,nlay_i) ::   zdeltah
+      REAL(wp), DIMENSION(jpij,nlay_i) ::   zh_i      ! ice layer thickness
+      INTEGER , DIMENSION(jpij,nlay_i) ::   icount    ! number of layers vanished by melting 
+
+      REAL(wp), DIMENSION(jpij) ::   zeh_i       ! total ice heat content  (J.m-2)
+      REAL(wp), DIMENSION(jpij) ::   zsnw        ! distribution of snow after wind blowing
+
+      REAL(wp) ::   zswitch_sal
+
+      INTEGER  ::   num_iter_max      ! Heat conservation 
+      !!------------------------------------------------------------------
+
+      ! Discriminate between time varying salinity and constant
+      SELECT CASE( nn_icesal )                  ! varying salinity or not
+         CASE( 1 , 3 )   ;   zswitch_sal = 0._wp   ! prescribed salinity profile
+         CASE( 2 )       ;   zswitch_sal = 1._wp   ! varying salinity profile
+      END SELECT
+
+      ! initialize layer thicknesses and enthalpies
+      h_i_old (1:npti,0:nlay_i+1) = 0._wp
+      eh_i_old(1:npti,0:nlay_i+1) = 0._wp
+      DO jk = 1, nlay_i
+         DO ji = 1, npti
+            h_i_old (ji,jk) = h_i_1d(ji) * r1_nlay_i
+            eh_i_old(ji,jk) = e_i_1d(ji,jk) * h_i_old(ji,jk)
+         END DO
+      END DO
+      !
+      !------------------------------------------------------------------------------!
+      !  1) Calculate available heat for surface and bottom ablation                 !
+      !------------------------------------------------------------------------------!
+      !
+      DO ji = 1, npti
+         zdum       = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
+         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
+
+         zq_su (ji) = MAX( 0._wp, zdum      * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
+         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! If snow temperature is above freezing point, then snow melts 
+      ! (should not happen but sometimes it does)
+      !------------------------------------------------------------------------------!
+      DO ji = 1, npti
+         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting
+            ! Contribution to heat flux to the ocean [W.m-2], < 0  
+            hfx_res_1d(ji) = hfx_res_1d(ji) + e_s_1d(ji,1) * h_s_1d(ji) * a_i_1d(ji) * r1_rdtice
+            ! Contribution to mass flux
+            wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhosn * h_s_1d(ji) * a_i_1d(ji) * r1_rdtice
+            ! updates
+            h_s_1d(ji)   = 0._wp
+            e_s_1d (ji,1) = 0._wp
+            t_s_1d (ji,1) = rt0
+         END IF
+      END DO
+
+      !------------------------------------------------------------!
+      !  2) Computing layer thicknesses and enthalpies.            !
+      !------------------------------------------------------------!
+      DO jk = 1, nlay_i
+         DO ji = 1, npti
+            zh_i(ji,jk) = h_i_1d(ji) * r1_nlay_i
+            zeh_i(ji)   = zeh_i(ji) + e_i_1d(ji,jk) * zh_i(ji,jk)
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------|
+      !  3) Surface ablation and sublimation                                         |
+      !------------------------------------------------------------------------------|
+      !
+      !-------------------------
+      ! 3.1 Snow precips / melt
+      !-------------------------
+      ! Snow accumulation in one thermodynamic time step
+      ! snowfall is partitionned between leads and ice
+      ! if snow fall was uniform, a fraction (1-at_i) would fall into leads
+      ! but because of the winds, more snow falls on leads than on sea ice
+      ! and a greater fraction (1-at_i)^beta of the total mass of snow 
+      ! (beta < 1) falls in leads.
+      ! In reality, beta depends on wind speed, 
+      ! and should decrease with increasing wind speed but here, it is 
+      ! considered as a constant. an average value is 0.66
+      ! Martin Vancoppenolle, December 2006
+
+      CALL ice_thd_snwblow( 1. - at_i_1d(1:npti), zsnw(1:npti) ) ! snow distribution over ice after wind blowing
+
+      zdeltah(1:npti,:) = 0._wp
+      DO ji = 1, npti
+         !-----------
+         ! Snow fall
+         !-----------
+         ! thickness change
+         zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji)
+         ! enthalpy of the precip (>0, J.m-3)
+         zqprec   (ji) = - qprec_ice_1d(ji)   
+         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp
+         ! heat flux from snow precip (>0, W.m-2)
+         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
+         ! mass flux, <0
+         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice
+
+         !---------------------
+         ! Melt of falling snow
+         !---------------------
+         ! thickness change
+         rswitch        = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) )
+         zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
+         zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting 
+         ! heat used to melt snow (W.m-2, >0)
+         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
+         ! snow melting only = water into the ocean (then without snow precip), >0
+         wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
+         ! updates available heat + precipitations after melting
+         zq_su     (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )      
+         zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+
+         ! update thickness
+         h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdh_s_pre(ji) )
+      END DO
+
+      ! If heat still available (zq_su > 0), then melt more snow
+      zdeltah(1:npti,:) = 0._wp
+      zdh_s_mel(1:npti) = 0._wp
+      DO jk = 1, nlay_s
+         DO ji = 1, npti
+            ! thickness change
+            rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) ) 
+            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,jk) - epsi20 ) ) ) 
+            zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( e_s_1d(ji,jk), epsi20 )
+            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - h_s_1d(ji) ) ! bound melting
+            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)    
+            ! heat used to melt snow(W.m-2, >0)
+            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d(ji,jk) * r1_rdtice 
+            ! snow melting only = water into the ocean (then without snow precip)
+            wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+            ! updates available heat + thickness
+            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) )
+            h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdeltah(ji,jk) )
+         END DO
+      END DO
+
+      !------------------------------
+      ! 3.2 Sublimation (part1: snow) 
+      !------------------------------
+      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
+      ! clem comment: not counted in mass/heat exchange in iceupdate.F90 since this is an exchange with atm. (not ocean)
+      zdeltah(1:npti,:) = 0._wp
+      DO ji = 1, npti
+         zdh_s_sub(ji)  = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
+         ! remaining evap in kg.m-2 (used for ice melting later on)
+         zevap_rema(ji)  = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhosn
+         ! Heat flux by sublimation [W.m-2], < 0 (sublimate first snow that had fallen, then pre-existing snow)
+         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
+         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1)  &
+            &                              ) * a_i_1d(ji) * r1_rdtice
+         ! Mass flux by sublimation
+         wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
+
+         ! new snow thickness
+         h_s_1d(ji)    =  MAX( 0._wp , h_s_1d(ji) + zdh_s_sub(ji) )
+         ! update precipitations after sublimation and correct sublimation
+         zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+         zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1)
+      END DO
+      
+      ! --- Update snow diags --- !
+      DO ji = 1, npti
+         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
+      END DO
+
+      !-------------------------------------------
+      ! 3.3 Update temperature, energy
+      !-------------------------------------------
+      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow)
+      DO jk = 1, nlay_s
+         DO ji = 1,npti
+            rswitch       = MAX( 0._wp , SIGN( 1._wp, h_s_1d(ji) - epsi20 ) )
+            e_s_1d(ji,jk) = rswitch / MAX( h_s_1d(ji), epsi20 ) *           &
+              &            ( ( zdh_s_pre(ji)               ) * zqprec(ji) +  &
+              &              ( h_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
+         END DO
+      END DO
+
+      !--------------------------
+      ! 3.4 Surface ice ablation 
+      !--------------------------
+      zdeltah(1:npti,:) = 0._wp ! important
+      DO jk = 1, nlay_i
+         DO ji = 1, npti
+            ztmelts           = - tmut * sz_i_1d(ji,jk)          ! Melting point of layer k [C]
+            
+            IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN !!! Internal melting
+
+               zEi            = - e_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]       
+               zdE            = 0._wp                                 ! Specific enthalpy difference   (J/kg, <0)
+                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted)
+               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing     
+                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this
+               zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0
+                         
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+
+               ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
+               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+               
+               ! Contribution to salt flux (clem: using s_i_1d and not sz_i_1d(jk) is ok)
+               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+            ELSE                                !!! Surface melting
+               
+               zEi            = - e_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]
+               zEw            =    rcp * ztmelts                      ! Specific enthalpy of resulting meltwater [J/kg, <0]
+               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
+               
+               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0]
+               
+               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0]
+               
+               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
+               
+               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
+               
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+               
+               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
+               
+               ! Contribution to salt flux >0 (clem: using s_i_1d and not sz_i_1d(jk) is ok)
+               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to heat flux [W.m-2], < 0
+               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+               
+               ! Total heat flux used in this process [W.m-2], > 0  
+               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+               
+            END IF
+            ! ----------------------
+            ! Sublimation part2: ice
+            ! ----------------------
+            zdum      = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoic )
+            zdeltah(ji,jk) = zdeltah(ji,jk) + zdum
+            dh_i_sub(ji)  = dh_i_sub(ji) + zdum
+            ! Salt flux > 0 (clem2016: flux is sent to the ocean for simplicity but salt should remain in the ice except if all ice is melted.
+            !                          It must be corrected at some point)
+            sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_rdtice
+            ! Heat flux [W.m-2], < 0
+            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice
+            ! Mass flux > 0
+            wfx_ice_sub_1d(ji) =  wfx_ice_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * r1_rdtice
+
+            ! update remaining mass flux
+            zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoic
+            
+            ! record which layers have disappeared (for bottom melting) 
+            !    => icount=0 : no layer has vanished
+            !    => icount=5 : 5 layers have vanished
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
+            icount(ji,jk) = NINT( rswitch )
+            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
+                        
+            ! update heat content (J.m-2) and layer thickness
+            eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk)
+            h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
+         END DO
+      END DO
+      ! update ice thickness
+      DO ji = 1, npti
+         h_i_1d(ji) =  MAX( 0._wp , h_i_1d(ji) + dh_i_surf(ji) + dh_i_sub(ji) )
+      END DO
+
+      ! remaining "potential" evap is sent to ocean
+      DO ji = 1, npti
+         wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
+      END DO
+
+
+      !------------------------------------------------------------------------------!
+      ! 4) Basal growth / melt                                                       !
+      !------------------------------------------------------------------------------!
+      !
+      !------------------
+      ! 4.1 Basal growth 
+      !------------------
+      ! Basal growth is driven by heat imbalance at the ice-ocean interface,
+      ! between the inner conductive flux  (fc_bo_i), from the open water heat flux 
+      ! (fhld) and the turbulent ocean flux (fhtur). 
+      ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice 
+
+      ! If salinity varies in time, an iterative procedure is required, because
+      ! the involved quantities are inter-dependent.
+      ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi),
+      ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott)
+      ! -> need for an iterative procedure, which converges quickly
+
+      num_iter_max = 1
+      IF( nn_icesal == 2 )   num_iter_max = 5  ! salinity varying in time
+      
+      ! Iterative procedure
+      DO ji = 1, npti
+         IF(  zf_tt(ji) < 0._wp  ) THEN
+            DO iter = 1, num_iter_max
+
+               ! New bottom ice salinity (Cox & Weeks, JGR88 )
+               !--- zswi1  if dh/dt < 2.0e-8
+               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 
+               !--- zswi2  if dh/dt > 3.6e-7
+               zgrr               = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) )
+               zswi2              = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) )
+               zswi12             = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 )
+               zswi1              = 1. - zswi2 * zswi12
+               zfracs             = MIN ( zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   &
+                  &               + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 )
+
+               s_i_new(ji)        = zswitch_sal * zfracs * sss_1d(ji)  &  ! New ice salinity
+                                  + ( 1. - zswitch_sal ) * s_i_1d(ji) 
+               ! New ice growth
+               ztmelts            = - tmut * s_i_new(ji)                 ! New ice melting point (C)
+
+               zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
+               
+               zEi                = cpic * ( zt_i_new - (ztmelts+rt0) ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
+                  &               - lfus * ( 1.0 - ztmelts / ( zt_i_new - rt0 ) )   &
+                  &               + rcp  * ztmelts          
+
+               zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
+
+               zdE                = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
+
+               dh_i_bott(ji)      = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) )
+               
+            END DO
+            ! Contribution to Energy and Salt Fluxes                                    
+            zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0)
+
+            ztmelts        = - tmut * s_i_new(ji)                ! New ice melting point (C)
+            
+            zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
+            
+            zEi            = cpic * ( zt_i_new - (ztmelts+rt0) ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
+               &               - lfus * ( 1.0 - ztmelts / ( zt_i_new - rt0 ) )   &
+               &               + rcp  * ztmelts          
+            
+            zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
+            
+            zdE            = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
+            
+            ! Contribution to heat flux to the ocean [W.m-2], >0  
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+
+            ! Total heat flux used in this process [W.m-2], <0  
+            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+            
+            ! Contribution to salt flux, <0
+            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice
+
+            ! Contribution to mass flux, <0
+            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * r1_rdtice
+
+            ! update heat content (J.m-2) and layer thickness
+            eh_i_old(ji,nlay_i+1) = eh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * (-zEi * rhoic)
+            h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji)
+
+         ENDIF
+
+      END DO
+
+      !----------------
+      ! 4.2 Basal melt
+      !----------------
+      zdeltah(1:npti,:) = 0._wp ! important
+      DO jk = nlay_i, 1, -1
+         DO ji = 1, npti
+            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting 
+
+               ztmelts = - tmut * sz_i_1d(ji,jk)  ! Melting point of layer jk (C)
+
+               IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN !!! Internal melting
+
+                  zEi               = - e_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0)
+                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0)
+                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted)
+                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing     
+                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this
+
+                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk)
+
+                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0
+
+                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
+                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+
+                  ! Contribution to salt flux (clem: using s_i_1d and not sz_i_1d(jk) is ok)
+                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice
+                                    
+                  ! Contribution to mass flux
+                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+                  ! update heat content (J.m-2) and layer thickness
+                  eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk)
+                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
+
+               ELSE                               !!! Basal melting
+
+                  zEi             = - e_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0)
+                  zEw             = rcp * ztmelts              ! Specific enthalpy of meltwater (J/kg, <0)
+                  zdE             = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0)
+
+                  zfmdt           = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0)
+
+                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic         ! Gross thickness change
+
+                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
+                  
+                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
+
+                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt
+
+                  zfmdt           = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
+
+                  zQm             = zfmdt * zEw         ! Heat exchanged with ocean
+
+                  ! Contribution to heat flux to the ocean [W.m-2], <0  
+                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+
+                  ! Contribution to salt flux (clem: using s_i_1d and not sz_i_1d(jk) is ok)
+                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice
+                  
+                  ! Total heat flux used in this process [W.m-2], >0  
+                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+                  
+                  ! Contribution to mass flux
+                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+                  ! update heat content (J.m-2) and layer thickness
+                  eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk)
+                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
+               ENDIF
+           
+            ENDIF
+         END DO
+      END DO
+
+      !-------------------------------------------
+      ! Update temperature, energy
+      !-------------------------------------------
+      DO ji = 1, npti
+         h_i_1d(ji) =  MAX( 0._wp , h_i_1d(ji) + dh_i_bott(ji) )
+      END DO  
+
+      !-------------------------------------------
+      ! 5. What to do with remaining energy
+      !-------------------------------------------
+      ! If heat still available for melting and snow remains, then melt more snow
+      !-------------------------------------------
+      zdeltah(1:npti,:) = 0._wp ! important
+      DO ji = 1, npti
+         zq_rema(ji)     = zq_su(ji) + zq_bo(ji) 
+         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) )   ! =1 if snow
+         rswitch         = rswitch * MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,1) - epsi20 ) )
+         zdeltah  (ji,1) = - rswitch * zq_rema(ji) / MAX( e_s_1d(ji,1), epsi20 )
+         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - h_s_1d(ji) ) ) ! bound melting
+         dh_s_tot (ji)   = dh_s_tot(ji)  + zdeltah(ji,1)
+         h_s_1d   (ji)  = h_s_1d(ji)   + zdeltah(ji,1)
+        
+         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * e_s_1d(ji,1)                ! update available heat (J.m-2)
+         ! heat used to melt snow
+         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0)
+         ! Contribution to mass flux
+         wfx_snw_sum_1d(ji)  =  wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
+         !    
+         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget
+         hfx_out_1d(ji)  = hfx_out_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
+
+         IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
+      END DO
+
+      !
+      !------------------------------------------------------------------------------|
+      !  6) Snow-Ice formation                                                       |
+      !------------------------------------------------------------------------------|
+      ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level, 
+      ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice
+      z1_rho = 1._wp / ( rhosn+rau0-rhoic )
+      DO ji = 1, npti
+         !
+         dh_snowice(ji) = MAX(  0._wp , ( rhosn * h_s_1d(ji) + (rhoic-rau0) * h_i_1d(ji) ) * z1_rho )
+
+         h_i_1d(ji)    = h_i_1d(ji) + dh_snowice(ji)
+         h_s_1d(ji)    = h_s_1d(ji) - dh_snowice(ji)
+
+         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0)
+         zfmdt          = ( rhosn - rhoic ) * dh_snowice(ji)    ! <0
+         zEw            = rcp * sst_1d(ji)
+         zQm            = zfmdt * zEw 
+         
+         ! Contribution to heat flux
+         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
+
+         ! Contribution to salt flux
+         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_rdtice 
+
+         ! Case constant salinity in time: virtual salt flux to keep salinity constant
+         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
+            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m     into the ocean
+               &                            - s_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice    ! and get  rn_icesal from the ocean 
+         ENDIF
+
+         ! Contribution to mass flux
+         ! All snow is thrown in the ocean, and seawater is taken to replace the volume
+         wfx_sni_1d(ji)     = wfx_sni_1d(ji)     - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice
+         wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice
+
+         ! update heat content (J.m-2) and layer thickness
+         eh_i_old(ji,0) = eh_i_old(ji,0) + dh_snowice(ji) * e_s_1d(ji,1) + zfmdt * zEw
+         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji)
+         
+      END DO
+
+      !
+      !-------------------------------------------
+      ! Update temperature, energy
+      !-------------------------------------------
+      DO ji = 1, npti
+         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 
+         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0
+      END DO
+
+      DO jk = 1, nlay_s
+         DO ji = 1,npti
+            ! mask enthalpy
+            rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp, - h_s_1d(ji) )  )
+            e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk)
+            ! recalculate t_s_1d from e_s_1d
+            t_s_1d(ji,jk) = rt0 + rswitch * ( - e_s_1d(ji,jk) * r1_rhosn * r1_cpic + lfus * r1_cpic )
+         END DO
+      END DO
+
+      ! --- ensure that a_i = 0 where h_i = 0 ---
+      WHERE( h_i_1d(1:npti) == 0._wp )   a_i_1d(1:npti) = 0._wp
+      !
+   END SUBROUTINE ice_thd_dh
+
+
+   !!--------------------------------------------------------------------------
+   !! INTERFACE ice_thd_snwblow
+   !! ** Purpose :   Compute distribution of precip over the ice
+   !!--------------------------------------------------------------------------
+!!gm  I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE....
+   SUBROUTINE ice_thd_snwblow_2d( pin, pout )
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( 1. - a_i_b )
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_blow_s )
+   END SUBROUTINE ice_thd_snwblow_2d
+
+   SUBROUTINE ice_thd_snwblow_1d( pin, pout )
+      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin
+      REAL(wp), DIMENSION(:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_blow_s )
+   END SUBROUTINE ice_thd_snwblow_1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd_dh
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90	(revision 8586)
@@ -0,0 +1,526 @@
+MODULE icethd_do
+   !!======================================================================
+   !!                       ***  MODULE icethd_do   ***
+   !!   sea-ice: sea ice growth in the leads (open water)  
+   !!======================================================================
+   !! History :  LIM  ! 2005-12 (M. Vancoppenolle)  Original code
+   !!             -   ! 2006-01 (M. Vancoppenolle)  add ITD
+   !!            3.0  ! 2007-07 (M. Vancoppenolle)  Mass and energy conservation tested
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_thd_do        : ice growth in open water (=lateral accretion of ice)
+   !!   ice_thd_do_init   : initialization
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE sbc_oce , ONLY : sss_m
+   USE sbc_ice , ONLY : utau_ice, vtau_ice
+   USE ice1D          ! sea-ice: thermodynamics variables
+   USE ice            ! sea-ice: variables
+   USE icetab         ! sea-ice: 2D <==> 1D
+   USE icectl         ! sea-ice: conservation
+   USE icethd_ent     ! sea-ice: thermodynamics, enthalpy
+   USE icevar         ! sea-ice: operations
+   USE icethd_sal     ! sea-ice: salinity profiles
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_thd_do        ! called by ice_thd
+   PUBLIC   ice_thd_do_init   ! called by ice_stp
+
+   ! ** namelist (namthd_do) **
+   REAL(wp) ::   rn_hinew         ! thickness for new ice formation (m)
+   LOGICAL  ::   ln_frazil        ! use of frazil ice collection as function of wind (T) or not (F)
+   REAL(wp) ::   rn_maxfraz       ! maximum portion of frazil ice collecting at the ice bottom
+   REAL(wp) ::   rn_vfraz         ! threshold drift speed for collection of bottom frazil ice
+   REAL(wp) ::   rn_Cfraz         ! squeezing coefficient for collection of bottom frazil ice
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd_do.F90 8420 2017-08-08 12:18:46Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_thd_do
+      !!-------------------------------------------------------------------
+      !!               ***   ROUTINE ice_thd_do  ***
+      !!  
+      !! ** Purpose : Computation of the evolution of the ice thickness and 
+      !!      concentration as a function of the heat balance in the leads.
+      !!       
+      !! ** Method  : Ice is formed in the open water when ocean lose heat
+      !!      (heat budget of open water Bl is negative) .
+      !!      Computation of the increase of 1-A (ice concentration) fol-
+      !!      lowing the law :
+      !!      (dA/dt)acc = F[ (1-A)/(1-a) ] * [ Bl / (Li*h0) ]
+      !!       where - h0 is the thickness of ice created in the lead
+      !!             - a is a minimum fraction for leads
+      !!             - F is a monotonic non-increasing function defined as:
+      !!                  F(X)=( 1 - X**exld )**(1.0/exld)
+      !!             - exld is the exponent closure rate (=2 default val.)
+      !! 
+      !! ** Action : - Adjustment of snow and ice thicknesses and heat
+      !!                content in brine pockets
+      !!             - Updating ice internal temperature
+      !!             - Computation of variation of ice volume and mass
+      !!             - Computation of a_i after lateral accretion and 
+      !!               update h_s_1d, h_i_1d      
+      !!------------------------------------------------------------------------
+      INTEGER  ::   ji,jj,jk,jl      ! dummy loop indices
+      INTEGER  ::   iter     !   -       -
+      REAL(wp) ::   ztmelts, zfrazb, zweight, zde                          ! local scalars
+      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      -
+      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      -
+
+      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean)
+      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg)
+      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg)
+      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean)
+     
+      REAL(wp) ::   zv_newfra
+  
+      INTEGER , DIMENSION(jpij) ::   jcat        ! indexes of categories where new ice grows
+      REAL(wp), DIMENSION(jpij) ::   zswinew     ! switch for new ice or not
+
+      REAL(wp), DIMENSION(jpij) ::   zv_newice   ! volume of accreted ice
+      REAL(wp), DIMENSION(jpij) ::   za_newice   ! fractional area of accreted ice
+      REAL(wp), DIMENSION(jpij) ::   zh_newice   ! thickness of accreted ice
+      REAL(wp), DIMENSION(jpij) ::   ze_newice   ! heat content of accreted ice
+      REAL(wp), DIMENSION(jpij) ::   zs_newice   ! salinity of accreted ice
+      REAL(wp), DIMENSION(jpij) ::   zo_newice   ! age of accreted ice
+      REAL(wp), DIMENSION(jpij) ::   zdv_res     ! residual volume in case of excessive heat budget
+      REAL(wp), DIMENSION(jpij) ::   zda_res     ! residual area in case of excessive heat budget
+      REAL(wp), DIMENSION(jpij) ::   zv_frazb    ! accretion of frazil ice at the ice bottom
+      REAL(wp), DIMENSION(jpij) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector)
+
+      REAL(wp), DIMENSION(jpij,jpl) ::   zv_b      ! old volume of ice in category jl
+      REAL(wp), DIMENSION(jpij,jpl) ::   za_b      ! old area of ice in category jl
+
+      REAL(wp), DIMENSION(jpij,nlay_i,jpl) ::   ze_i_2d !: 1-D version of e_i
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   zvrel     ! relative ice / frazil velocity
+
+      REAL(wp) :: zcai = 1.4e-3_wp                     ! ice-air drag (clem: should be dependent on coupling/forcing used)
+      !!-----------------------------------------------------------------------!
+
+      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
+
+      CALL ice_var_agg(1)
+      CALL ice_var_glo2eqv
+
+      !------------------------------------------------------------------------------!
+      ! 3) Collection thickness of ice formed in leads and polynyas
+      !------------------------------------------------------------------------------!    
+      ! ht_i_new is the thickness of new ice formed in open water
+      ! ht_i_new can be either prescribed (frazswi = 0) or computed (frazswi = 1)
+      ! Frazil ice forms in open water, is transported by wind
+      ! accumulates at the edge of the consolidated ice edge
+      ! where it forms aggregates of a specific thickness called
+      ! collection thickness.
+
+      ! Note : the following algorithm currently breaks vectorization
+      ! 
+
+      zvrel(:,:) = 0._wp
+
+      ! Default new ice thickness
+      WHERE( qlead(:,:) < 0._wp )   ;   ht_i_new(:,:) = rn_hinew
+      ELSEWHERE                     ;   ht_i_new(:,:) = 0._wp
+      END WHERE
+
+      IF( ln_frazil ) THEN
+
+         !--------------------
+         ! Physical constants
+         !--------------------
+         ht_i_new(:,:) = 0._wp
+
+         zhicrit = 0.04 ! frazil ice thickness
+         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav
+         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag)
+         zgamafr = 0.03
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast
+                  !-------------
+                  ! Wind stress
+                  !-------------
+                  ! C-grid wind stress components
+                  ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   &
+                     &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp
+                  ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   &
+                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
+                  ! Square root of wind stress
+                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
+
+                  !---------------------
+                  ! Frazil ice velocity
+                  !---------------------
+                  rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) )
+                  zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 )
+                  zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 )
+
+                  !-------------------
+                  ! Pack ice velocity
+                  !-------------------
+                  ! C-grid ice velocity
+                  zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
+                  zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
+
+                  !-----------------------------------
+                  ! Relative frazil/pack ice velocity
+                  !-----------------------------------
+                  ! absolute relative velocity
+                  rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
+                  zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   &
+                     &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch
+                  zvrel(ji,jj) = SQRT( zvrel2 )
+
+                  !---------------------
+                  ! Iterative procedure
+                  !---------------------
+                  ht_i_new(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    &
+                     &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2
+
+                  iter = 1
+                  DO WHILE ( iter < 20 ) 
+                     zf  = ( ht_i_new(ji,jj) - zhicrit ) * ( ht_i_new(ji,jj) * ht_i_new(ji,jj) - zhicrit * zhicrit ) -   &
+                        &    ht_i_new(ji,jj) * zhicrit * ztwogp * zvrel2
+                     zfp = ( ht_i_new(ji,jj) - zhicrit ) * ( 3.0 * ht_i_new(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2
+
+                     ht_i_new(ji,jj) = ht_i_new(ji,jj) - zf / MAX( zfp, epsi20 )
+                     iter = iter + 1
+                  END DO
+
+               ENDIF ! end of selection of pixels where ice forms
+
+            END DO 
+         END DO 
+         ! 
+         CALL lbc_lnk_multi( zvrel, 'T', 1., ht_i_new, 'T', 1.  )
+
+      ENDIF ! End of computation of frazil ice collection thickness
+
+      !------------------------------------------------------------------------------!
+      ! 4) Identify grid points where new ice forms
+      !------------------------------------------------------------------------------!
+
+      !-------------------------------------
+      ! Select points for new ice formation
+      !-------------------------------------
+      ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice
+      npti = 0 ; nptidx(:) = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN
+               npti = npti + 1
+               nptidx( npti ) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+
+      !------------------------------
+      ! Move from 2-D to 1-D vectors
+      !------------------------------
+      ! If ocean gains heat do nothing. Otherwise compute new ice formation
+
+      IF ( npti > 0 ) THEN
+
+         CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti)      , at_i        )
+         CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i (:,:,:) )
+         CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i (:,:,:) )
+         CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i(:,:,:) )
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               CALL tab_2d_1d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) )
+            END DO
+         END DO
+         CALL tab_2d_1d( npti, nptidx(1:npti), qlead_1d  (1:npti) , qlead       )
+         CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d   (1:npti) , t_bo        )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_opw_1d(1:npti) , sfx_opw     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_opw_1d(1:npti) , wfx_opw     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), zh_newice (1:npti) , ht_i_new    )
+         CALL tab_2d_1d( npti, nptidx(1:npti), zvrel_1d  (1:npti) , zvrel       )
+
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d(1:npti) , hfx_thd     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d(1:npti) , hfx_opw     )
+         CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti) , rn_amax_2d  )
+         CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d    (1:npti) , sss_m       )
+
+         !------------------------------------------------------------------------------|
+         ! 2) Convert units for ice internal energy
+         !------------------------------------------------------------------------------|
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i               
+               WHERE( v_i_2d(1:npti,jl) > 0._wp )
+                  ze_i_2d(1:npti,jk,jl) = ze_i_2d(1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i )
+               ELSEWHERE
+                  ze_i_2d(1:npti,jk,jl) = 0._wp
+               END WHERE
+            END DO
+         END DO
+         !------------------------------------------------------------------------------!
+         ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice
+         !------------------------------------------------------------------------------!
+
+         !-----------------------------------------
+         ! Keep old ice areas and volume in memory
+         !-----------------------------------------
+         zv_b(1:npti,:) = v_i_2d(1:npti,:) 
+         za_b(1:npti,:) = a_i_2d(1:npti,:)
+
+         !----------------------
+         ! Salinity of new ice 
+         !----------------------
+         SELECT CASE ( nn_icesal )
+         CASE ( 1 )                    ! Sice = constant 
+            zs_newice(1:npti) = rn_icesal
+         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)]
+            DO ji = 1, npti
+               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_1d(ji) )
+            END DO
+         CASE ( 3 )                    ! Sice = F(z) [multiyear ice]
+            zs_newice(1:npti) =   2.3
+         END SELECT
+
+         !-------------------------
+         ! Heat content of new ice
+         !-------------------------
+         ! We assume that new ice is formed at the seawater freezing point
+         DO ji = 1, npti
+            ztmelts       = - tmut * zs_newice(ji)                  ! Melting point (C)
+            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - ( t_bo_1d(ji) - rt0 ) )                     &
+               &                       + lfus * ( 1.0 - ztmelts / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   &
+               &                       - rcp  *         ztmelts )
+         END DO
+
+         !----------------
+         ! Age of new ice
+         !----------------
+         zo_newice(1:npti) = 0._wp
+
+         !-------------------
+         ! Volume of new ice
+         !-------------------
+         DO ji = 1, npti
+
+            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg]
+
+            zEw           = rcp * ( t_bo_1d(ji) - rt0 )            ! specific enthalpy of seawater at t_bo_1d [J/kg]
+                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 
+                                                                   
+            zdE           = zEi - zEw                              ! specific enthalpy difference [J/kg]
+                                              
+            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0) 
+                                                                   ! clem: we use qlead instead of zqld (icethd) because we suppose we are at the freezing point   
+            zv_newice(ji) = - zfmdt * r1_rhoic
+
+            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux  
+
+            ! Contribution to heat flux to the ocean [W.m-2], >0  
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice
+            ! Total heat flux used in this process [W.m-2]  
+            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice
+            ! mass flux
+            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice
+            ! salt flux
+            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice
+         END DO
+         
+         zv_frazb(1:npti) = 0._wp
+         IF( ln_frazil ) THEN
+            ! A fraction zfrazb of frazil ice is accreted at the ice bottom
+            DO ji = 1, npti
+               rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - at_i_1d(ji) ) )
+               zfrazb        = rswitch * ( TANH( rn_Cfraz * ( zvrel_1d(ji) - rn_vfraz ) ) + 1.0 ) * 0.5 * rn_maxfraz
+               zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
+               zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
+            END DO
+         END IF
+         
+         !-----------------
+         ! Area of new ice
+         !-----------------
+         DO ji = 1, npti
+            za_newice(ji) = zv_newice(ji) / zh_newice(ji)
+         END DO
+
+         !------------------------------------------------------------------------------!
+         ! 6) Redistribute new ice area and volume into ice categories                  !
+         !------------------------------------------------------------------------------!
+
+         !------------------------
+         ! 6.1) lateral ice growth
+         !------------------------
+         ! If lateral ice growth gives an ice concentration gt 1, then
+         ! we keep the excessive volume in memory and attribute it later to bottom accretion
+         DO ji = 1, npti
+            IF ( za_newice(ji) >  ( rn_amax_1d(ji) - at_i_1d(ji) ) ) THEN
+               zda_res(ji)   = za_newice(ji) - ( rn_amax_1d(ji) - at_i_1d(ji) )
+               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji) 
+               za_newice(ji) = za_newice(ji) - zda_res  (ji)
+               zv_newice(ji) = zv_newice(ji) - zdv_res  (ji)
+            ELSE
+               zda_res(ji) = 0._wp
+               zdv_res(ji) = 0._wp
+            ENDIF
+         END DO
+
+         ! find which category to fill
+         DO jl = 1, jpl
+            DO ji = 1, npti
+               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN
+                  a_i_2d(ji,jl) = a_i_2d(ji,jl) + za_newice(ji)
+                  v_i_2d(ji,jl) = v_i_2d(ji,jl) + zv_newice(ji)
+                  jcat(ji) = jl
+               ENDIF
+            END DO
+         END DO
+         at_i_1d(1:npti) = SUM( a_i_2d(1:npti,:), dim=2 )
+
+         ! Heat content
+         DO ji = 1, npti
+            jl = jcat(ji)                                                    ! categroy in which new ice is put
+            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice
+         END DO
+
+         DO jk = 1, nlay_i
+            DO ji = 1, npti
+               jl = jcat(ji)
+               rswitch = MAX( 0._wp, SIGN( 1._wp , v_i_2d(ji,jl) - epsi20 ) )
+               ze_i_2d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                    &
+                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_2d(ji,jk,jl) * zv_b(ji,jl) )  &
+                  &        * rswitch / MAX( v_i_2d(ji,jl), epsi20 )
+            END DO
+         END DO
+
+         !------------------------------------------------
+         ! 6.2) bottom ice growth + ice enthalpy remapping
+         !------------------------------------------------
+         DO jl = 1, jpl
+
+            ! for remapping
+            h_i_old (1:npti,0:nlay_i+1) = 0._wp
+            eh_i_old(1:npti,0:nlay_i+1) = 0._wp
+            DO jk = 1, nlay_i
+               DO ji = 1, npti
+                  h_i_old (ji,jk) = v_i_2d(ji,jl) * r1_nlay_i
+                  eh_i_old(ji,jk) = ze_i_2d(ji,jk,jl) * h_i_old(ji,jk)
+               END DO
+            END DO
+
+            ! new volumes including lateral/bottom accretion + residual
+            DO ji = 1, npti
+               rswitch        = MAX( 0._wp, SIGN( 1._wp , at_i_1d(ji) - epsi20 ) )
+               zv_newfra     = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * a_i_2d(ji,jl) / MAX( at_i_1d(ji) , epsi20 )
+               a_i_2d(ji,jl) = rswitch * a_i_2d(ji,jl)               
+               v_i_2d(ji,jl) = v_i_2d(ji,jl) + zv_newfra
+               ! for remapping
+               h_i_old (ji,nlay_i+1) = zv_newfra
+               eh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra
+            ENDDO
+            ! --- Ice enthalpy remapping --- !
+            CALL ice_thd_ent( ze_i_2d(1:npti,:,jl) ) 
+         ENDDO
+
+         !-----------------
+         ! Update salinity
+         !-----------------
+         DO jl = 1, jpl
+            DO ji = 1, npti
+               sv_i_2d(ji,jl) = sv_i_2d(ji,jl) + zs_newice(ji) * ( v_i_2d(ji,jl) - zv_b(ji,jl) )
+            END DO
+         END DO
+
+         !------------------------------------------------------------------------------!
+         ! 8) Change units for e_i
+         !------------------------------------------------------------------------------!    
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               ze_i_2d(1:npti,jk,jl) = ze_i_2d(1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i 
+            END DO
+         END DO
+         !------------------------------------------------------------------------------!
+         ! 7) Change 2D vectors to 1D vectors 
+         !------------------------------------------------------------------------------!
+         CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i (:,:,:) )
+         CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i (:,:,:) )
+         CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i(:,:,:) )
+          DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               CALL tab_1d_2d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) )
+            END DO
+         END DO
+         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_opw_1d(1:npti), sfx_opw )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_opw_1d(1:npti), wfx_opw )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d(1:npti), hfx_thd )
+         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_opw_1d(1:npti), hfx_opw )
+         !
+      ENDIF ! npti > 0
+      !
+      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
+      !
+   END SUBROUTINE ice_thd_do
+
+   SUBROUTINE ice_thd_do_init
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_do_init *** 
+      !!                 
+      !! ** Purpose :   Physical constants and parameters associated with
+      !!                ice growth in the leads
+      !!
+      !! ** Method  :   Read the namthd_do namelist and check the parameters
+      !!                called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namthd_do
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namthd_do/ rn_hinew, ln_frazil, rn_maxfraz, rn_vfraz, rn_Cfraz
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namthd_do in reference namelist : Ice thermodynamics
+      READ  ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namthd_do in configuration namelist : Ice thermodynamics
+      READ  ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namthd_do )
+      !
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*) 'ice_thd_do_init: Ice growth in open water'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namthd_do:'
+         WRITE(numout,*) '      ice thickness for lateral accretion                       rn_hinew   = ', rn_hinew
+         WRITE(numout,*) '      Frazil ice thickness as a function of wind or not         ln_frazil  = ', ln_frazil
+         WRITE(numout,*) '      Maximum proportion of frazil ice collecting at bottom     rn_maxfraz = ', rn_maxfraz
+         WRITE(numout,*) '      Threshold relative drift speed for collection of frazil   rn_vfraz   = ', rn_vfraz
+         WRITE(numout,*) '      Squeezing coefficient for collection of frazil            rn_Cfraz   = ', rn_Cfraz
+      ENDIF
+      !
+      IF ( rn_hinew < rn_himin )   CALL ctl_stop( 'ice_thd_do_init : rn_hinew should be >= rn_himin' )
+      !
+   END SUBROUTINE ice_thd_do_init
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd_do
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_ent.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_ent.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_ent.F90	(revision 8586)
@@ -0,0 +1,146 @@
+MODULE icethd_ent
+   !!======================================================================
+   !!                       ***  MODULE icethd_ent   ***
+   !!   sea-ice: redistribution of enthalpy in the ice on the new vertical grid
+   !!                       after vertical growth/melt
+   !!======================================================================
+   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D
+   !!                 ! 2005-07 (M. Vancoppenolle) 3D version 
+   !!                 ! 2006-11 (X. Fettweis) Vectorized 
+   !!            3.0  ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2014-05 (C. Rousset) complete rewriting
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_thd_ent   : ice redistribution of enthalpy
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! domain variables
+   USE domain         !
+   USE phycst         ! physical constants
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamics variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_thd_ent         ! called by icethd and icethd_do
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd_ent.F90 8420 2017-08-08 12:18:46Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+   SUBROUTINE ice_thd_ent( qnew )
+      !!-------------------------------------------------------------------
+      !!               ***   ROUTINE ice_thd_ent  ***
+      !!
+      !! ** Purpose :
+      !!           This routine computes new vertical grids in the ice, 
+      !!           and consistently redistributes temperatures. 
+      !!           Redistribution is made so as to ensure to energy conservation
+      !!
+      !!
+      !! ** Method  : linear conservative remapping
+      !!           
+      !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses
+      !!            2) linear remapping on the new layers
+      !!
+      !! ------------ cum0(0)                        ------------- cum1(0)
+      !!                                    NEW      -------------
+      !! ------------ cum0(1)               ==>      -------------
+      !!     ...                                     -------------
+      !! ------------                                -------------
+      !! ------------ cum0(nlay_i+2)                 ------------- cum1(nlay_i)
+      !!
+      !!
+      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   qnew             ! new enthlapies (J.m-3, remapped)
+      !
+      INTEGER  :: ji         !  dummy loop indices
+      INTEGER  :: jk0, jk1   !  old/new layer indices
+      !
+      REAL(wp), DIMENSION(jpij,0:nlay_i+2) ::   zeh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces
+      REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zeh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces
+      REAL(wp), DIMENSION(jpij)            ::   zhnew               ! new layers thicknesses
+      !!-------------------------------------------------------------------
+
+      !--------------------------------------------------------------------------
+      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
+      !--------------------------------------------------------------------------
+      zeh_cum0(1:npti,0) = 0._wp 
+      zh_cum0 (1:npti,0) = 0._wp
+      DO jk0 = 1, nlay_i+2
+         DO ji = 1, npti
+            zeh_cum0(ji,jk0) = zeh_cum0(ji,jk0-1) + eh_i_old(ji,jk0-1)
+            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1)
+         END DO
+      END DO
+
+      !------------------------------------
+      !  2) Interpolation on the new layers
+      !------------------------------------
+      ! new layer thickesses
+      DO ji = 1, npti
+         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i  
+      END DO
+
+      ! new layers interfaces
+      zh_cum1(1:npti,0) = 0._wp
+      DO jk1 = 1, nlay_i
+         DO ji = 1, npti
+            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji)
+         END DO
+      END DO
+
+      zeh_cum1(1:npti,0) = 0._wp 
+      ! new cumulative q*h => linear interpolation
+      DO jk0 = 1, nlay_i+1
+         DO jk1 = 1, nlay_i-1
+            DO ji = 1, npti
+               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN
+                  zeh_cum1(ji,jk1) = ( zeh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  &
+                     &                 zeh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  &
+                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      ! to ensure that total heat content is strictly conserved, set:
+      zeh_cum1(1:npti,nlay_i) = zeh_cum0(1:npti,nlay_i+2) 
+
+      ! new enthalpies
+      DO jk1 = 1, nlay_i
+         DO ji = 1, npti
+            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 
+            qnew(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
+         END DO
+      END DO
+
+      ! --- diag error on heat remapping --- !
+      ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in icethd_do), 
+      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0
+      DO ji = 1, npti
+         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  &
+            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 
+      END DO
+      
+   END SUBROUTINE ice_thd_ent
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd_ent
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90	(revision 8586)
@@ -0,0 +1,166 @@
+MODULE icethd_sal
+   !!======================================================================
+   !!                       ***  MODULE icethd_sal ***
+   !!   sea-ice : computation of salinity variations in the ice
+   !!======================================================================
+   !! History :   -   ! 2003-05 (M. Vancoppenolle) UCL-ASTR first coding for LIM3-1D
+   !!            3.0  ! 2005-12 (M. Vancoppenolle) adapted to the 3-D version
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!---------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_thd_sal        : salinity variations in the ice
+   !!   ice_thd_sal_init   : initialization
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamics variables
+   USE icevar         ! sea-ice: operations
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_thd_sal        ! called by icethd
+   PUBLIC   ice_thd_sal_init   ! called by ice_init
+   
+   ! ** namelist (namthd_sal) **
+   REAL(wp) ::   rn_sal_gd        ! restoring salinity for gravity drainage [PSU]
+   REAL(wp) ::   rn_time_gd       ! restoring time constant for gravity drainage (= 20 days) [s]
+   REAL(wp) ::   rn_sal_fl        ! restoring salinity for flushing [PSU]
+   REAL(wp) ::   rn_time_fl       ! restoring time constant for gravity drainage (= 10 days) [s]
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd_sal.F90 8420 2017-08-08 12:18:46Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_thd_sal( ld_sal )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_thd_sal  ***    
+      !!   
+      !! ** Purpose :   computes new salinities in the ice
+      !!
+      !! ** Method  :  3 possibilities
+      !!               -> nn_icesal = 1 -> Sice = cst    [ice salinity constant in both time & space] 
+      !!               -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
+      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice]
+      !!---------------------------------------------------------------------
+      LOGICAL, INTENT(in) ::   ld_sal            ! gravity drainage and flushing or not 
+      INTEGER  ::   ji, jk                       ! dummy loop indices 
+      REAL(wp) ::   iflush, igravdr              ! local scalars
+      REAL(wp) ::   zs_sni, zs_i_gd, zs_i_fl, zs_i_si, zs_i_bg   ! local scalars
+      REAL(wp) ::   z1_time_gd, z1_time_fl
+      !!---------------------------------------------------------------------
+
+      SELECT CASE ( nn_icesal )
+      !
+      !               !---------------------------------------------!
+      CASE( 2 )       !  time varying salinity with linear profile  !
+      !               !---------------------------------------------!
+         z1_time_gd = 1._wp / rn_time_gd * rdt_ice
+         z1_time_fl = 1._wp / rn_time_fl * rdt_ice
+         !
+         DO ji = 1, npti
+
+            !---------------------------------------------------------
+            !  Update ice salinity from snow-ice and bottom growth
+            !---------------------------------------------------------
+            IF( h_i_1d(ji) > 0._wp ) THEN
+               zs_sni   = sss_1d(ji) * ( rhoic - rhosn ) * r1_rhoic                                 ! Salinity of snow ice
+               zs_i_si = ( zs_sni      - s_i_1d(ji) ) *             dh_snowice(ji)  / h_i_1d(ji) ! snow-ice    
+               zs_i_bg = ( s_i_new(ji) - s_i_1d(ji) ) * MAX( 0._wp, dh_i_bott(ji) ) / h_i_1d(ji) ! bottom growth
+               ! Update salinity (nb: salt flux already included in icethd_dh)
+               s_i_1d(ji) = s_i_1d(ji) + zs_i_bg + zs_i_si
+            ENDIF
+
+            IF( ld_sal ) THEN
+               !---------------------------------------------------------
+               !  Update ice salinity from brine drainage and flushing
+               !---------------------------------------------------------
+               iflush   = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0         ) )  ! =1 if summer 
+               igravdr  = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )  ! =1 if t_su < t_bo
+
+               zs_i_gd = - igravdr * MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd  ! gravity drainage 
+               zs_i_fl = - iflush  * MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl  ! flushing
+               
+               ! Update salinity   
+               s_i_1d(ji) = s_i_1d(ji) + zs_i_fl + zs_i_gd
+               
+               ! Salt flux
+               sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_rdtice
+            ENDIF
+         END DO
+
+         ! Salinity profile
+         CALL ice_var_salprof1d
+         !
+      !         !---------------------------------------------!
+      CASE( 3 ) ! constant salinity with a fixed profile      ! (Schwarzacher (1959) multiyear salinity profile(mean = 2.30)
+      !         !---------------------------------------------!
+         CALL ice_var_salprof1d
+      !
+   END SELECT
+   !
+   END SUBROUTINE ice_thd_sal
+
+
+   SUBROUTINE ice_thd_sal_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_thd_sal_init  ***
+      !!
+      !! ** Purpose :   initialization of ice salinity parameters
+      !!
+      !! ** Method  :   Read the namthd_sal namelist and check the parameter
+      !!                values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namthd_sal
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namthd_sal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd,   &
+         &                 rn_sal_fl, rn_time_fl, rn_simax , rn_simin 
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namthd_sal in reference namelist : Ice salinity
+      READ  ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist', lwp )
+      !
+      REWIND( numnam_ice_cfg )              ! Namelist namthd_sal in configuration namelist : Ice salinity
+      READ  ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namthd_sal )
+      !
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_thd_sal_init : Ice parameters for salinity '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namthd_sal:'
+         WRITE(numout,*) '      switch for salinity                                     nn_icesal  = ', nn_icesal
+         WRITE(numout,*) '      bulk salinity value if nn_icesal = 1                    rn_icesal  = ', rn_icesal
+         WRITE(numout,*) '      restoring salinity for gravity drainage                 rn_sal_gd  = ', rn_sal_gd
+         WRITE(numout,*) '      restoring time for for gravity drainage                 rn_time_gd = ', rn_time_gd
+         WRITE(numout,*) '      restoring salinity for flushing                         rn_sal_fl  = ', rn_sal_fl
+         WRITE(numout,*) '      restoring time for flushing                             rn_time_fl = ', rn_time_fl
+         WRITE(numout,*) '      Maximum tolerated ice salinity                          rn_simax   = ', rn_simax
+         WRITE(numout,*) '      Minimum tolerated ice salinity                          rn_simin   = ', rn_simin
+      ENDIF
+      !
+   END SUBROUTINE ice_thd_sal_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy Module           No ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd_sal
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90	(revision 8586)
@@ -0,0 +1,717 @@
+MODULE icethd_zdf
+   !!======================================================================
+   !!                       ***  MODULE icethd_zdf ***
+   !!   sea-ice: vertical heat diffusion in sea ice (computation of temperatures) 
+   !!======================================================================
+   !! History :  LIM  ! 02-2003 (M. Vancoppenolle) original 1D code
+   !!                 ! 06-2005 (M. Vancoppenolle) 3d version
+   !!                 ! 11-2006 (X Fettweis) Vectorization by Xavier
+   !!                 ! 04-2007 (M. Vancoppenolle) Energy conservation
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants (ocean directory) 
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamics variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_thd_zdf        ! called by icethd
+   PUBLIC   ice_thd_zdf_init   ! called by icestp
+
+   !!** namelist (namthd_zdf) **
+   LOGICAL  ::   ln_zdf_Beer      ! Heat diffusion follows a Beer Law
+   LOGICAL  ::   ln_cndi_U64      ! thermal conductivity: Untersteiner (1964)
+   LOGICAL  ::   ln_cndi_P07      ! thermal conductivity: Pringle et al (2007)
+   REAL(wp) ::   rn_cnd_s         ! thermal conductivity of the snow [W/m/K]
+   REAL(wp) ::   rn_kappa_i       ! coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
+   LOGICAL  ::   ln_dqns_i        ! change non-solar surface flux with changing surface temperature (T) or not (F)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd_zdf.F90 8420 2017-08-08 12:18:46Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_thd_zdf
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_thd_zdf  ***
+      !! ** Purpose :
+      !!           This routine determines the time evolution of snow and sea-ice 
+      !!           temperature profiles.
+      !! ** Method  :
+      !!           This is done by solving the heat equation diffusion with
+      !!           a Neumann boundary condition at the surface and a Dirichlet one
+      !!           at the bottom. Solar radiation is partially absorbed into the ice.
+      !!           The specific heat and thermal conductivities depend on ice salinity
+      !!           and temperature to take into account brine pocket melting. The 
+      !!           numerical
+      !!           scheme is an iterative Crank-Nicolson on a non-uniform multilayer grid 
+      !!           in the ice and snow system.
+      !!
+      !!           The successive steps of this routine are
+      !!           1.  initialization of ice-snow layers thicknesses
+      !!           2.  Internal absorbed and transmitted radiation
+      !!           Then iterative procedure begins
+      !!           3.  Thermal conductivity
+      !!           4.  Kappa factors
+      !!           5.  specific heat in the ice
+      !!           6.  eta factors
+      !!           7.  surface flux computation
+      !!           8.  tridiagonal system terms
+      !!           9.  solving the tridiagonal system with Gauss elimination
+      !!           Iterative procedure ends according to a criterion on evolution
+      !!           of temperature
+      !!           10. Fluxes at the interfaces
+      !!
+      !! ** Inputs / Ouputs : (global commons)
+      !!           surface temperature : t_su_1d
+      !!           ice/snow temperatures   : t_i_1d, t_s_1d
+      !!           ice salinities          : sz_i_1d
+      !!           number of layers in the ice/snow: nlay_i, nlay_s
+      !!           total ice/snow thickness : h_i_1d, h_s_1d
+      !!-------------------------------------------------------------------
+      INTEGER ::   ji, jk         ! spatial loop index
+      INTEGER ::   jm             ! current reference number of equation
+      INTEGER ::   jm_mint, jm_maxt
+      INTEGER ::   iconv          ! number of iterations in iterative procedure
+      INTEGER ::   iconv_max = 50 ! max number of iterations in iterative procedure
+      
+      INTEGER, DIMENSION(jpij) ::   jm_min    ! reference number of top equation
+      INTEGER, DIMENSION(jpij) ::   jm_max    ! reference number of bottom equation
+      
+      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system
+      REAL(wp) ::   zg1       =  2._wp        !
+      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat
+      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13)
+      REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow
+      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity
+      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered at 0C 
+      REAL(wp) ::   zdti_bnd  =  1.e-4_wp     ! maximal authorized error on temperature 
+      REAL(wp) ::   ztmelt_i                  ! ice melting temperature
+      REAL(wp) ::   z1_hsu
+      REAL(wp) ::   zdti_max                  ! current maximal error on temperature 
+      REAL(wp) ::   zcpi                      ! Ice specific heat
+      REAL(wp) ::   zhfx_err, zdq             ! diag errors on heat
+      REAL(wp) ::   zfac                      ! dummy factor
+      
+      REAL(wp), DIMENSION(jpij)     ::   isnow       ! switch for presence (1) or absence (0) of snow
+      REAL(wp), DIMENSION(jpij)     ::   ztsub       ! surface temperature at previous iteration
+      REAL(wp), DIMENSION(jpij)     ::   zh_i, z1_h_i ! ice layer thickness
+      REAL(wp), DIMENSION(jpij)     ::   zh_s, z1_h_s ! snow layer thickness
+      REAL(wp), DIMENSION(jpij)     ::   zfsw        ! solar radiation absorbed at the surface
+      REAL(wp), DIMENSION(jpij)     ::   zqns_ice_b  ! solar radiation absorbed at the surface
+      REAL(wp), DIMENSION(jpij)     ::   zfnet       ! surface flux function
+      REAL(wp), DIMENSION(jpij)     ::   zdqns_ice_b ! derivative of the surface flux function
+      REAL(wp), DIMENSION(jpij)     ::   zftrice     ! solar radiation transmitted through the ice
+      
+      REAL(wp), DIMENSION(jpij,nlay_i)     ::   ztiold      ! Old temperature in the ice
+      REAL(wp), DIMENSION(jpij,nlay_s)     ::   ztsold      ! Old temperature in the snow
+      REAL(wp), DIMENSION(jpij,nlay_i)     ::   ztib        ! Temporary temperature in the ice to check the convergence
+      REAL(wp), DIMENSION(jpij,nlay_s)     ::   ztsb        ! Temporary temperature in the snow to check the convergence
+      REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   ztcond_i    ! Ice thermal conductivity
+      REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zradtr_i    ! Radiation transmitted through the ice
+      REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zradab_i    ! Radiation absorbed in the ice
+      REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zkappa_i    ! Kappa factor in the ice
+      REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zeta_i      ! Eta factor in the ice
+      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zradtr_s    ! Radiation transmited through the snow
+      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zradab_s    ! Radiation absorbed in the snow
+      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zkappa_s    ! Kappa factor in the snow
+      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zeta_s      ! Eta factor in the snow
+      REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindterm    ! 'Ind'ependent term
+      REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindtbis    ! Temporary 'ind'ependent term
+      REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zdiagbis    ! Temporary 'dia'gonal term
+      REAL(wp), DIMENSION(jpij,nlay_i+3,3) ::   ztrid       ! Tridiagonal system terms
+      REAL(wp), DIMENSION(jpij)            ::   zq_ini      ! diag errors on heat
+      REAL(wp), DIMENSION(jpij)            ::   zghe        ! G(he), th. conduct enhancement factor, mono-cat
+      
+      ! Mono-category
+      REAL(wp) :: zepsilon      ! determines thres. above which computation of G(h) is done
+      REAL(wp) :: zhe           ! dummy factor
+      REAL(wp) :: zcnd_i        ! mean sea ice thermal conductivity
+      !!------------------------------------------------------------------     
+
+      ! --- diag error on heat diffusion - PART 1 --- !
+      DO ji = 1, npti
+         zq_ini(ji) = ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i +  &
+            &           SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s ) 
+      END DO
+
+      !------------------
+      ! 1) Initialization
+      !------------------
+      DO ji = 1, npti
+         isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - h_s_1d(ji) ) )  ! is there snow or not
+         ! layer thickness
+         zh_i(ji) = h_i_1d(ji) * r1_nlay_i
+         zh_s(ji) = h_s_1d(ji) * r1_nlay_s
+      END DO
+      !
+      WHERE( zh_i(1:npti) >= epsi10 )   ;   z1_h_i(1:npti) = 1._wp / zh_i(1:npti)
+      ELSEWHERE                         ;   z1_h_i(1:npti) = 0._wp
+      END WHERE
+
+      WHERE( zh_s(1:npti) >= epsi10 )   ;   z1_h_s(1:npti) = 1._wp / zh_s(1:npti)
+      ELSEWHERE                         ;   z1_h_s(1:npti) = 0._wp
+      END WHERE
+      !
+      ! temperatures
+      ztsub  (1:npti)   = t_su_1d(1:npti)  ! temperature at the previous iteration
+      ztsold (1:npti,:) = t_s_1d(1:npti,:)   ! Old snow temperature
+      ztiold (1:npti,:) = t_i_1d(1:npti,:)   ! Old ice temperature
+      t_su_1d(1:npti)   = MIN( t_su_1d(1:npti), rt0 - ztsu_err )   ! necessary
+      !
+      !-------------
+      ! 2) Radiation
+      !-------------
+      z1_hsu = 1._wp / 0.1_wp ! threshold for the computation of i0
+      DO ji = 1, npti
+         ! --- Computation of i0 --- !
+         ! i0 describes the fraction of solar radiation which does not contribute
+         ! to the surface energy budget but rather penetrates inside the ice.
+         ! We assume that no radiation is transmitted through the snow
+         ! If there is no no snow
+         ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface 
+         ! zftrice = io.qsr_ice       is below the surface 
+         ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 
+         ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover
+         zfac = MAX( 0._wp , 1._wp - ( h_i_1d(ji) * z1_hsu ) )     
+         i0(ji) = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zfac * fr2_i0_1d(ji) )
+
+         ! --- Solar radiation absorbed / transmitted at the surface --- !
+         !     Derivative of the non solar flux
+         zfsw   (ji)     =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface
+         zftrice(ji)     =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer
+         zdqns_ice_b(ji) = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux 
+         zqns_ice_b (ji) =  qns_ice_1d(ji)                    ! store previous qns_ice_1d value
+      END DO
+
+      ! --- Transmission/absorption of solar radiation in the ice --- !
+      zradtr_s(1:npti,0) = zftrice(1:npti)
+      DO jk = 1, nlay_s
+         DO ji = 1, npti
+            !                             ! radiation transmitted below the layer-th snow layer
+            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * zh_s(ji) * REAL(jk) )
+            !                             ! radiation absorbed by the layer-th snow layer
+            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk)
+         END DO
+      END DO
+         
+      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + zftrice(1:npti) * ( 1._wp - isnow(1:npti) )
+      DO jk = 1, nlay_i 
+         DO ji = 1, npti
+            !                             ! radiation transmitted below the layer-th ice layer
+            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * zh_i(ji) * REAL(jk) )
+            !                             ! radiation absorbed by the layer-th ice layer
+            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
+         END DO
+      END DO
+
+      ftr_ice_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice
+      !
+      iconv    =  0          ! number of iterations
+      zdti_max =  1000._wp   ! maximal value of error on all points
+      !                                                          !============================!
+      DO WHILE ( zdti_max > zdti_bnd .AND. iconv < iconv_max )   ! Iterative procedure begins !
+         !                                                       !============================!
+         iconv = iconv + 1
+         !
+         ztib(1:npti,:) = t_i_1d(1:npti,:)
+         ztsb(1:npti,:) = t_s_1d(1:npti,:)
+         !
+         !--------------------------------
+         ! 3) Sea ice thermal conductivity
+         !--------------------------------
+         IF( ln_cndi_U64 ) THEN         !-- Untersteiner (1964) formula: k = k0 + beta.S/T
+            !
+            DO ji = 1, npti
+               ztcond_i(ji,0)      = rcdic + zbeta * sz_i_1d(ji,1)      / MIN( -epsi10, t_i_1d(ji,1) - rt0 )
+               ztcond_i(ji,nlay_i) = rcdic + zbeta * sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji)  - rt0 )
+            END DO
+            DO jk = 1, nlay_i-1
+               DO ji = 1, npti
+                  ztcond_i(ji,jk) = rcdic + zbeta * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /  &
+                     &                      MIN( -epsi10, 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 )
+               END DO
+            END DO
+            !
+         ELSEIF( ln_cndi_P07 ) THEN     !-- Pringle et al formula: k = k0 + beta1.S/T - beta2.T
+            !
+            DO ji = 1, npti
+               ztcond_i(ji,0)      = rcdic + 0.09_wp * sz_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )  &
+                  &                        - 0.011_wp * ( t_i_1d(ji,1) - rt0 )
+               ztcond_i(ji,nlay_i) = rcdic + 0.09_wp * sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 )  &
+                  &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 )
+            END DO
+            DO jk = 1, nlay_i-1
+               DO ji = 1, npti
+                  ztcond_i(ji,jk) = rcdic + 0.09_wp * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /          &
+                     &                     MIN( -epsi10, 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 )   &
+                     &                    - 0.011_wp * ( 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 )
+               END DO
+            END DO
+            !
+         ENDIF
+         ztcond_i(1:npti,:) = MAX( zkimin, ztcond_i(1:npti,:) )        
+         !
+         !--- G(he) : enhancement of thermal conductivity in mono-category case
+         ! Computation of effective thermal conductivity G(h)
+         ! Used in mono-category case only to simulate an ITD implicitly
+         ! Fichefet and Morales Maqueda, JGR 1997
+         zghe(1:npti) = 1._wp
+         !
+         SELECT CASE ( nn_monocat )
+
+         CASE ( 1 , 3 )
+
+            zepsilon = 0.1_wp
+            DO ji = 1, npti
+               zcnd_i = SUM( ztcond_i(ji,:) ) / REAL( nlay_i+1, wp )                             ! Mean sea ice thermal conductivity
+               zhe = ( rn_cnd_s * h_i_1d(ji) + zcnd_i * h_s_1d(ji) ) / ( rn_cnd_s + zcnd_i )   ! Effective thickness he (zhe)
+               IF( zhe >=  zepsilon * 0.5_wp * EXP(1._wp) ) THEN
+                  zghe(ji) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) ) )    ! G(he)
+               ENDIF
+            END DO
+
+         END SELECT
+         !
+         !-----------------
+         ! 4) kappa factors
+         !-----------------
+         !--- Snow
+         DO jk = 0, nlay_s-1
+            DO ji = 1, npti
+               zkappa_s(ji,jk) = zghe(ji) * rn_cnd_s * z1_h_s(ji)
+            END DO
+         END DO
+         DO ji = 1, npti   ! Snow-ice interface
+            zfac = 0.5_wp * ( ztcond_i(ji,0) * zh_s(ji) + rn_cnd_s * zh_i(ji) )
+            IF( zfac > epsi10 ) THEN
+               zkappa_s(ji,nlay_s) = zghe(ji) * rn_cnd_s * ztcond_i(ji,0) / zfac
+            ELSE
+               zkappa_s(ji,nlay_s) = 0._wp
+            ENDIF
+         END DO
+
+         !--- Ice
+         DO jk = 0, nlay_i
+            DO ji = 1, npti
+               zkappa_i(ji,jk) = zghe(ji) * ztcond_i(ji,jk) * z1_h_i(ji)
+            END DO
+         END DO
+         DO ji = 1, npti   ! Snow-ice interface
+            zkappa_i(ji,0) = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) )
+         END DO
+         !
+         !--------------------------------------
+         ! 5) Sea ice specific heat, eta factors
+         !--------------------------------------
+         DO jk = 1, nlay_i
+            DO ji = 1, npti
+               zcpi = cpic + zgamma * sz_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztiold(ji,jk) - rt0 ), epsi10 )
+               zeta_i(ji,jk) = rdt_ice * r1_rhoic * z1_h_i(ji) / MAX( epsi10, zcpi ) 
+            END DO
+         END DO
+
+         DO jk = 1, nlay_s
+            DO ji = 1, npti
+               zeta_s(ji,jk) = rdt_ice * r1_rhosn * r1_cpic * z1_h_s(ji)
+            END DO
+         END DO
+         !
+         !----------------------------
+         ! 6) surface flux computation
+         !----------------------------
+         IF ( ln_dqns_i ) THEN 
+            DO ji = 1, npti
+               ! update of the non solar flux according to the update in T_su
+               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) )
+            END DO
+         ENDIF
+
+         DO ji = 1, npti
+            zfnet(ji) = zfsw(ji) + qns_ice_1d(ji) ! incoming = net absorbed solar radiation + non solar total flux (LWup, LWdw, SH, LH)
+         END DO
+         !
+         !----------------------------
+         ! 7) tridiagonal system terms
+         !----------------------------
+         !!layer denotes the number of the layer in the snow or in the ice
+         !!jm denotes the reference number of the equation in the tridiagonal
+         !!system, terms of tridiagonal system are indexed as following :
+         !!1 is subdiagonal term, 2 is diagonal and 3 is superdiagonal one
+
+         !!ice interior terms (top equation has the same form as the others)
+         ztrid   (1:npti,:,:) = 0._wp
+         zindterm(1:npti,:)   = 0._wp
+         zindtbis(1:npti,:)   = 0._wp
+         zdiagbis(1:npti,:)   = 0._wp
+
+         DO jm = nlay_s + 2, nlay_s + nlay_i 
+            DO ji = 1, npti
+               jk = jm - nlay_s - 1
+               ztrid(ji,jm,1)  = - zeta_i(ji,jk) * zkappa_i(ji,jk-1)
+               ztrid(ji,jm,2)  = 1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) )
+               ztrid(ji,jm,3)  = - zeta_i(ji,jk) * zkappa_i(ji,jk)
+               zindterm(ji,jm) = ztiold(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk)
+            END DO
+         ENDDO
+
+         jm =  nlay_s + nlay_i + 1
+         DO ji = 1, npti
+            !!ice bottom term
+            ztrid(ji,jm,1)  = - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)   
+            ztrid(ji,jm,2)  = 1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) )
+            ztrid(ji,jm,3)  = 0.0
+            zindterm(ji,jm) = ztiold(ji,nlay_i) + zeta_i(ji,nlay_i) *  &
+               &            ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 *  t_bo_1d(ji) ) 
+         ENDDO
+
+
+         DO ji = 1, npti
+            !                               !---------------------!
+            IF ( h_s_1d(ji) > 0.0 ) THEN   !  snow-covered cells !
+               !                            !---------------------!
+               ! snow interior terms (bottom equation has the same form as the others)
+               DO jm = 3, nlay_s + 1
+                  jk = jm - 1
+                  ztrid(ji,jm,1)  = - zeta_s(ji,jk) * zkappa_s(ji,jk-1)
+                  ztrid(ji,jm,2)  = 1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) )
+                  ztrid(ji,jm,3)  = - zeta_s(ji,jk)*zkappa_s(ji,jk)
+                  zindterm(ji,jm) = ztsold(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
+               END DO
+
+               ! case of only one layer in the ice (ice equation is altered)
+               IF ( nlay_i == 1 ) THEN
+                  ztrid(ji,nlay_s+2,3)  = 0.0
+                  zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji) 
+               ENDIF
+
+               IF ( t_su_1d(ji) < rt0 ) THEN   !--  case 1 : no surface melting
+
+                  jm_min(ji) = 1
+                  jm_max(ji) = nlay_i + nlay_s + 1
+
+                  ! surface equation
+                  ztrid(ji,1,1)  = 0.0
+                  ztrid(ji,1,2)  = zdqns_ice_b(ji) - zg1s * zkappa_s(ji,0)
+                  ztrid(ji,1,3)  = zg1s * zkappa_s(ji,0)
+                  zindterm(ji,1) = zdqns_ice_b(ji) * t_su_1d(ji) - zfnet(ji)
+
+                  ! first layer of snow equation
+                  ztrid(ji,2,1)  = - zkappa_s(ji,0) * zg1s * zeta_s(ji,1)
+                  ztrid(ji,2,2)  = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
+                  ztrid(ji,2,3)  = - zeta_s(ji,1)* zkappa_s(ji,1)
+                  zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) * zradab_s(ji,1)
+
+               ELSE                            !--  case 2 : surface is melting
+                  !
+                  jm_min(ji) = 2
+                  jm_max(ji) = nlay_i + nlay_s + 1
+
+                  ! first layer of snow equation
+                  ztrid(ji,2,1)  = 0.0
+                  ztrid(ji,2,2)  = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
+                  ztrid(ji,2,3)  = - zeta_s(ji,1)*zkappa_s(ji,1) 
+                  zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) *  &
+                     &           ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
+               ENDIF
+            !                               !---------------------!
+            ELSE                            ! cells without snow  !
+               !                            !---------------------!
+               !
+               IF ( t_su_1d(ji) < rt0 ) THEN   !--  case 1 : no surface melting
+                  !
+                  jm_min(ji) = nlay_s + 1
+                  jm_max(ji) = nlay_i + nlay_s + 1
+
+                  ! surface equation	
+                  ztrid(ji,jm_min(ji),1)  = 0.0
+                  ztrid(ji,jm_min(ji),2)  = zdqns_ice_b(ji) - zkappa_i(ji,0)*zg1    
+                  ztrid(ji,jm_min(ji),3)  = zkappa_i(ji,0)*zg1
+                  zindterm(ji,jm_min(ji)) = zdqns_ice_b(ji)*t_su_1d(ji) - zfnet(ji)
+
+                  ! first layer of ice equation
+                  ztrid(ji,jm_min(ji)+1,1)  = - zkappa_i(ji,0) * zg1 * zeta_i(ji,1)
+                  ztrid(ji,jm_min(ji)+1,2)  = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
+                  ztrid(ji,jm_min(ji)+1,3)  = - zeta_i(ji,1) * zkappa_i(ji,1)  
+                  zindterm(ji,jm_min(ji)+1) = ztiold(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)  
+
+                  ! case of only one layer in the ice (surface & ice equations are altered)
+                  IF ( nlay_i == 1 ) THEN
+                     ztrid(ji,jm_min(ji),1)    = 0.0
+                     ztrid(ji,jm_min(ji),2)    = zdqns_ice_b(ji) - zkappa_i(ji,0) * 2.0
+                     ztrid(ji,jm_min(ji),3)    = zkappa_i(ji,0) * 2.0
+                     ztrid(ji,jm_min(ji)+1,1)  = -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1)
+                     ztrid(ji,jm_min(ji)+1,2)  = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
+                     ztrid(ji,jm_min(ji)+1,3)  = 0.0
+                     zindterm(ji,jm_min(ji)+1) = ztiold(ji,1) + zeta_i(ji,1) *  &
+                        &                      ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )
+                  ENDIF
+
+               ELSE                            !--  case 2 : surface is melting
+
+                  jm_min(ji)    =  nlay_s + 2
+                  jm_max(ji)    =  nlay_i + nlay_s + 1
+
+                  ! first layer of ice equation
+                  ztrid(ji,jm_min(ji),1)  = 0.0
+                  ztrid(ji,jm_min(ji),2)  = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )  
+                  ztrid(ji,jm_min(ji),3)  = - zeta_i(ji,1) * zkappa_i(ji,1)
+                  zindterm(ji,jm_min(ji)) = ztiold(ji,1) + zeta_i(ji,1) *  &
+                     &                    ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
+
+                  ! case of only one layer in the ice (surface & ice equations are altered)
+                  IF ( nlay_i == 1 ) THEN
+                     ztrid(ji,jm_min(ji),1)  = 0.0
+                     ztrid(ji,jm_min(ji),2)  = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
+                     ztrid(ji,jm_min(ji),3)  = 0.0
+                     zindterm(ji,jm_min(ji)) = ztiold(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )  &
+                        &                    + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0
+                  ENDIF
+
+               ENDIF
+            ENDIF
+            !
+            zindtbis(ji,jm_min(ji)) = zindterm(ji,jm_min(ji))
+            zdiagbis(ji,jm_min(ji)) = ztrid(ji,jm_min(ji),2)
+            !
+         END DO
+         !
+         !------------------------------
+         ! 8) tridiagonal system solving
+         !------------------------------
+         ! Solve the tridiagonal system with Gauss elimination method.
+         ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, McGraw-Hill 1984
+         jm_maxt = 0
+         jm_mint = nlay_i+5
+         DO ji = 1, npti
+            jm_mint = MIN(jm_min(ji),jm_mint)
+            jm_maxt = MAX(jm_max(ji),jm_maxt)
+         END DO
+
+         DO jk = jm_mint+1, jm_maxt
+            DO ji = 1, npti
+               jm = min(max(jm_min(ji)+1,jk),jm_max(ji))
+               zdiagbis(ji,jm) = ztrid(ji,jm,2)  - ztrid(ji,jm,1) * ztrid(ji,jm-1,3)  / zdiagbis(ji,jm-1)
+               zindtbis(ji,jm) = zindterm(ji,jm) - ztrid(ji,jm,1) * zindtbis(ji,jm-1) / zdiagbis(ji,jm-1)
+            END DO
+         END DO
+
+         DO ji = 1, npti
+            ! ice temperatures
+            t_i_1d(ji,nlay_i) = zindtbis(ji,jm_max(ji)) / zdiagbis(ji,jm_max(ji))
+         END DO
+
+         DO jm = nlay_i + nlay_s, nlay_s + 2, -1
+            DO ji = 1, npti
+               jk    =  jm - nlay_s - 1
+               t_i_1d(ji,jk) = ( zindtbis(ji,jm) - ztrid(ji,jm,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,jm)
+            END DO
+         END DO
+
+         DO ji = 1, npti
+            ! snow temperatures      
+            IF( h_s_1d(ji) > 0._wp ) THEN
+               t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) )  &
+                  &                / zdiagbis(ji,nlay_s+1)
+            ENDIF
+            ! surface temperature
+            ztsub(ji) = t_su_1d(ji)
+            IF( t_su_1d(ji) < rt0 ) THEN
+               t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  &
+                  &          ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji))
+            ENDIF
+         END DO
+         !
+         !--------------------------------------------------------------
+         ! 9) Has the scheme converged ?, end of the iterative procedure
+         !--------------------------------------------------------------
+         ! check that nowhere it has started to melt
+         ! zdti_max is a measure of error, it has to be under zdti_bnd
+         zdti_max = 0._wp
+         DO ji = 1, npti
+            t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , rt0 ) , rt0 - 100._wp )
+            zdti_max = MAX( zdti_max, ABS( t_su_1d(ji) - ztsub(ji) ) )     
+         END DO
+
+         DO jk  =  1, nlay_s
+            DO ji = 1, npti
+               t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), rt0 - 100._wp )
+               zdti_max = MAX( zdti_max, ABS( t_s_1d(ji,jk) - ztsb(ji,jk) ) )
+            END DO
+         END DO
+
+         DO jk  =  1, nlay_i
+            DO ji = 1, npti
+               ztmelt_i      = -tmut * sz_i_1d(ji,jk) + rt0 
+               t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), rt0 - 100._wp )
+               zdti_max      =  MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) )
+            END DO
+         END DO
+
+         ! Compute spatial maximum over all errors
+         ! note that this could be optimized substantially by iterating only the non-converging points
+         IF( lk_mpp ) CALL mpp_max( zdti_max, kcom=ncomm_ice )
+
+      END DO  ! End of the do while iterative procedure
+
+      IF( ln_icectl .AND. lwp ) THEN
+         WRITE(numout,*) ' zdti_max : ', zdti_max
+         WRITE(numout,*) ' iconv    : ', iconv
+      ENDIF
+      !
+      !-----------------------------
+      ! 10) Fluxes at the interfaces
+      !-----------------------------
+      DO ji = 1, npti
+         !                                ! surface ice conduction flux
+         fc_su(ji)   =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
+            &           - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji))
+         !                                ! bottom ice conduction flux
+         fc_bo_i(ji) =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) )
+      END DO
+
+      ! --- computes sea ice energy of melting compulsory for icethd_dh --- !
+      CALL ice_thd_enmelt
+
+      ! --- diagnose the change in non-solar flux due to surface temperature change --- !
+      IF ( ln_dqns_i ) THEN
+         DO ji = 1, npti
+            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji) 
+         END DO
+      END IF
+
+      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
+      !     hfx_dif = Heat flux used to warm/cool ice in W.m-2
+      !     zhfx_err = correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation
+      DO ji = 1, npti
+         zdq = - zq_ini(ji) + ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i +  &
+            &                   SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s )
+
+         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
+            zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji) 
+         ELSE                          ! case T_su = 0degC
+            zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji)
+         ENDIF
+         hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_rdtice * a_i_1d(ji)
+
+         ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation)
+         hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err
+
+      END DO   
+
+      ! --- Diagnostics SIMIP --- !
+      DO ji = 1, npti
+         !--- Conduction fluxes (positive downwards)
+         diag_fc_bo_1d(ji) = diag_fc_bo_1d(ji) + fc_bo_i(ji) * a_i_1d(ji) / at_i_1d(ji)
+         diag_fc_su_1d(ji) = diag_fc_su_1d(ji) + fc_su(ji)   * a_i_1d(ji) / at_i_1d(ji)
+
+         !--- Snow-ice interfacial temperature (diagnostic SIMIP)
+         zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji)
+         IF( zh_s(ji) >= 1.e-3 .AND. zfac > epsi10 ) THEN
+            t_si_1d(ji) = ( rn_cnd_s       * zh_i(ji) * t_s_1d(ji,1) +   &
+               &            ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / zfac
+         ELSE
+            t_si_1d(ji) = t_su_1d(ji)
+         ENDIF
+      END DO
+      !
+   END SUBROUTINE ice_thd_zdf
+
+
+   SUBROUTINE ice_thd_enmelt
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_enmelt *** 
+      !!                 
+      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature
+      !!
+      !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jk   ! dummy loop indices
+      REAL(wp) ::   ztmelts  ! local scalar 
+      !!-------------------------------------------------------------------
+      !
+      DO jk = 1, nlay_i             ! Sea ice energy of melting
+         DO ji = 1, npti
+            ztmelts      = - tmut  * sz_i_1d(ji,jk)
+            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point
+                                                                !   (sometimes dif scheme produces abnormally high temperatures)   
+            e_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) )           &
+               &                    + lfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) )   &
+               &                    - rcp  *   ztmelts )
+         END DO
+      END DO
+      DO jk = 1, nlay_s             ! Snow energy of melting
+         DO ji = 1, npti
+            e_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus )
+         END DO
+      END DO
+      !
+   END SUBROUTINE ice_thd_enmelt
+
+
+   SUBROUTINE ice_thd_zdf_init
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_thd_zdf_init *** 
+      !!                 
+      !! ** Purpose :   Physical constants and parameters associated with
+      !!                ice thermodynamics
+      !!
+      !! ** Method  :   Read the namthd_zdf namelist and check the parameters
+      !!                called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namthd_zdf
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namthd_zdf/ ln_zdf_Beer, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, rn_kappa_i, ln_dqns_i
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namthd_zdf in reference namelist : Ice thermodynamics
+      READ  ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics
+      READ  ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namthd_zdf )
+      !
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*) 'ice_thd_zdf_init: Ice vertical heat diffusion'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namthd_zdf:'
+         WRITE(numout,*) '      Diffusion follows a Beer Law                            ln_zdf_Beer  = ', ln_zdf_Beer
+         WRITE(numout,*) '      thermal conductivity in the ice (Untersteiner 1964)     ln_cndi_U64  = ', ln_cndi_U64
+         WRITE(numout,*) '      thermal conductivity in the ice (Pringle et al 2007)    ln_cndi_P07  = ', ln_cndi_P07
+         WRITE(numout,*) '      thermal conductivity in the snow                        rn_cnd_s     = ', rn_cnd_s
+         WRITE(numout,*) '      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i
+         WRITE(numout,*) '      change the surface non-solar flux with Tsu or not       ln_dqns_i    = ', ln_dqns_i
+     ENDIF
+      !
+      IF ( ( ln_cndi_U64 .AND. ln_cndi_P07 ) .OR. ( .NOT.ln_cndi_U64 .AND. .NOT.ln_cndi_P07 ) ) THEN
+         CALL ctl_stop( 'ice_thd_zdf_init: choose one and only one formulation for thermal conduction (ln_cndi_U64 or ln_cndi_P07)' )
+      ENDIF
+      !
+   END SUBROUTINE ice_thd_zdf_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option       Dummy Module             No ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd_zdf
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90	(revision 8586)
@@ -0,0 +1,451 @@
+MODULE iceupdate
+   !!======================================================================
+   !!                       ***  MODULE iceupdate   ***
+   !!  Sea-ice :   computation of the flux at the sea ice/ocean interface
+   !!======================================================================
+   !! History :   -   ! 2006-07 (M. Vancoppelle)  LIM3 original code
+   !!            3.0  ! 2008-03 (C. Tallandier)  surface module
+   !!             -   ! 2008-04 (C. Tallandier)  split in 2 + new ice-ocean coupling
+   !!            3.3  ! 2010-05 (G. Madec) decrease ocean & ice reference salinities in the Baltic sea
+   !!                 !                  + simplification of the ice-ocean stress calculation
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2012    (D. Iovino) salt flux change
+   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
+   !!            3.5  ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_update_alloc : allocate the iceupdate arrays
+   !!   ice_update_init  : initialisation
+   !!   ice_update_flx   : updates mass, heat and salt fluxes at the ocean surface
+   !!   ice_update_tau   : update i- and j-stresses, and its modulus at the ocean surface
+   !!----------------------------------------------------------------------
+   USE oce     , ONLY : sshn, sshb
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean domain
+   USE ice            ! sea-ice: variables
+!!gm  It should be probably better to pass these variable in argument of the routine, 
+!!gm  rather than having this long list in USE. This will also highlight what is updated, and what is just use.
+   USE sbc_ice
+   USE sbc_oce
+!!gm end
+   USE sbccpl         ! Surface boundary condition: coupled interface
+   USE icealb         ! sea-ice: albedo parameters
+   USE traqsr         ! add penetration of solar flux in the calculation of heat budget
+   USE icectl         ! sea-ice: control prints
+   USE bdy_oce , ONLY : ln_bdy
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_update_init   ! called by ice_init
+   PUBLIC   ice_update_flx    ! called by ice_stp
+   PUBLIC   ice_update_tau    ! called by ice_stp
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2]
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean velocity   [m/s]
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: iceupdate.F90 8411 2017-08-07 16:09:12Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION ice_update_alloc()
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE ice_update_alloc ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( utau_oce(jpi,jpj), vtau_oce(jpi,jpj), tmod_io(jpi,jpj), STAT=ice_update_alloc )
+      !
+      IF( lk_mpp                )   CALL mpp_sum( ice_update_alloc )
+      IF( ice_update_alloc /= 0 )   CALL ctl_warn('ice_update_alloc: failed to allocate arrays')
+      !
+   END FUNCTION ice_update_alloc
+
+
+   SUBROUTINE ice_update_flx( kt )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_update_flx ***
+      !!  
+      !! ** Purpose :   Update the surface ocean boundary condition for heat 
+      !!                salt and mass over areas where sea-ice is non-zero
+      !!         
+      !! ** Action  : - computes the heat and freshwater/salt fluxes
+      !!                at the ice-ocean interface.
+      !!              - Update the ocean sbc
+      !!     
+      !! ** Outputs : - qsr     : sea heat flux:     solar 
+      !!              - qns     : sea heat flux: non solar
+      !!              - emp     : freshwater budget: volume flux 
+      !!              - sfx     : salt flux 
+      !!              - fr_i    : ice fraction
+      !!              - tn_ice  : sea-ice surface temperature
+      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode)
+      !!
+      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
+      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
+      !!              These refs are now obsolete since everything has been revised
+      !!              The ref should be Rousset et al., 2015
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      !
+      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
+      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2)
+      REAL(wp) ::   zqsr             ! New solar flux received by the ocean
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_cs, zalb_os     ! 3D workspace
+      !!---------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('ice_update')
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'ice_update_flx: update fluxes (mass, salt and heat) at the ice-ocean interface'
+         WRITE(numout,*)'~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! --- case we bypass ice thermodynamics --- !
+      IF( .NOT. ln_icethd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere
+         hfx_in   (:,:)   = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
+         hfx_out  (:,:)   = ( 1._wp - at_i_b(:,:) ) *   qns_oce(:,:)                  + qemp_oce(:,:)
+         ftr_ice  (:,:,:) = 0._wp
+         emp_ice  (:,:)   = 0._wp
+         qemp_ice (:,:)   = 0._wp
+         qevap_ice(:,:,:) = 0._wp
+      ENDIF
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
+            !---------------------------------------------------
+            zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - ftr_ice(ji,jj,:) ) )
+
+            ! Total heat flux reaching the ocean = hfx_out (W.m-2) 
+            !---------------------------------------------------
+            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
+            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr
+
+            ! Add the residual from heat diffusion equation and sublimation (W.m-2)
+            !----------------------------------------------------------------------
+            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) +   &
+               &           ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
+
+            ! New qsr and qns used to compute the oceanic heat flux at the next time step
+            !----------------------------------------------------------------------------
+            qsr(ji,jj) = zqsr                                      
+            qns(ji,jj) = hfx_out(ji,jj) - zqsr              
+
+            ! Mass flux at the atm. surface       
+            !-----------------------------------
+            wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj)
+
+            ! Mass flux at the ocean surface      
+            !------------------------------------
+            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
+            !  ------------------------------------------------------------------------------------- 
+            !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
+            !  Thus  FW  flux  =  External ( E-P+snow melt)
+            !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
+            !                     Associated to Ice formation AND Ice melting
+            !                     Even if i see Ice melting as a FW and SALT flux
+            !        
+            ! mass flux from ice/ocean
+            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
+               &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 
+
+            IF ( ln_pnd_fw )   wfx_ice(ji,jj) = wfx_ice(ji,jj) + wfx_pnd(ji,jj)
+
+            ! add the snow melt water to snow mass flux to the ocean
+            wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
+
+            ! mass flux at the ocean/ice interface
+            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
+            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+
+
+            ! Salt flux at the ocean surface      
+            !------------------------------------------
+            sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   &
+               &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
+            
+            ! Mass of snow and ice per unit area   
+            !----------------------------------------
+            snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step
+            !                                               ! new mass per unit area
+            snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj)  ) 
+            !                                               ! time evolution of snow+ice mass
+            snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice
+            
+         END DO
+      END DO
+
+      ! Storing the transmitted variables
+      !----------------------------------
+      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction            
+      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                      
+
+      ! Snow/ice albedo (only if sent to coupler, useless in forced mode)
+      !------------------------------------------------------------------
+      CALL ice_alb( t_su, h_i, h_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
+      !
+      alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+      !
+      IF( lrst_ice ) THEN                       !* write snwice_mass fields in the restart file
+         CALL update_rst( 'WRITE', kt )
+      ENDIF
+      !
+      ! output all fluxes
+      !------------------
+      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * ( 1._wp - at_i_b(:,:) ) )                      !     solar flux at ocean surface
+      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * ( 1._wp - at_i_b(:,:) ) + qemp_oce(:,:) )      ! non-solar flux at ocean surface
+      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface
+      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface
+      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice
+      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * ( 1._wp - at_i_b(:,:) ) + qemp_oce(:,:) )
+      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   &
+         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) )
+!!gm I don't understand the variable below.... why not multiplied by a_i_b or (1-a_i_b) ??? 
+      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )  
+      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )  
+      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce (:,:) )   ! emp over ocean (taking into account the snow blown away from the ice)
+      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice (:,:) )   ! emp over ice   (taking into account the snow blown away from the ice)
+
+      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation [m/day]
+
+      CALL iom_put( "sfxbog"      , sfx_bog             )        ! salt flux from bottom growth
+      CALL iom_put( "sfxbom"      , sfx_bom             )        ! salt flux from bottom melting
+      CALL iom_put( "sfxsum"      , sfx_sum             )        ! salt flux from surface melting
+      CALL iom_put( "sfxlam"      , sfx_lam             )        ! salt flux from lateral melting
+      CALL iom_put( "sfxsni"      , sfx_sni             )        ! salt flux from snow ice formation
+      CALL iom_put( "sfxopw"      , sfx_opw             )        ! salt flux from open water formation
+      CALL iom_put( "sfxdyn"      , sfx_dyn             )        ! salt flux from ridging rafting
+      CALL iom_put( "sfxres"      , sfx_res             )        ! salt flux from corrections (resultant)
+      CALL iom_put( "sfxbri"      , sfx_bri             )        ! salt flux from brines
+      CALL iom_put( "sfxsub"      , sfx_sub             )        ! salt flux from sublimation
+      CALL iom_put( "sfx"         , sfx                 )        ! total salt flux
+
+      CALL iom_put( "vfxres"     , wfx_res              )        ! prod./melting due to corrections 
+      CALL iom_put( "vfxopw"     , wfx_opw              )        ! lateral thermodynamic ice production
+      CALL iom_put( "vfxsni"     , wfx_sni              )        ! snowice ice production
+      CALL iom_put( "vfxbog"     , wfx_bog              )        ! bottom thermodynamic ice production
+      CALL iom_put( "vfxdyn"     , wfx_dyn              )        ! dynamic ice production (rid/raft)
+      CALL iom_put( "vfxsum"     , wfx_sum              )        ! surface melt 
+      CALL iom_put( "vfxbom"     , wfx_bom              )        ! bottom melt 
+      CALL iom_put( "vfxlam"     , wfx_lam              )        ! lateral melt 
+      CALL iom_put( "vfxice"     , wfx_ice              )        ! total ice growth/melt 
+      IF ( ln_pnd )   CALL iom_put( "vfxpnd", wfx_pnd   )        ! melt pond water flux
+
+      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations  
+         WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog
+         ELSEWHERE                                     ; z2d = 0._wp
+         END WHERE
+         CALL iom_put( "vfxthin", ( wfx_opw + z2d )     )
+      ENDIF
+
+      CALL iom_put( "vfxspr"     , wfx_spr              )        ! precip (snow)
+      CALL iom_put( "vfxsnw"     , wfx_snw              )        ! total snw growth/melt 
+      CALL iom_put( "vfxsub"     , wfx_sub              )        ! sublimation (snow/ice) 
+      CALL iom_put( "vfxsub_err" , wfx_err_sub          )        ! "excess" of sublimation sent to ocean      
+ 
+      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   !  
+      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   !  
+      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   !  
+      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   !  
+      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   !  
+      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   !  
+      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   !  
+      CALL iom_put ('hfxerr'     , hfx_err_dif(:,:)     )   !  
+      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   !  
+      
+      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   !  
+      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   !  
+      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   !  
+      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !  
+      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !  
+      CALL iom_put ('hfxtur'     , fhtur(:,:) * at_i_b(:,:) ) ! turbulent heat flux at ice base 
+      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice 
+      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip 
+      !
+      ! controls
+      !---------
+      IF( ln_icediachk .AND. .NOT. ln_bdy)   CALL ice_cons_final('iceupdate')                                       ! conservation
+      IF( ln_icectl                      )   CALL ice_prt       (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints
+      IF( ln_ctl                         )   CALL ice_prt3D     ('iceupdate')                                       ! prints
+      IF( nn_timing == 1                 )   CALL timing_stop   ('ice_update')                                      ! timing
+      !
+   END SUBROUTINE ice_update_flx
+
+
+   SUBROUTINE ice_update_tau( kt, pu_oce, pv_oce )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_update_tau ***
+      !!  
+      !! ** Purpose : Update the ocean surface stresses due to the ice
+      !!         
+      !! ** Action  : * at each ice time step (every nn_fsbc time step):
+      !!                - compute the modulus of ice-ocean relative velocity 
+      !!                  (*rho*Cd) at T-point (C-grid) or I-point (B-grid)
+      !!                      tmod_io = rhoco * | U_ice-U_oce |
+      !!                - update the modulus of stress at ocean surface
+      !!                      taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce |
+      !!              * at each ocean time step (every kt): 
+      !!                  compute linearized ice-ocean stresses as
+      !!                      Utau = tmod_io * | U_ice - pU_oce |
+      !!                using instantaneous current ocean velocity (usually before)
+      !!
+      !!    NB: - ice-ocean rotation angle no more allowed
+      !!        - here we make an approximation: taum is only computed every ice time step
+      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 
+      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
+      !!
+      !! ** Outputs : - utau, vtau   : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes
+      !!              - taum         : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
+      !!---------------------------------------------------------------------
+      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar
+      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      -
+      !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('ice_update')
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'ice_update_tau: update stress at the ice-ocean interface'
+         WRITE(numout,*)'~~~~~~~~~~~~~~'
+      ENDIF
+
+      zrhoco = rau0 * rn_cio
+      !
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
+         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
+            DO ji = fs_2, fs_jpim1
+               !                                               ! 2*(U_ice-U_oce) at T-point
+               zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
+               zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
+               !                                              ! |U_ice-U_oce|^2
+               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
+               !                                               ! update the ocean stress modulus
+               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
+               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
+            END DO
+         END DO
+         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. )
+         !
+         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step
+         vtau_oce(:,:) = vtau(:,:)
+         !
+      ENDIF
+      !
+      !                                      !==  every ocean time-step  ==!
+      !
+      DO jj = 2, jpjm1                                !* update the stress WITHOUT an ice-ocean rotation angle
+         DO ji = fs_2, fs_jpim1   ! Vect. Opt.
+            zat_u  = ( at_i(ji,jj) + at_i(ji+1,jj) ) * 0.5_wp   ! ice area at u and V-points
+            zat_v  = ( at_i(ji,jj) + at_i(ji,jj+1) ) * 0.5_wp
+            !                                                   ! linearized quadratic drag formulation
+            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
+            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
+            !                                                   ! stresses at the ocean surface
+            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
+            vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
+         END DO
+      END DO
+      CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ice_update')
+      !  
+   END SUBROUTINE ice_update_tau
+
+
+   SUBROUTINE ice_update_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_update_init  ***
+      !!             
+      !! ** Purpose :   ???
+      !!
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   zcoefu, zcoefv, zcoeff   ! local scalar
+      !!-------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ice_update_init: ???? '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
+
+      !                                      ! allocate ice_update array
+      IF( ice_update_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_update_init : unable to allocate standard arrays' )
+      !
+      CALL update_rst( 'READ' )  !* read or initialize all required files
+      !
+   END SUBROUTINE ice_update_init
+
+   SUBROUTINE update_rst( cdrw, kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE rhg_evp_rst  ***
+      !!                     
+      !! ** Purpose :   Read or write RHG file in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
+      !
+      INTEGER  ::   iter   ! local integer
+      INTEGER  ::   id1    ! local integer
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize
+         !                                   ! ---------------
+         IF( ln_rstart ) THEN                   !* Read the restart file
+            !
+            id1 = iom_varid( numrir, 'snwice_mass' , ldstop = .FALSE. )
+            !
+            IF( id1 > 0 ) THEN                       ! fields exist
+               CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass   )
+               CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
+            ELSE                                     ! start from rest
+               IF(lwp) WRITE(numout,*) '   ==>>   previous run without snow-ice mass output then set it'
+               snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )
+               snwice_mass_b(:,:) = snwice_mass(:,:)
+            ENDIF
+         ELSE                                   !* Start from rest
+            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set the snow-ice mass'
+            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )
+            snwice_mass_b(:,:) = snwice_mass(:,:)
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- update-rst ----'
+         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1
+         !
+         CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass   )
+         CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
+         !
+      ENDIF
+      !
+   END SUBROUTINE update_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif 
+
+   !!======================================================================
+END MODULE iceupdate
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90	(revision 8586)
@@ -0,0 +1,703 @@
+MODULE icevar
+   !!======================================================================
+   !!                       ***  MODULE icevar ***
+   !!   sea-ice:     Different sets of ice model variables 
+   !!                   how to switch from one to another
+   !!
+   !!                 There are three sets of variables
+   !!                 VGLO : global variables of the model
+   !!                        - v_i (jpi,jpj,jpl)
+   !!                        - v_s (jpi,jpj,jpl)
+   !!                        - a_i (jpi,jpj,jpl)
+   !!                        - t_s (jpi,jpj,jpl)
+   !!                        - e_i (jpi,jpj,nlay_i,jpl)
+   !!                        - sv_i(jpi,jpj,jpl)
+   !!                        - oa_i(jpi,jpj,jpl)
+   !!                 VEQV : equivalent variables sometimes used in the model
+   !!                        - h_i(jpi,jpj,jpl)
+   !!                        - h_s(jpi,jpj,jpl)
+   !!                        - t_i(jpi,jpj,nlay_i,jpl)
+   !!                        ...
+   !!                 VAGG : aggregate variables, averaged/summed over all
+   !!                        thickness categories
+   !!                        - vt_i(jpi,jpj)
+   !!                        - vt_s(jpi,jpj)
+   !!                        - at_i(jpi,jpj)
+   !!                        - et_s(jpi,jpj)  !total snow heat content
+   !!                        - et_i(jpi,jpj)  !total ice thermal content 
+   !!                        - sm_i(jpi,jpj) !mean ice salinity
+   !!                        - tm_i (jpi,jpj) !mean ice temperature
+   !!======================================================================
+   !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!            3.5  ! 2012    (M. Vancoppenolle)  add ice_var_itd
+   !!            3.6  ! 2014-01 (C. Rousset) add ice_var_zapsmall, rewrite ice_var_itd
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_var_agg       : integrate variables over layers and categories
+   !!   ice_var_glo2eqv   : transform from VGLO to VEQV
+   !!   ice_var_eqv2glo   : transform from VEQV to VGLO
+   !!   ice_var_salprof   : salinity profile in the ice
+   !!   ice_var_salprof1d : salinity profile in the ice 1D
+   !!   ice_var_zapsmall  : remove very small area and volume
+   !!   ice_var_itd       : convert 1-cat to multiple cat
+   !!   ice_var_bv        : brine volume
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants (ocean directory) 
+   USE sbc_oce , ONLY : sss_m
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamics variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_var_agg          
+   PUBLIC   ice_var_glo2eqv      
+   PUBLIC   ice_var_eqv2glo      
+   PUBLIC   ice_var_salprof      
+   PUBLIC   ice_var_salprof1d    
+   PUBLIC   ice_var_zapsmall
+   PUBLIC   ice_var_itd
+   PUBLIC   ice_var_bv           
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icevar.F90 8422 2017-08-08 13:58:05Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_var_agg( kn )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_var_agg  ***
+      !!
+      !! ** Purpose :   aggregates ice-thickness-category variables to 
+      !!              all-ice variables, i.e. it turns VGLO into VAGG
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kn     ! =1 state variables only
+      !                                 ! >1 state variables + others
+      !
+      INTEGER ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z1_at_i, z1_vt_i
+      !!-------------------------------------------------------------------
+      !
+      !                                      ! integrated values
+      vt_i(:,:) =       SUM( v_i(:,:,:)           , dim=3 )
+      vt_s(:,:) =       SUM( v_s(:,:,:)           , dim=3 )
+      at_i(:,:) =       SUM( a_i(:,:,:)           , dim=3 )
+      et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 )
+      et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 )
+
+      ! MV MP 2016
+      IF ( ln_pnd ) THEN                     ! Melt pond
+         at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 )
+         vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 )
+      ENDIF
+      ! END MP 2016
+
+      ato_i(:,:) = 1._wp - at_i(:,:)    ! open water fraction  
+
+      IF( kn > 1 ) THEN
+         !
+         ALLOCATE( z1_at_i(jpi,jpj) , z1_vt_i(jpi,jpj) )
+         WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:)
+         ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp
+         END WHERE
+         WHERE( vt_i(:,:) > epsi20 )   ;   z1_vt_i(:,:) = 1._wp / vt_i(:,:)
+         ELSEWHERE                     ;   z1_vt_i(:,:) = 0._wp
+         END WHERE
+         !
+         !                          ! mean ice/snow thickness
+         hm_i(:,:) = vt_i(:,:) * z1_at_i(:,:)
+         hm_s(:,:) = vt_s(:,:) * z1_at_i(:,:)
+         !         
+         !                          ! mean temperature (K), salinity and age
+         tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
+         tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
+         om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:)
+         !
+         tm_i(:,:) = 0._wp
+         sm_i(:,:) = 0._wp
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               tm_i(:,:) = tm_i(:,:) + r1_nlay_i * t_i (:,:,jk,jl) * v_i(:,:,jl) * z1_vt_i(:,:)
+               sm_i(:,:) = sm_i(:,:) + r1_nlay_i * sz_i(:,:,jk,jl) * v_i(:,:,jl) * z1_vt_i(:,:)
+            END DO
+         END DO
+         !
+         DEALLOCATE( z1_at_i , z1_vt_i )
+      ENDIF
+      !
+   END SUBROUTINE ice_var_agg
+
+
+   SUBROUTINE ice_var_glo2eqv
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_var_glo2eqv ***
+      !!
+      !! ** Purpose :   computes equivalent variables as function of  
+      !!              global variables, i.e. it turns VGLO into VEQV
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   ze_i             ! local scalars
+      REAL(wp) ::   ze_s, ztmelts, zbbb, zccc       !   -      -
+      REAL(wp) ::   zhmax, z1_zhmax                 !   -      -
+      REAL(wp) ::   zlay_i, zlay_s                  !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i, z1_v_i
+      !!-------------------------------------------------------------------
+
+!!gm Question 2:  It is possible to define existence of sea-ice in a common way between 
+!!                ice area and ice volume ?
+!!                the idea is to be able to define one for all at the begining of this routine
+!!                a criteria for icy area (i.e. a_i > epsi20 and v_i > epsi20 )
+
+      !-------------------------------------------------------
+      ! Ice thickness, snow thickness, ice salinity, ice age
+      !-------------------------------------------------------
+      !                                            !--- inverse of the ice area
+      WHERE( a_i(:,:,:) > epsi20 )   ;   z1_a_i(:,:,:) = 1._wp / a_i(:,:,:)
+      ELSEWHERE                      ;   z1_a_i(:,:,:) = 0._wp
+      END WHERE
+      !
+      WHERE( v_i(:,:,:) > epsi20 )   ;   z1_v_i(:,:,:) = 1._wp / v_i(:,:,:)
+      ELSEWHERE                      ;   z1_v_i(:,:,:) = 0._wp
+      END WHERE
+      !
+      h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:)    !--- ice thickness
+
+      zhmax    =          hi_max(jpl)
+      z1_zhmax =  1._wp / hi_max(jpl)               
+      WHERE( h_i(:,:,jpl) > zhmax )               !--- bound h_i by hi_max (i.e. 99 m) with associated update of ice area
+         h_i  (:,:,jpl) = zhmax
+         a_i   (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax 
+         z1_a_i(:,:,jpl) = zhmax * z1_v_i(:,:,jpl)          ! NB: v_i always /=0 as h_i > hi_max
+      END WHERE
+
+      h_s(:,:,:) = v_s (:,:,:) * z1_a_i(:,:,:)    !--- snow thickness
+      
+      o_i(:,:,:)  = oa_i(:,:,:) * z1_a_i(:,:,:)    !--- ice age
+
+      IF( nn_icesal == 2 ) THEN                    !--- salinity (with a minimum value imposed everywhere)
+         WHERE( v_i(:,:,:) > epsi20 )   ;   s_i(:,:,:) = MAX( rn_simin , MIN( rn_simax, sv_i(:,:,:) * z1_v_i(:,:,:) ) )
+         ELSEWHERE                      ;   s_i(:,:,:) = rn_simin
+         END WHERE
+      ENDIF
+
+      CALL ice_var_salprof      ! salinity profile
+
+      !-------------------
+      ! Ice temperature   [K]   (with a minimum value (rt0 - 100.))
+      !-------------------
+      zlay_i   = REAL( nlay_i , wp )    ! number of layers
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
+                     !
+                     ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i               ! Energy of melting e(S,T) [J.m-3]
+                     ztmelts          = - sz_i(ji,jj,jk,jl) * tmut                                 ! Ice layer melt temperature [C]
+                     ! Conversion q(S,T) -> T (second order equation)
+                     zbbb             = ( rcp - cpic ) * ztmelts + ze_i * r1_rhoic - lfus
+                     zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * cpic * lfus * ztmelts , 0._wp) )
+                     t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_cpic , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts
+                     !
+                  ELSE                                !--- no ice
+                     t_i(ji,jj,jk,jl) = rt0
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !--------------------
+      ! Snow temperature   [K]   (with a minimum value (rt0 - 100.))
+      !--------------------
+      zlay_s = REAL( nlay_s , wp )
+      DO jk = 1, nlay_s
+         WHERE( v_s(:,:,:) > epsi20 )        !--- icy area
+            t_s(:,:,jk,:) = MAX( -100._wp , MIN( r1_cpic * ( -r1_rhosn * (e_s(:,:,jk,:)/v_s(:,:,:)*zlay_s) + lfus ) , 0._wp ) ) + rt0
+         ELSEWHERE                           !--- no ice
+            t_s(:,:,jk,:) = rt0
+         END WHERE
+      END DO
+
+      ! integrated values 
+      vt_i (:,:) = SUM( v_i, dim=3 )
+      vt_s (:,:) = SUM( v_s, dim=3 )
+      at_i (:,:) = SUM( a_i, dim=3 )
+
+! MV MP 2016
+! probably should resum for melt ponds ???
+
+      !
+   END SUBROUTINE ice_var_glo2eqv
+
+
+   SUBROUTINE ice_var_eqv2glo
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_var_eqv2glo ***
+      !!
+      !! ** Purpose :   computes global variables as function of 
+      !!              equivalent variables,  i.e. it turns VEQV into VGLO
+      !!-------------------------------------------------------------------
+      !
+      v_i (:,:,:) = h_i(:,:,:) * a_i(:,:,:)
+      v_s (:,:,:) = h_s(:,:,:) * a_i(:,:,:)
+      sv_i(:,:,:) = s_i(:,:,:) * v_i(:,:,:)
+      !
+   END SUBROUTINE ice_var_eqv2glo
+
+
+   SUBROUTINE ice_var_salprof
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_var_salprof ***
+      !!
+      !! ** Purpose :   computes salinity profile in function of bulk salinity     
+      !!
+      !! ** Method  : If bulk salinity greater than zsi1, 
+      !!              the profile is assumed to be constant (S_inf)
+      !!              If bulk salinity lower than zsi0,
+      !!              the profile is linear with 0 at the surface (S_zero)
+      !!              If it is between zsi0 and zsi1, it is a
+      !!              alpha-weighted linear combination of s_inf and s_zero
+      !!
+      !! ** References : Vancoppenolle et al., 2007
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
+      REAL(wp) ::   zsal, z1_dS
+      REAL(wp) ::   zargtemp , zs0, zs
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   z_slope_s, zalpha    ! case 2 only
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
+      !!-------------------------------------------------------------------
+
+!!gm Question: Remove the option 3 ?  How many years since it last use ? 
+
+      SELECT CASE ( nn_icesal )
+      !
+      !               !---------------------------------------!
+      CASE( 1 )       !  constant salinity in time and space  !
+         !            !---------------------------------------!
+         sz_i(:,:,:,:) = rn_icesal
+         s_i(:,:,:)   = rn_icesal
+         !
+         !            !---------------------------------------------!
+      CASE( 2 )       !  time varying salinity with linear profile  !
+         !            !---------------------------------------------!
+         !
+         ALLOCATE( z_slope_s(jpi,jpj,jpl) , zalpha(jpi,jpj,jpl) )
+         !
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               sz_i(:,:,jk,jl)  = s_i(:,:,jl)
+            END DO
+         END DO
+         !                                      ! Slope of the linear profile 
+         WHERE( h_i(:,:,:) > epsi20 )   ;   z_slope_s(:,:,:) = 2._wp * s_i(:,:,:) / h_i(:,:,:)
+         ELSEWHERE                       ;   z_slope_s(:,:,:) = 0._wp
+         END WHERE
+         !
+         z1_dS = 1._wp / ( zsi1 - zsi0 )
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  )
+                  !                             ! force a constant profile when SSS too low (Baltic Sea)
+                  IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp  
+               END DO
+            END DO
+         END DO
+
+         ! Computation of the profile
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     !                          ! linear profile with 0 surface value
+                     zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i
+                     zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile
+                     sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) )
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DEALLOCATE( z_slope_s , zalpha )
+         !
+         !            !-------------------------------------------!
+      CASE( 3 )       ! constant salinity with a fix profile      ! (Schwarzacher (1959) multiyear salinity profile
+         !            !-------------------------------------------!                                   (mean = 2.30)
+         !
+         s_i(:,:,:) = 2.30_wp
+!!gm Remark: if we keep the case 3, then compute an store one for all time-step
+!!           a array  S_prof(1:nlay_i) containing the calculation and just do:
+!         DO jk = 1, nlay_i
+!            sz_i(:,:,jk,:) = S_prof(jk)
+!         END DO
+!!gm end
+         !
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
+               sz_i(:,:,jk,jl) =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE ice_var_salprof
+
+   SUBROUTINE ice_var_salprof1d
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_var_salprof1d  ***
+      !!
+      !! ** Purpose :   1d computation of the sea ice salinity profile
+      !!                Works with 1d vectors and is used by thermodynamic modules
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jk    ! dummy loop indices
+      REAL(wp) ::   zargtemp, zsal, z1_dS   ! local scalars
+      REAL(wp) ::   zs, zs0              !   -      -
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z_slope_s, zalpha   !
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
+      !!-------------------------------------------------------------------
+      !
+      SELECT CASE ( nn_icesal )
+      !
+      !               !---------------------------------------!
+      CASE( 1 )       !  constant salinity in time and space  !
+         !            !---------------------------------------!
+         sz_i_1d(1:npti,:) = rn_icesal
+         !
+         !            !---------------------------------------------!
+      CASE( 2 )       !  time varying salinity with linear profile  !
+         !            !---------------------------------------------!
+         !
+         ALLOCATE( z_slope_s(jpij), zalpha(jpij) )
+         !
+         !                                      ! Slope of the linear profile 
+         WHERE( h_i_1d(1:npti) > epsi20 )   ;   z_slope_s(1:npti) = 2._wp * s_i_1d(1:npti) / h_i_1d(1:npti)
+         ELSEWHERE                           ;   z_slope_s(1:npti) = 0._wp
+         END WHERE
+         
+         z1_dS = 1._wp / ( zsi1 - zsi0 )
+         DO ji = 1, npti
+            zalpha(ji) = MAX(  0._wp , MIN(  ( zsi1 - s_i_1d(ji) ) * z1_dS , 1._wp  )  )
+            !                             ! force a constant profile when SSS too low (Baltic Sea)
+            IF( 2._wp * s_i_1d(ji) >= sss_1d(ji) )   zalpha(ji) = 0._wp
+         END DO
+         !
+         ! Computation of the profile
+         DO jk = 1, nlay_i
+            DO ji = 1, npti
+               !                          ! linear profile with 0 surface value
+               zs0 = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * h_i_1d(ji) * r1_nlay_i
+               zs  = zalpha(ji) * zs0 + ( 1._wp - zalpha(ji) ) * s_i_1d(ji)
+               sz_i_1d(ji,jk) = MIN( rn_simax , MAX( zs , rn_simin ) )
+            END DO
+         END DO
+         !
+         DEALLOCATE( z_slope_s, zalpha )
+
+         !            !-------------------------------------------!
+      CASE( 3 )       ! constant salinity with a fix profile      ! (Schwarzacher (1959) multiyear salinity profile
+         !            !-------------------------------------------!                                   (mean = 2.30)
+         !
+         s_i_1d(1:npti) = 2.30_wp
+         !
+!!gm cf remark in ice_var_salprof routine, CASE( 3 )
+         DO jk = 1, nlay_i
+            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
+            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) )
+            DO ji = 1, npti
+               sz_i_1d(ji,jk) = zsal
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE ice_var_salprof1d
+
+
+   SUBROUTINE ice_var_zapsmall
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE ice_var_zapsmall ***
+      !!
+      !! ** Purpose :   Remove too small sea ice areas and correct fluxes
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj) ::   zswitch
+      !!-------------------------------------------------------------------
+      !
+      DO jl = 1, jpl       !==  loop over the categories  ==!
+         !
+         !-----------------------------------------------------------------
+         ! Zap ice energy and use ocean heat to melt ice
+         !-----------------------------------------------------------------
+         WHERE( a_i(:,:,jl) > epsi20 )   ;   h_i(:,:,jl) = v_i(:,:,jl) / a_i(:,:,jl)
+         ELSEWHERE                       ;   h_i(:,:,jl) = 0._wp
+         END WHERE
+         !
+         WHERE( a_i(:,:,jl) < epsi10 .OR. v_i(:,:,jl) < epsi10 .OR. h_i(:,:,jl) < epsi10 )   ;   zswitch(:,:) = 0._wp
+         ELSEWHERE                                                                           ;   zswitch(:,:) = 1._wp
+         END WHERE
+         
+         DO jk = 1, nlay_i
+            DO jj = 1 , jpj
+               DO ji = 1 , jpi
+                  ! update exchanges with ocean
+                  hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj)
+                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+               ! update exchanges with ocean
+               sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoic * r1_rdtice
+               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoic * r1_rdtice
+               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhosn * r1_rdtice
+               hfx_res(ji,jj)  = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s (ji,jj,1,jl) * r1_rdtice ! W.m-2 <0
+               !-----------------------------------------------------------------
+               ! Zap snow energy 
+               !-----------------------------------------------------------------
+               t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) )
+               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * zswitch(ji,jj)
+
+               !-----------------------------------------------------------------
+               ! zap ice and snow volume, add water and salt to ocean
+               !-----------------------------------------------------------------
+               ato_i(ji,jj)    = a_i (ji,jj,jl) * ( 1._wp - zswitch(ji,jj) ) + ato_i(ji,jj)
+               a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj)
+               v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj)
+               v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj)
+               t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) )
+               oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj)
+               sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj)
+
+               h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj)
+               h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj)
+
+            END DO
+         END DO
+
+         IF( ln_pnd ) THEN 
+            DO jj = 1 , jpj
+               DO ji = 1 , jpi
+                  IF( ln_pnd_fw )   &
+                     &   wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_ip(ji,jj,jl) * rhofw * r1_rdtice
+                  a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj)
+                  v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj)
+               END DO
+            END DO
+         ENDIF
+         
+      END DO 
+
+      ! to be sure that at_i is the sum of a_i(jl)
+      at_i (:,:) = SUM( a_i(:,:,:), dim=3 )
+      vt_i (:,:) = SUM( v_i(:,:,:), dim=3 )
+
+      ! open water = 1 if at_i=0
+      WHERE( at_i(:,:) == 0._wp )   ato_i(:,:) = 1._wp
+      !
+   END SUBROUTINE ice_var_zapsmall
+
+
+   SUBROUTINE ice_var_itd( zhti, zhts, zati, zh_i, zh_s, za_i )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_var_itd   ***
+      !!
+      !! ** Purpose :  converting 1-cat ice to multiple ice categories
+      !!
+      !!                  ice thickness distribution follows a gaussian law
+      !!               around the concentration of the most likely ice thickness
+      !!                           (similar as iceistate.F90)
+      !!
+      !! ** Method:   Iterative procedure
+      !!                
+      !!               1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian
+      !!
+      !!               2) Check whether the distribution conserves area and volume, positivity and
+      !!                  category boundaries
+      !!              
+      !!               3) If not (input ice is too thin), the last category is empty and
+      !!                  the number of categories is reduced (jpl-1)
+      !!
+      !!               4) Iterate until ok (SUM(itest(:) = 4)
+      !!
+      !! ** Arguments : zhti: 1-cat ice thickness
+      !!                zhts: 1-cat snow depth
+      !!                zati: 1-cat ice concentration
+      !!
+      !! ** Output    : jpl-cat 
+      !!
+      !!  (Example of application: BDY forcings when input are cell averaged)  
+      !!-------------------------------------------------------------------
+      INTEGER  :: ji, jk, jl             ! dummy loop indices
+      INTEGER  :: ijpij, i_fill, jl0  
+      REAL(wp) :: zarg, zV, zconv, zdh, zdv
+      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zh_i, zh_s, za_i ! output ice/snow variables
+      INTEGER , DIMENSION(4)                  ::   itest
+      !!-------------------------------------------------------------------
+      !
+      ! ----------------------------------------
+      ! distribution over the jpl ice categories
+      ! ----------------------------------------
+      ! a gaussian distribution for ice concentration is used
+      ! then we check whether the distribution fullfills
+      ! volume and area conservation, positivity and ice categories bounds
+      ijpij = SIZE( zhti , 1 )
+      zh_i(1:ijpij,1:jpl) = 0._wp
+      zh_s(1:ijpij,1:jpl) = 0._wp
+      za_i (1:ijpij,1:jpl) = 0._wp
+
+      DO ji = 1, ijpij
+         
+         IF( zhti(ji) > 0._wp ) THEN
+
+            ! find which category (jl0) the input ice thickness falls into
+            jl0 = jpl
+            DO jl = 1, jpl
+               IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN
+                  jl0 = jl
+                  CYCLE
+               ENDIF
+            END DO
+
+            itest(:) = 0
+            i_fill   = jpl + 1                                            !------------------------------------
+            DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )   ! iterative loop on i_fill categories
+               !                                                          !------------------------------------
+               i_fill = i_fill - 1
+               !
+               zh_i(ji,1:jpl) = 0._wp
+               za_i (ji,1:jpl) = 0._wp
+               itest(:)        = 0      
+               
+               IF ( i_fill == 1 ) THEN      !-- case very thin ice: fill only category 1
+                  zh_i(ji,1) = zhti(ji)
+                  za_i (ji,1) = zati (ji)
+               ELSE                         !-- case ice is thicker: fill categories >1
+                  ! thickness
+                  DO jl = 1, i_fill - 1
+                     zh_i(ji,jl) = hi_mean(jl)
+                  END DO
+                  
+                  ! concentration
+                  za_i(ji,jl0) = zati(ji) / SQRT(REAL(jpl))
+                  DO jl = 1, i_fill - 1
+                     IF ( jl /= jl0 ) THEN
+                        zarg        = ( zh_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
+                        za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2)
+                     ENDIF
+                  END DO
+                  
+                  ! last category
+                  za_i(ji,i_fill) = zati(ji) - SUM( za_i(ji,1:i_fill-1) )
+                  zV = SUM( za_i(ji,1:i_fill-1) * zh_i(ji,1:i_fill-1) )
+                  zh_i(ji,i_fill) = ( zhti(ji) * zati(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 ) 
+                  
+                  ! clem: correction if concentration of upper cat is greater than lower cat
+                  !       (it should be a gaussian around jl0 but sometimes it is not)
+                  IF ( jl0 /= jpl ) THEN
+                     DO jl = jpl, jl0+1, -1
+                        IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN
+                           zdv = zh_i(ji,jl) * za_i(ji,jl)
+                           zh_i(ji,jl    ) = 0._wp
+                           za_i (ji,jl    ) = 0._wp
+                           za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 )
+                        END IF
+                     ENDDO
+                  ENDIF
+               
+               ENDIF
+            
+               ! Compatibility tests
+               zconv = ABS( zati(ji) - SUM( za_i(ji,1:jpl) ) ) 
+               IF ( zconv < epsi06 ) itest(1) = 1                                        ! Test 1: area conservation
+            
+               zconv = ABS( zhti(ji)*zati(ji) - SUM( za_i(ji,1:jpl)*zh_i(ji,1:jpl) ) )
+               IF ( zconv < epsi06 ) itest(2) = 1                                        ! Test 2: volume conservation
+               
+               IF ( zh_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1                  ! Test 3: thickness of the last category is in-bounds ?
+               
+               itest(4) = 1
+               DO jl = 1, i_fill
+                  IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0                                ! Test 4: positivity of ice concentrations
+               END DO
+               !                                         !----------------------------
+            END DO                                       ! end iteration on categories
+               !                                         !----------------------------
+         ENDIF
+      END DO
+
+      ! Add Snow in each category where za_i is not 0
+      DO jl = 1, jpl
+         DO ji = 1, ijpij
+            IF( za_i(ji,jl) > 0._wp ) THEN
+               zh_s(ji,jl) = zh_i(ji,jl) * ( zhts(ji) / zhti(ji) )
+               ! In case snow load is in excess that would lead to transformation from snow to ice
+               ! Then, transfer the snow excess into the ice (different from icethd_dh)
+               zdh = MAX( 0._wp, ( rhosn * zh_s(ji,jl) + ( rhoic - rau0 ) * zh_i(ji,jl) ) * r1_rau0 ) 
+               ! recompute h_i, h_s avoiding out of bounds values
+               zh_i(ji,jl) = MIN( hi_max(jl), zh_i(ji,jl) + zdh )
+               zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoic * r1_rhosn )
+            ENDIF
+         END DO
+      END DO
+      !
+    END SUBROUTINE ice_var_itd
+
+
+    SUBROUTINE ice_var_bv
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_var_bv ***
+      !!
+      !! ** Purpose :   computes mean brine volume (%) in sea ice
+      !!
+      !! ** Method  : e = - 0.054 * S (ppt) / T (C)
+      !!
+      !! References : Vancoppenolle et al., JGR, 2007
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      !!-------------------------------------------------------------------
+      !
+!!gm I prefere to use WHERE / ELSEWHERE  to set it to zero only where needed   <<<=== to be done
+!!   instead of setting everything to zero as just below
+      bv_i (:,:,:) = 0._wp
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 )   
+               bv_i(:,:,jl) = bv_i(:,:,jl) - tmut * sz_i(:,:,jk,jl) * r1_nlay_i / ( t_i(:,:,jk,jl) - rt0 )
+            END WHERE
+         END DO
+      END DO
+      WHERE( vt_i(:,:) > epsi20 )   ;   bvm_i(:,:) = SUM( bv_i(:,:,:) * v_i(:,:,:) , dim=3 ) / vt_i(:,:)
+      ELSEWHERE                     ;   bvm_i(:,:) = 0._wp
+      END WHERE
+      !
+   END SUBROUTINE ice_var_bv
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy module           NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icevar
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90	(revision 8586)
@@ -0,0 +1,408 @@
+MODULE icewri
+   !!======================================================================
+   !!                     ***  MODULE  icewri  ***
+   !!   sea-ice : output ice variables
+   !!======================================================================
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_wri       : write of the diagnostics variables in ouput file 
+   !!   ice_wri_state : write for initial state or/and abandon
+   !!----------------------------------------------------------------------
+   USE dianam         ! build name of file (routine)
+   USE phycst         ! physical constant
+   USE dom_oce        ! domain: ocean
+   USE sbc_oce        ! surf. boundary cond.: ocean
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE ice            ! sea-ice: variables
+   USE icevar         ! sea-ice: operations
+   !
+   USE ioipsl         !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
+   USE lbclnk         ! lateral boundary conditions (or mpp links)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ice_wri        ! called by ice_stp
+   PUBLIC ice_wri_state  ! called by dia_wri_state 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icewri.F90 8409 2017-08-07 15:29:21Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_wri( kt )
+      !!-------------------------------------------------------------------
+      !!  This routine computes the average of some variables and write it
+      !!  on the ouput files.
+      !!  ATTENTION cette routine n'est valable que si le pas de temps est
+      !!  egale a une fraction entiere de 1 jours.
+      !!  Diff 1-D 3-D : suppress common also included in etat
+      !!                 suppress cmoymo 11-18
+      !!  modif : 03/06/98
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time-step
+      !
+      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices
+      REAL(wp) ::  z2da, z2db, zrho1, zrho2, zmiss_val
+      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d, zswi, zmiss !  2D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::  zfb              ! ice freeboard
+      REAL(wp), DIMENSION(jpi,jpj)     ::  zamask, zamask15 ! 15% concentration mask
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::  zswi2, zmiss2
+      !
+      ! Global ice diagnostics (SIMIP)
+      REAL(wp) ::  zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh   ! area, extent, volume
+      REAL(wp) ::  zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 
+      !!-------------------------------------------------------------------
+
+      IF( nn_timing == 1 )   CALL timing_start('icewri')
+
+      !----------------------------------------
+      ! Brine volume, switches, missing values
+      !----------------------------------------
+
+      CALL ice_var_bv      ! brine volume
+
+      ! tresholds for outputs
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zswi(ji,jj)      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
+            zamask(ji,jj)    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05   ) ) ! 1 if 5% ice, 0 if less - required to mask thickness and snow depth
+            zamask15(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15   ) ) ! 1 if 15% ice, 0 if less
+         END DO
+      END DO
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zswi2(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
+            END DO
+         END DO
+      END DO
+
+      zmiss_val     = 1.e20_wp
+      zmiss (:,:)   = zmiss_val * ( 1._wp - zswi (:,:) )
+      zmiss2(:,:,:) = zmiss_val * ( 1._wp - zswi2(:,:,:) )
+
+      !----------------------------------------
+      ! Standard outputs
+      !----------------------------------------
+      ! velocity
+      IF( iom_use('uice_ipa') )  CALL iom_put( "uice_ipa" , u_ice         )   ! ice velocity u component
+      IF( iom_use('vice_ipa') )  CALL iom_put( "vice_ipa" , v_ice         )   ! ice velocity v component
+
+      IF( iom_use('icevel') .OR. iom_use('icevel_mv') ) THEN 
+         DO jj = 2 , jpjm1
+            DO ji = 2 , jpim1
+               z2da  = ( u_ice(ji,jj) + u_ice(ji-1,jj) )
+               z2db  = ( v_ice(ji,jj) + v_ice(ji,jj-1) )
+               z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
+           END DO
+         END DO
+         CALL lbc_lnk( z2d, 'T', 1. )
+         IF( iom_use('icevel'   ) )   CALL iom_put( "icevel"       , z2d        )                          ! ice velocity module
+         IF( iom_use('icevel_mv') )   CALL iom_put( "icevel_mv"    , z2d(:,:) * zswi(:,:) + zmiss(:,:) )   ! ice velocity module (missing value)
+      ENDIF
+      !
+      IF( iom_use('miceage')  )       CALL iom_put( "miceage"     , om_i * zswi * zamask15 )  ! mean ice age
+      IF( iom_use('micet')    )       CALL iom_put( "micet"       , ( tm_i  - rt0 ) * zswi )  ! ice mean    temperature
+      IF( iom_use('icest')    )       CALL iom_put( "icest"       , ( tm_su - rt0 ) * zswi )  ! ice surface temperature
+      IF( iom_use('icecolf')  )       CALL iom_put( "icecolf"     , ht_i_new               )  ! new ice thickness formed in the leads
+      !
+      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature
+      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity
+      CALL iom_put( "iceconc"     , at_i  * zswi        )        ! ice concentration
+      CALL iom_put( "icevolu"     , vt_i  * zswi        )        ! ice volume = mean ice thickness over the cell
+      CALL iom_put( "icethick"    , hm_i  * zswi        )        ! ice thickness
+      CALL iom_put( "icehc"       , et_i  * zswi        )        ! ice total heat content
+      CALL iom_put( "isnowhc"     , et_s  * zswi        )        ! snow total heat content
+      CALL iom_put( "ibrinv"      , bvm_i * zswi * 100. )        ! brine volume
+      CALL iom_put( "micesalt"    , sm_i  * zswi      )        ! mean ice salinity
+      CALL iom_put( "snowvol"     , vt_s  * zswi      )        ! snow volume
+      
+      IF ( ln_pnd ) THEN
+         CALL iom_put( "iceamp"  , at_ip  * zswi        )   ! melt pond total fraction
+         CALL iom_put( "icevmp"  , vt_ip  * zswi        )   ! melt pond total volume per unit area
+      ENDIF
+
+      !----------------------------------
+      ! Output category-dependent fields
+      !----------------------------------
+      IF ( iom_use('iceconc_cat' ) )  CALL iom_put( "iceconc_cat"      , a_i  * zswi2   )        ! area for categories
+      IF ( iom_use('icethic_cat' ) )  CALL iom_put( "icethic_cat"      , h_i  * zswi2   )        ! thickness for categories
+      IF ( iom_use('snowthic_cat') )  CALL iom_put( "snowthic_cat"     , h_s  * zswi2   )        ! snow depth for categories
+      IF ( iom_use('salinity_cat') )  CALL iom_put( "salinity_cat"     , s_i  * zswi2   )        ! salinity for categories
+      IF ( iom_use('icetemp_cat' ) )  CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 )    ! ice temperature
+      IF ( iom_use('snwtemp_cat' ) )  CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 )    ! snow temperature
+      IF ( iom_use('iceage_cat'  ) )  CALL iom_put( "iceage_cat" , o_i * zswi2 )                   ! ice age
+      IF ( iom_use('brinevol_cat') )  CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 )          ! brine volume
+
+      IF ( ln_pnd ) THEN
+         IF ( iom_use('iceamp_cat') )  CALL iom_put( "iceamp_cat"     , a_ip       * zswi2   )       ! melt pond frac for categories
+         IF ( iom_use('icevmp_cat') )  CALL iom_put( "icevmp_cat"     , v_ip       * zswi2   )       ! melt pond frac for categories
+         IF ( iom_use('icehmp_cat') )  CALL iom_put( "icehmp_cat"     , h_ip       * zswi2   )       ! melt pond frac for categories
+         IF ( iom_use('iceafp_cat') )  CALL iom_put( "iceafp_cat"     , a_ip_frac  * zswi2   )       ! melt pond frac for categories
+      ENDIF
+
+      !--------------------------------
+      ! Add-ons for SIMIP
+      !--------------------------------
+      zrho1 = ( rau0 - rhoic ) * r1_rau0; zrho2 = rhosn * r1_rau0
+
+      IF ( iom_use( "icepres"  ) ) CALL iom_put( "icepres"     , zswi(:,:)                     )                                ! Ice presence (1 or 0) 
+      IF ( iom_use( "icemass"  ) ) CALL iom_put( "icemass"     , rhoic * vt_i(:,:) * zswi(:,:) )                                ! Ice mass per cell area 
+      IF ( iom_use( "icethic"  ) ) CALL iom_put( "icethic"     , hm_i(:,:) * zamask(:,:)  + ( 1. - zamask(:,:) ) * zmiss_val )     ! Ice thickness 
+      IF ( iom_use( "snomass"  ) ) CALL iom_put( "snomass"     , rhosn * vt_s(:,:)         * zswi(:,:) + zmiss(:,:) )           ! Snow mass per cell area
+      IF ( iom_use( "snothic"  ) ) CALL iom_put( "snothic"     , hm_s(:,:) * zamask(:,:)  + ( 1. - zamask(:,:) ) * zmiss_val )     ! Snow thickness       
+
+      IF ( iom_use( "iceconc_cat_mv"  ) )  CALL iom_put( "iceconc_cat_mv" , a_i(:,:,:)  * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Area for categories
+      IF ( iom_use( "icethic_cat_mv"  ) )  CALL iom_put( "icethic_cat_mv" , h_i(:,:,:) * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Thickness for categories
+      IF ( iom_use( "snowthic_cat_mv" ) )  CALL iom_put( "snowthic_cat_mv", h_s(:,:,:) * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Snow depth for categories
+
+      IF ( iom_use( "icestK"   ) ) CALL iom_put( "icestK"      , tm_su(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Ice surface temperature
+      IF ( iom_use( "icesntK"  ) ) CALL iom_put( "icesntK"     , tm_si(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Snow-ice interface temperature
+      IF ( iom_use( "icebotK"  ) ) CALL iom_put( "icebotK"     , t_bo(:,:)                 * zswi(:,:) + zmiss(:,:) )           ! Ice bottom temperature
+      IF ( iom_use( "iceage"   ) ) CALL iom_put( "iceage"      , om_i(:,:) * zamask15(:,:) + ( 1. - zamask15(:,:) ) * zmiss_val )   ! Ice age
+      IF ( iom_use( "icesmass" ) ) CALL iom_put( "icesmass"    , SUM( sv_i, DIM = 3 ) * rhoic * 1.0e-3 * zswi(:,:) )           ! Mass of salt in sea ice per cell area
+      IF ( iom_use( "icesal"   ) ) CALL iom_put( "icesal"      , sm_i(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Ice salinity
+
+      IF ( iom_use( "icefb"    ) ) THEN
+         zfb(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                         
+         WHERE( zfb < 0._wp ) ;   zfb = 0._wp ;   END WHERE
+                                   CALL iom_put( "icefb"       , zfb(:,:)                  * zswi(:,:) + zmiss(:,:) )           ! Ice freeboard
+      ENDIF
+
+      IF ( iom_use( "isnhcneg" ) ) CALL iom_put( "isnhcneg"    , - et_s(:,:)               * zswi(:,:) + zmiss(:,:) )           ! Snow total heat content
+
+      IF ( iom_use( "dmithd"   ) ) CALL iom_put( "dmithd"      , - wfx_bog - wfx_bom - wfx_sum   &                       ! Sea-ice mass change from thermodynamics
+              &                                                   - wfx_sni - wfx_opw - wfx_res )
+      IF ( iom_use( "dmidyn"   ) ) CALL iom_put( "dmidyn"      , - wfx_dyn(:,:) + rhoic * diag_trp_vi(:,:) )             ! Sea-ice mass change from dynamics(kg/m2/s)
+      IF ( iom_use( "dmiopw"   ) ) CALL iom_put( "dmiopw"      , - wfx_opw                  )                            ! Sea-ice mass change through growth in open water
+      IF ( iom_use( "dmibog"   ) ) CALL iom_put( "dmibog"      , - wfx_bog                  )                            ! Sea-ice mass change through basal growth
+      IF ( iom_use( "dmisni"   ) ) CALL iom_put( "dmisni"      , - wfx_sni                  )                            ! Sea-ice mass change through snow-to-ice conversion
+      IF ( iom_use( "dmisum"   ) ) CALL iom_put( "dmisum"      , - wfx_sum                  )                            ! Sea-ice mass change through surface melting
+      IF ( iom_use( "dmibom"   ) ) CALL iom_put( "dmibom"      , - wfx_bom                  )                            ! Sea-ice mass change through bottom melting
+
+      IF ( iom_use( "dmtsub"   ) ) CALL iom_put( "dmtsub"      , - wfx_sub                  )                            ! Sea-ice mass change through evaporation and sublimation
+      IF ( iom_use( "dmssub"   ) ) CALL iom_put( "dmssub"      , - wfx_snw_sub              )                            ! Snow mass change through sublimation
+      IF ( iom_use( "dmisub"   ) ) CALL iom_put( "dmisub"      , - wfx_ice_sub              )                            ! Sea-ice mass change through sublimation
+
+      IF ( iom_use( "dmsspr"   ) ) CALL iom_put( "dmsspr"      , - wfx_spr                  )                            ! Snow mass change through snow fall
+      IF ( iom_use( "dmsssi"   ) ) CALL iom_put( "dmsssi"      ,   wfx_sni*rhosn*r1_rhoic   )                            ! Snow mass change through snow-to-ice conversion
+
+      IF ( iom_use( "dmsmel"   ) ) CALL iom_put( "dmsmel"      , - wfx_snw_sum              )                            ! Snow mass change through melt
+      IF ( iom_use( "dmsdyn"   ) ) CALL iom_put( "dmsdyn"      , - wfx_snw_dyn(:,:) + rhosn * diag_trp_vs(:,:) )         ! Snow mass change through dynamics(kg/m2/s)
+
+      IF ( iom_use( "hfxsenso" ) ) CALL iom_put( "hfxsenso"    ,   -fhtur(:,:)              * zswi(:,:) + zmiss(:,:) )   ! Sensible oceanic heat flux
+      IF ( iom_use( "hfxconbo" ) ) CALL iom_put( "hfxconbo"    ,   diag_fc_bo               * zswi(:,:) + zmiss(:,:) )   ! Bottom conduction flux
+      IF ( iom_use( "hfxconsu" ) ) CALL iom_put( "hfxconsu"    ,   diag_fc_su               * zswi(:,:) + zmiss(:,:) )   ! Surface conduction flux
+
+      IF ( iom_use( "wfxtot"   ) ) CALL iom_put( "wfxtot"      ,   wfx_ice(:,:)             * zswi(:,:) + zmiss(:,:) )   ! Total freshwater flux from sea ice
+      IF ( iom_use( "wfxsum"   ) ) CALL iom_put( "wfxsum"      ,   wfx_sum(:,:)             * zswi(:,:) + zmiss(:,:) )   ! Freshwater flux from sea-ice surface
+      IF ( iom_use( "sfx_mv"   ) ) CALL iom_put( "sfx_mv"      ,   sfx(:,:) * 0.001         * zswi(:,:) + zmiss(:,:) )   ! Total salt flux
+
+      IF ( iom_use( "uice_mv"  ) ) CALL iom_put( "uice_mv"     ,   u_ice(:,:)               * zswi(:,:) + zmiss(:,:) )   ! ice velocity u component
+      IF ( iom_use( "vice_mv"  ) ) CALL iom_put( "vice_mv"     ,   v_ice(:,:)               * zswi(:,:) + zmiss(:,:) )   ! ice velocity v component
+      
+      IF ( iom_use( "utau_ice" ) ) CALL iom_put( "utau_ice"     ,  utau_ice(:,:)            * zswi(:,:) + zmiss(:,:) )   ! Wind stress term in force balance (x)
+      IF ( iom_use( "vtau_ice" ) ) CALL iom_put( "vtau_ice"     ,  vtau_ice(:,:)            * zswi(:,:) + zmiss(:,:) )   ! Wind stress term in force balance (y)
+
+      !--------------------------------
+      ! Global ice diagnostics (SIMIP)
+      !--------------------------------
+      !
+      IF ( iom_use( "NH_icearea" ) .OR. iom_use( "NH_icevolu" ) .OR. iom_use( "NH_iceextt" ) )   THEN   ! NH diagnostics
+         !
+         WHERE( ff_t > 0._wp )   ;   zswi(:,:) = 1.0e-12
+         ELSEWHERE               ;   zswi(:,:) = 0.
+         END WHERE 
+         zdiag_area_nh = glob_sum( at_i(:,:) * zswi(:,:) * e1e2t(:,:) )
+         zdiag_volu_nh = glob_sum( vt_i(:,:) * zswi(:,:) * e1e2t(:,:) )
+         !
+         WHERE( ff_t > 0._wp .AND. at_i > 0.15 )   ; zswi(:,:) = 1.0e-12
+         ELSEWHERE                                 ; zswi(:,:) = 0.
+         END WHERE 
+         zdiag_extt_nh = glob_sum( zswi(:,:) * e1e2t(:,:) )
+         !
+         IF ( iom_use( "NH_icearea" ) )   CALL iom_put( "NH_icearea" ,  zdiag_area_nh  )
+         IF ( iom_use( "NH_icevolu" ) )   CALL iom_put( "NH_icevolu" ,  zdiag_volu_nh  )
+         IF ( iom_use( "NH_iceextt" ) )   CALL iom_put( "NH_iceextt" ,  zdiag_extt_nh  )
+         !
+      ENDIF
+      !
+      IF ( iom_use( "SH_icearea" ) .OR. iom_use( "SH_icevolu" ) .OR. iom_use( "SH_iceextt" ) )   THEN   ! SH diagnostics
+         !
+         WHERE( ff_t < 0._wp ); zswi(:,:) = 1.0e-12; 
+         ELSEWHERE            ; zswi(:,:) = 0.
+         END WHERE 
+         zdiag_area_sh = glob_sum( at_i(:,:) * zswi(:,:) * e1e2t(:,:) ) 
+         zdiag_volu_sh = glob_sum( vt_i(:,:) * zswi(:,:) * e1e2t(:,:) )
+         !
+         WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zswi(:,:) = 1.0e-12
+         ELSEWHERE                              ; zswi(:,:) = 0.
+         END WHERE 
+         zdiag_extt_sh = glob_sum( zswi(:,:) * e1e2t(:,:) )
+         !
+         IF ( iom_use( "SH_icearea" ) ) CALL iom_put( "SH_icearea", zdiag_area_sh )
+         IF ( iom_use( "SH_icevolu" ) ) CALL iom_put( "SH_icevolu", zdiag_volu_sh )
+         IF ( iom_use( "SH_iceextt" ) ) CALL iom_put( "SH_iceextt", zdiag_extt_sh )
+         !
+      ENDIF 
+      !
+!!CR      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
+!!CR      !     IF( kindic < 0 )   CALL ice_wri_state( 'output.abort' )
+!!CR      !     not yet implemented
+!!gm  idem for the ocean...  Ask Seb how to get read of ioipsl....
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('icewri')
+      !
+   END SUBROUTINE ice_wri
+
+ 
+   SUBROUTINE ice_wri_state( kt, kid, kh_i )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE ice_wri_state  ***
+      !!        
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!      the instantaneous ice state and forcing fields for ice model
+      !!        Used to find errors in the initial state or save the last
+      !!      ocean state in case of abnormal end of a simulation
+      !!
+      !! History :   4.0  !  2013-06  (C. Rousset)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )   ::   kt               ! ocean time-step index
+      INTEGER, INTENT( in )   ::   kid , kh_i
+      INTEGER                 ::   nz_i, jl
+      REAL(wp), DIMENSION(jpl) :: jcat
+      !!----------------------------------------------------------------------
+      !
+      DO jl = 1, jpl
+         jcat(jl) = REAL(jl)
+      END DO
+      
+      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up")
+
+      CALL histdef( kid, "sithic", "Ice thickness"           , "m"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "siconc", "Ice concentration"       , "%"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sitemp", "Ice temperature"         , "C"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sivelu", "i-Ice speed "            , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sivelv", "j-Ice speed "            , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa"     ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa"     ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sisflx", "Solar flux over ocean"     , "w/m2" ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sisali", "Ice salinity"            , "PSU"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sivolu", "Ice volume"              , "m"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sidive", "Ice divergence"          , "10-8s-1",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+
+      ! MV MP 2016
+      IF ( ln_pnd ) THEN
+         CALL histdef( kid, "si_amp", "Melt pond fraction"      , "%"      ,   &
+      &         jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+         CALL histdef( kid, "si_vmp", "Melt pond volume"        ,  "m"     ,   &
+      &         jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      ENDIF
+      ! END MV MP 2016
+
+      CALL histdef( kid, "vfxbog", "Ice bottom production"   , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxdyn", "Ice dynamic production"  , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxopw", "Ice open water prod"     , "m/s"    ,   &
+      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxsni", "Snow ice production "    , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxres", "Ice prod from corrections" , "m/s"  ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxbom", "Ice bottom melt"         , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxsum", "Ice surface melt"        , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+
+      CALL histdef( kid, "sithicat", "Ice thickness"         , "m"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "siconcat", "Ice concentration"     , "%"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sisalcat", "Ice salinity"           , ""      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sitemcat", "Ice temperature"       , "C"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "snthicat", "Snw thickness"         , "m"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sntemcat", "Snw temperature"       , "C"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+
+      CALL histend( kid, snc4set )   ! end of the file definition
+
+      CALL histwrite( kid, "sithic", kt, hm_i           , jpi*jpj, (/1/) )    
+      CALL histwrite( kid, "siconc", kt, at_i           , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sitemp", kt, tm_i - rt0     , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sivelu", kt, u_ice          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sivelv", kt, v_ice          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sistru", kt, utau_ice       , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sistrv", kt, vtau_ice       , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sisali", kt, sm_i           , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sivolu", kt, vt_i           , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sidive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
+
+      ! MV MP 2016
+      IF ( ln_pnd ) THEN
+         CALL histwrite( kid, "si_amp", kt, at_ip         , jpi*jpj, (/1/) )
+         CALL histwrite( kid, "si_vmp", kt, vt_ip         , jpi*jpj, (/1/) )
+      ENDIF
+      ! END MV MP 2016
+
+      CALL histwrite( kid, "vfxbog", kt, wfx_bog        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxdyn", kt, wfx_dyn        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxopw", kt, wfx_opw        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxsni", kt, wfx_sni        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxres", kt, wfx_res        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxbom", kt, wfx_bom        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxsum", kt, wfx_sum        , jpi*jpj, (/1/) )
+      IF ( ln_pnd ) &
+         CALL histwrite( kid, "vfxpnd", kt, wfx_pnd     , jpi*jpj, (/1/) )
+
+      CALL histwrite( kid, "sithicat", kt, h_i         , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "sisalcat", kt, s_i         , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "sitemcat", kt, tm_i - rt0  , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "snthicat", kt, h_s         , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) )    
+
+      !! The file is closed in dia_wri_state (ocean routine)
+      !! CALL histclo( kid )
+      !
+    END SUBROUTINE ice_wri_state
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module         NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icewri
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90	(revision 8568)
+++ 	(revision )
@@ -1,418 +1,0 @@
-MODULE limadv_prather 
-   !!======================================================================
-   !!                       ***  MODULE limadv_prather   ***
-   !! LIM sea-ice model : sea-ice advection => Prather scheme
-   !!======================================================================
-   !! History :  LIM  ! 2008-03 (M. Vancoppenolle)  LIM-3 from LIM-2 code
-   !!            3.2  ! 2009-06 (F. Dupont)  correct a error in the North fold b. c.
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!--------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                     LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_adv_x  : advection of sea ice on x axis
-   !!   lim_adv_y  : advection of sea ice on y axis
-   !!----------------------------------------------------------------------
-   USE dom_oce          ! ocean domain
-   USE ice              ! LIM-3 variables
-   USE lbclnk           ! lateral boundary condition - MPP exchanges
-   USE in_out_manager   ! I/O manager
-   USE prtctl           ! Print control
-   USE lib_mpp          ! MPP library
-   USE wrk_nemo         ! work arrays
-   USE lib_fortran      ! to use key_nosignedzero
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_adv_x   ! called by lim_trp
-   PUBLIC   lim_adv_y   ! called by lim_trp
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id: limadv.F90 6746 2016-06-27 17:20:57Z clem $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_adv_x( pdf, put , pcrh, psm , ps0 ,   &
-      &                  psx, psxx, psy , psyy, psxy )
-      !!---------------------------------------------------------------------
-      !!                **  routine lim_adv_x  **
-      !!  
-      !! ** purpose :   Computes and adds the advection trend to sea-ice
-      !!              variable on i-axis
-      !!
-      !! ** method  :   Uses Prather second order scheme that advects tracers
-      !!              but also theirquadratic forms. The method preserves
-      !!              tracer structures by conserving second order moments.
-      !!
-      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
-      !!--------------------------------------------------------------------
-      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
-      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   put                ! i-direction ice velocity at U-point [m/s]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
-      !! 
-      INTEGER  ::   ji, jj                               ! dummy loop indices
-      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars
-      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      -
-      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zf0 , zfx  , zfy   , zbet   ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zfm , zfxx , zfyy  , zfxy   !  -      -
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zalg, zalg1, zalg1q         !  -      -
-      !---------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
-      CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
-
-      ! Limitation of moments.                                           
-
-      zrdt = rdt_ice * pdf      ! If ice drift field is too fast, use an appropriate time step for advection.
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zslpmax = MAX( 0._wp, ps0(ji,jj) )
-            zs1max  = 1.5 * zslpmax
-            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) )
-            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
-               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  )
-            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
-
-            ps0 (ji,jj) = zslpmax  
-            psx (ji,jj) = zs1new      * rswitch
-            psxx(ji,jj) = zs2new      * rswitch
-            psy (ji,jj) = psy (ji,jj) * rswitch
-            psyy(ji,jj) = psyy(ji,jj) * rswitch
-            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
-         END DO
-      END DO
-
-      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
-      psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
-
-      !  Calculate fluxes and moments between boxes i<-->i+1              
-      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0 
-         DO ji = 1, jpi
-            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
-            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)
-            zalfq        =  zalf * zalf
-            zalf1        =  1.0 - zalf
-            zalf1q       =  zalf1 * zalf1
-            !
-            zfm (ji,jj)  =  zalf  *   psm (ji,jj)
-            zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj) )  )
-            zfx (ji,jj)  =  zalfq * ( psx (ji,jj) + 3.0 * zalf1 * psxx(ji,jj) )
-            zfxx(ji,jj)  =  zalf  *   psxx(ji,jj) * zalfq
-            zfy (ji,jj)  =  zalf  * ( psy (ji,jj) + zalf1 * psxy(ji,jj) )
-            zfxy(ji,jj)  =  zalfq *   psxy(ji,jj)
-            zfyy(ji,jj)  =  zalf  *   psyy(ji,jj)
-
-            !  Readjust moments remaining in the box.
-            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
-            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
-            psx (ji,jj)  =  zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) )
-            psxx(ji,jj)  =  zalf1  * zalf1q * psxx(ji,jj)
-            psy (ji,jj)  =  psy (ji,jj) - zfy(ji,jj)
-            psyy(ji,jj)  =  psyy(ji,jj) - zfyy(ji,jj)
-            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
-         END DO
-      END DO
-
-      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0.
-         DO ji = 1, fs_jpim1
-            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 
-            zalg  (ji,jj) = zalf
-            zalfq         = zalf * zalf
-            zalf1         = 1.0 - zalf
-            zalg1 (ji,jj) = zalf1
-            zalf1q        = zalf1 * zalf1
-            zalg1q(ji,jj) = zalf1q
-            !
-            zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji+1,jj)
-            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) )
-            zfx   (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) )
-            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji+1,jj) * zalfq
-            zfy   (ji,jj) = zfy (ji,jj) + zalf  * ( psy (ji+1,jj) - zalf1 * psxy(ji+1,jj) )
-            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji+1,jj)
-            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji+1,jj)
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1                     !  Readjust moments remaining in the box. 
-         DO ji = fs_2, fs_jpim1
-            zbt  =       zbet(ji-1,jj)
-            zbt1 = 1.0 - zbet(ji-1,jj)
-            !
-            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) )
-            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) )
-            psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) )
-            psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj)
-            psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) )
-            psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) )
-            psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj)
-         END DO
-      END DO
-
-      !   Put the temporary moments into appropriate neighboring boxes.    
-      DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0.
-         DO ji = fs_2, fs_jpim1
-            zbt  =       zbet(ji-1,jj)
-            zbt1 = 1.0 - zbet(ji-1,jj)
-            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj)
-            zalf        = zbt * zfm(ji-1,jj) / psm(ji,jj)
-            zalf1       = 1.0 - zalf
-            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj)
-            !
-            ps0 (ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj)
-            psx (ji,jj) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj)
-            psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj)                               &
-               &                + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  )   &
-               &                                                + zbt1 * psxx(ji,jj)
-            psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj)             &
-               &                + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj) ) )   &
-               &                                                + zbt1 * psxy(ji,jj)
-            psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj)
-            psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj)
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1                     !  Flux from i+1 to i IF u LT 0.
-         DO ji = fs_2, fs_jpim1
-            zbt  =       zbet(ji,jj)
-            zbt1 = 1.0 - zbet(ji,jj)
-            psm(ji,jj)  = zbt * psm(ji,jj)  + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
-            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
-            zalf1       = 1.0 - zalf
-            ztemp       = - zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)
-            !
-            ps0(ji,jj)  = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )
-            psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp )
-            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( zalf * zalf * zfxx(ji,jj)  + zalf1 * zalf1 * psxx(ji,jj)  &
-               &                                      + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) )      &
-               &                                      + ( zalf1 - zalf ) * ztemp ) )
-            psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)  &
-               &                                      + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) )  )
-            psy(ji,jj)  = zbt * psy (ji,jj)  + zbt1 * ( psy (ji,jj) + zfy (ji,jj) )
-            psyy(ji,jj) = zbt * psyy(ji,jj)  + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) )
-         END DO
-      END DO
-
-      !-- Lateral boundary conditions
-      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   &
-         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes
-         &              , psxx, 'T',  1., psyy, 'T',  1.   &
-         &              , psxy, 'T',  1. )
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_x: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
-         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_x: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
-         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_x: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
-         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :')
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
-      CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
-      !
-   END SUBROUTINE lim_adv_x
-
-
-   SUBROUTINE lim_adv_y( pdf, pvt , pcrh, psm , ps0 ,   &
-      &                  psx, psxx, psy , psyy, psxy )
-      !!---------------------------------------------------------------------
-      !!                **  routine lim_adv_y  **
-      !!            
-      !! ** purpose :   Computes and adds the advection trend to sea-ice 
-      !!              variable on y axis
-      !!
-      !! ** method  :   Uses Prather second order scheme that advects tracers
-      !!              but also their quadratic forms. The method preserves 
-      !!              tracer structures by conserving second order moments.
-      !! 
-      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
-      !!---------------------------------------------------------------------
-      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
-      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvt                ! j-direction ice velocity at V-point [m/s]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
-      !!
-      INTEGER  ::   ji, jj                               ! dummy loop indices
-      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars
-      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
-      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zf0, zfx , zfy , zbet   ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zfm, zfxx, zfyy, zfxy   !  -      -
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zalg, zalg1, zalg1q     !  -      -
-      !---------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
-      CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
-
-      ! Limitation of moments.
-
-      zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection.
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zslpmax = MAX( 0._wp, ps0(ji,jj) )
-            zs1max  = 1.5 * zslpmax
-            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) )
-            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
-               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  )
-            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
-            !
-            ps0 (ji,jj) = zslpmax  
-            psx (ji,jj) = psx (ji,jj) * rswitch
-            psxx(ji,jj) = psxx(ji,jj) * rswitch
-            psy (ji,jj) = zs1new * rswitch
-            psyy(ji,jj) = zs2new * rswitch
-            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
-         END DO
-      END DO
-
-      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
-      psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
-
-      !  Calculate fluxes and moments between boxes j<-->j+1              
-      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0   
-         DO ji = 1, jpi
-            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
-            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)
-            zalfq        =  zalf * zalf
-            zalf1        =  1.0 - zalf
-            zalf1q       =  zalf1 * zalf1
-            !
-            zfm (ji,jj)  =  zalf  * psm(ji,jj)
-            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) ) 
-            zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) )
-            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj)
-            zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) )
-            zfxy(ji,jj)  =  zalfq * psxy(ji,jj)
-            zfxx(ji,jj)  =  zalf  * psxx(ji,jj)
-            !
-            !  Readjust moments remaining in the box.
-            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
-            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
-            psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) )
-            psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj)
-            psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj)
-            psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj)
-            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
-         END DO
-      END DO
-      !
-      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
-         DO ji = 1, jpi
-            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 
-            zalg  (ji,jj) = zalf
-            zalfq         = zalf * zalf
-            zalf1         = 1.0 - zalf
-            zalg1 (ji,jj) = zalf1
-            zalf1q        = zalf1 * zalf1
-            zalg1q(ji,jj) = zalf1q
-            !
-            zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji,jj+1)
-            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) )
-            zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) )
-            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji,jj+1) * zalfq
-            zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx (ji,jj+1) - zalf1 * psxy(ji,jj+1) )
-            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji,jj+1)
-            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji,jj+1)
-         END DO
-      END DO
-
-      !  Readjust moments remaining in the box. 
-      DO jj = 2, jpj
-         DO ji = 1, jpi
-            zbt  =         zbet(ji,jj-1)
-            zbt1 = ( 1.0 - zbet(ji,jj-1) )
-            !
-            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) )
-            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) )
-            psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) )
-            psyy(ji,jj) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj)
-            psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) )
-            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) )
-            psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj)
-         END DO
-      END DO
-
-      !   Put the temporary moments into appropriate neighboring boxes.    
-      DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0.
-         DO ji = 1, jpi
-            zbt  =         zbet(ji,jj-1)
-            zbt1 = ( 1.0 - zbet(ji,jj-1) )
-            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 
-            zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj) 
-            zalf1       = 1.0 - zalf
-            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1)
-            !
-            ps0(ji,jj)  = zbt  * ( ps0(ji,jj) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj)
-            psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   &
-               &                                               + zbt1 * psy(ji,jj)  
-            psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             &
-               &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   & 
-               &                                               + zbt1 * psyy(ji,jj)
-            psxy(ji,jj) = zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)               &
-               &                  + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) )  )   &
-               &                                                + zbt1 * psxy(ji,jj)
-            psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj)
-            psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj)
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0.
-         DO ji = 1, jpi
-            zbt  =         zbet(ji,jj)
-            zbt1 = ( 1.0 - zbet(ji,jj) )
-            psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
-            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
-            zalf1       = 1.0 - zalf
-            ztemp       = - zalf * ps0 (ji,jj) + zalf1 * zf0(ji,jj)
-            ps0 (ji,jj) =   zbt  * ps0 (ji,jj) + zbt1  * ( ps0(ji,jj) + zf0(ji,jj) )
-            psy (ji,jj) =   zbt  * psy (ji,jj) + zbt1  * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp )
-            psyy(ji,jj) =   zbt  * psyy(ji,jj) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)   &
-               &                                         + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) )          &
-               &                                         + ( zalf1 - zalf ) * ztemp )                                )
-            psxy(ji,jj) =   zbt  * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)       &
-               &                                         + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) )  )
-            psx (ji,jj) =   zbt  * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) )
-            psxx(ji,jj) =   zbt  * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) )
-         END DO
-      END DO
-
-      !-- Lateral boundary conditions
-      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   &
-         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes
-         &              , psxx, 'T',  1.,  psyy, 'T',  1.   &
-         &              , psxy, 'T',  1. )
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_y: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
-         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_y: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
-         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_y: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
-         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_y: psxy :')
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
-      CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
-      !
-   END SUBROUTINE lim_adv_y
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option            Dummy module         NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-#endif
-
-   !!======================================================================
-END MODULE limadv_prather
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90	(revision 8568)
+++ 	(revision )
@@ -1,587 +1,0 @@
-MODULE limadv_umx
-   !!==============================================================================
-   !!                       ***  MODULE  limadv_umx  ***
-   !! LIM sea-ice model : sea-ice advection using the ULTIMATE-MACHO scheme
-   !!==============================================================================
-   !! History :  3.5  !  2014-11  (C. Rousset, G. Madec)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   lim_adv_umx   : update the tracer trend with the 3D advection trends using a TVD scheme
-   !!   ultimate      : compute a tracer value at velocity points using ULTIMATE scheme at various orders
-   !!   macho         : 
-   !!   nonosc_2d     : compute monotonic tracer fluxes by a non-oscillatory algorithm 
-   !!----------------------------------------------------------------------
-   USE phycst         ! physical constant
-   USE dom_oce        ! ocean domain
-   USE sbc_oce        ! ocean surface boundary condition
-   USE ice            ! ice variables
-   !
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! lateral boundary conditions -- MPP exchanges
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_adv_umx    ! routine called by limtrp.F90
-      
-   REAL(wp) ::   z1_6   = 1._wp / 6._wp   ! =1/6
-   REAL(wp) ::   z1_120 = 1._wp / 120._wp ! =1/120
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: limadv_umx.F90 4499 2014-02-18 15:14:31Z timgraham $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_adv_umx( kt, pdt, puc, pvc, pubox, pvbox, ptc )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_adv_umx  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction)
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - pt  the after advective tracer
-      !!----------------------------------------------------------------------
-      INTEGER                     , INTENT(in   )           ::   kt         ! number of iteration
-      REAL(wp)                    , INTENT(in   )           ::   pdt        ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   puc, pvc   ! 2 ice velocity components => u*e2
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   pubox, pvbox   ! upstream velocity
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   ptc        ! tracer content field
-      !
-      INTEGER  ::   ji, jj           ! dummy loop indices  
-      REAL(wp) ::   ztra             ! local scalar
-      REAL(wp) ::   zfp_ui, zfp_vj   !   -      -
-      REAL(wp) ::   zfm_ui, zfm_vj   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('lim_adv_umx')
-      !
-      CALL wrk_alloc( jpi,jpj,   zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )
-      !
-      !
-      !  upstream advection with initial mass fluxes & intermediate update
-      ! --------------------------------------------------------------------
-      DO jj = 1, jpjm1         ! upstream tracer flux in the i and j direction
-         DO ji = 1, fs_jpim1   ! vector opt.
-            zfp_ui = puc(ji,jj) + ABS( puc(ji,jj) )
-            zfm_ui = puc(ji,jj) - ABS( puc(ji,jj) )
-            zfp_vj = pvc(ji,jj) + ABS( pvc(ji,jj) )
-            zfm_vj = pvc(ji,jj) - ABS( pvc(ji,jj) )
-            zfu_ups(ji,jj) = 0.5_wp * ( zfp_ui * ptc(ji,jj) + zfm_ui * ptc(ji+1,jj  ) )
-            zfv_ups(ji,jj) = 0.5_wp * ( zfp_vj * ptc(ji,jj) + zfm_vj * ptc(ji  ,jj+1) )
-         END DO
-      END DO
-      
-      DO jj = 2, jpjm1            ! total intermediate advective trends
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ztra = - (   zfu_ups(ji,jj) - zfu_ups(ji-1,jj  )   &
-               &       + zfv_ups(ji,jj) - zfv_ups(ji  ,jj-1)   ) * r1_e1e2t(ji,jj)
-            !
-            ztrd(ji,jj) =                         ztra                         ! upstream trend [ -div(uh) or -div(uhT) ]  
-            zt_ups (ji,jj) = ( ptc(ji,jj) + pdt * ztra ) * tmask(ji,jj,1)      ! guess after content field with monotonic scheme
-         END DO
-      END DO
-      CALL lbc_lnk( zt_ups, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign)
-      
-      ! High order (_ho) fluxes 
-      ! -----------------------
-      SELECT CASE( nn_limadv_ord )
-      CASE ( 20 )                          ! centered second order
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( ptc(ji,jj) + ptc(ji+1,jj) )
-               zfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( ptc(ji,jj) + ptc(ji,jj+1) )
-            END DO
-         END DO
-         !
-      CASE ( 1:5 )                      ! 1st to 5th order ULTIMATE-MACHO scheme
-         CALL macho( kt, nn_limadv_ord, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v )
-         !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zfu_ho(ji,jj) = puc(ji,jj) * zt_u(ji,jj)
-               zfv_ho(ji,jj) = pvc(ji,jj) * zt_v(ji,jj)
-            END DO
-         END DO
-         !
-      END SELECT
-         
-      ! antidiffusive flux : high order minus low order
-      ! --------------------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zfu_ho(ji,jj) = zfu_ho(ji,jj) - zfu_ups(ji,jj)
-            zfv_ho(ji,jj) = zfv_ho(ji,jj) - zfv_ups(ji,jj)
-         END DO
-      END DO
-      CALL lbc_lnk_multi( zfu_ho, 'U', -1., zfv_ho, 'V', -1. )         ! Lateral bondary conditions
-      
-      ! monotonicity algorithm
-      ! -------------------------
-      CALL nonosc_2d( ptc, zfu_ho, zfv_ho, zt_ups, pdt )
-      
-      ! final trend with corrected fluxes
-      ! ------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.  
-            ztra       = ztrd(ji,jj)  - (  zfu_ho(ji,jj) - zfu_ho(ji-1,jj  )   &
-               &                         + zfv_ho(ji,jj) - zfv_ho(ji  ,jj-1) ) * r1_e1e2t(ji,jj)  
-            ptc(ji,jj) = ptc(ji,jj) + pdt * ztra
-         END DO
-      END DO
-      CALL lbc_lnk( ptc(:,:) , 'T',  1. )
-      !
-      !
-      CALL wrk_dealloc( jpi,jpj,   zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('lim_adv_umx')
-      !
-   END SUBROUTINE lim_adv_umx
-
-
-   SUBROUTINE macho( kt, k_order, pdt, ptc, puc, pvc, pubox, pvbox, pt_u, pt_v )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE ultimate_x  ***
-      !!     
-      !! **  Purpose :   compute  
-      !!
-      !! **  Method  :   ... ???
-      !!                 TIM = transient interpolation Modeling 
-      !!
-      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
-      !!----------------------------------------------------------------------
-      INTEGER                     , INTENT(in   ) ::   kt         ! number of iteration
-      INTEGER                     , INTENT(in   ) ::   k_order    ! order of the ULTIMATE scheme
-      REAL(wp)                    , INTENT(in   ) ::   pdt        ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptc        ! tracer fields
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   puc, pvc   ! 2 ice velocity components
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pubox, pvbox   ! upstream velocity
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_u, pt_v ! tracer at u- and v-points 
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp) ::   zc_box    !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: zzt
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('macho')
-      !
-      CALL wrk_alloc( jpi,jpj,   zzt )
-      !
-      IF( MOD( (kt - 1) / nn_fsbc , 2 ) == 0 ) THEN         !==  odd ice time step:  adv_x then adv_y  ==!
-         !
-         !                                                           !--  ultimate interpolation of pt at u-point  --!
-         CALL ultimate_x( k_order, pdt, ptc, puc, pt_u )
-         !
-         !                                                           !--  advective form update in zzt  --!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zzt(ji,jj) = ptc(ji,jj) - pubox(ji,jj) * pdt * ( pt_u(ji,jj) - pt_u(ji-1,jj) ) * r1_e1t(ji,jj)  &
-                  &                    - ptc  (ji,jj) * pdt * ( puc (ji,jj) - puc (ji-1,jj) ) * r1_e1e2t(ji,jj)
-               zzt(ji,jj) = zzt(ji,jj) * tmask(ji,jj,1)
-            END DO
-         END DO
-         CALL lbc_lnk( zzt, 'T', 1. )
-         !
-         !                                                           !--  ultimate interpolation of pt at v-point  --!
-         CALL ultimate_y( k_order, pdt, zzt, pvc, pt_v )
-         !
-      ELSE                                                  !==  even ice time step:  adv_y then adv_x  ==!
-         !
-         !                                                           !--  ultimate interpolation of pt at v-point  --!
-         CALL ultimate_y( k_order, pdt, ptc, pvc, pt_v )
-         !
-         !                                                           !--  advective form update in zzt  --!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zzt(ji,jj) = ptc(ji,jj) - pvbox(ji,jj) * pdt * ( pt_v(ji,jj) - pt_v(ji,jj-1) ) * r1_e2t(ji,jj)  &
-                  &                    - ptc  (ji,jj) * pdt * ( pvc (ji,jj) - pvc (ji,jj-1) ) * r1_e1e2t(ji,jj)
-               zzt(ji,jj) = zzt(ji,jj) * tmask(ji,jj,1)
-            END DO
-         END DO
-         CALL lbc_lnk( zzt, 'T', 1. )
-         !
-         !                                                           !--  ultimate interpolation of pt at u-point  --!
-         CALL ultimate_x( k_order, pdt, zzt, puc, pt_u )
-         !      
-      ENDIF      
-      !
-      CALL wrk_dealloc( jpi,jpj,   zzt )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('macho')
-      !
-   END SUBROUTINE macho
-
-
-   SUBROUTINE ultimate_x( k_order, pdt, pt, puc, pt_u )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE ultimate_x  ***
-      !!     
-      !! **  Purpose :   compute  
-      !!
-      !! **  Method  :   ... ???
-      !!                 TIM = transient interpolation Modeling 
-      !!
-      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
-      !!----------------------------------------------------------------------
-      INTEGER                     , INTENT(in   ) ::   k_order   ! ocean time-step index
-      REAL(wp)                    , INTENT(in   ) ::   pdt       ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   puc       ! ice i-velocity component
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pt        ! tracer fields
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_u      ! tracer at u-point 
-      !
-      INTEGER  ::   ji, jj       ! dummy loop indices
-      REAL(wp) ::   zcu, zdx2, zdx4    !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztu1, ztu2, ztu3, ztu4
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ultimate_x')
-      !
-      CALL wrk_alloc( jpi,jpj,   ztu1, ztu2, ztu3, ztu4 )
-      !
-      !                                                     !--  Laplacian in i-direction  --!
-      DO jj = 2, jpjm1         ! First derivative (gradient)
-         DO ji = 1, fs_jpim1
-            ztu1(ji,jj) = ( pt(ji+1,jj) - pt(ji,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
-         END DO
-         !                     ! Second derivative (Laplacian)
-         DO ji = fs_2, fs_jpim1
-            ztu2(ji,jj) = ( ztu1(ji,jj) - ztu1(ji-1,jj) ) * r1_e1t(ji,jj)
-         END DO
-      END DO
-      CALL lbc_lnk( ztu2, 'T', 1. )
-      !
-      !                                                     !--  BiLaplacian in i-direction  --!
-      DO jj = 2, jpjm1         ! Third derivative
-         DO ji = 1, fs_jpim1
-            ztu3(ji,jj) = ( ztu2(ji+1,jj) - ztu2(ji,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
-         END DO
-         !                     ! Fourth derivative
-         DO ji = fs_2, fs_jpim1
-            ztu4(ji,jj) = ( ztu3(ji,jj) - ztu3(ji-1,jj) ) * r1_e1t(ji,jj)
-         END DO
-      END DO
-      CALL lbc_lnk( ztu4, 'T', 1. )
-      !
-      !
-      SELECT CASE (k_order )
-      !
-      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21)
-         !        
-         DO jj = 1, jpj
-            DO ji = 1, fs_jpim1   ! vector opt.
-               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (                               pt(ji+1,jj) + pt(ji,jj)   &
-                  &                                    - SIGN( 1._wp, puc(ji,jj) ) * ( pt(ji+1,jj) - pt(ji,jj) ) )
-            END DO
-         END DO
-         !
-      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23)
-         !
-         DO jj = 1, jpj
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (                                   pt(ji+1,jj) + pt(ji,jj)   &
-                  &                                               -              zcu   * ( pt(ji+1,jj) - pt(ji,jj) ) ) 
-            END DO
-         END DO
-         CALL lbc_lnk( pt_u(:,:) , 'U',  1. )
-         !  
-      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24)
-         !
-         DO jj = 1, jpj
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-               zdx2 = e1u(ji,jj) * e1u(ji,jj)
-!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
-               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (         (                         pt  (ji+1,jj) + pt  (ji,jj)        &
-                  &                                               -              zcu   * ( pt  (ji+1,jj) - pt  (ji,jj) )  )   &
-                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                         ztu2(ji+1,jj) + ztu2(ji,jj)        &
-                  &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj) - ztu2(ji,jj) )  )   )
-            END DO
-         END DO
-         !
-      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27)
-         !
-         DO jj = 1, jpj
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-               zdx2 = e1u(ji,jj) * e1u(ji,jj)
-!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
-               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (         (                   pt  (ji+1,jj) + pt  (ji,jj)        &
-                  &                                               -          zcu * ( pt  (ji+1,jj) - pt  (ji,jj) )  )   &
-                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                   ztu2(ji+1,jj) + ztu2(ji,jj)        &
-                  &                                               - 0.5_wp * zcu * ( ztu2(ji+1,jj) - ztu2(ji,jj) )  )   )
-            END DO
-         END DO
-         !
-      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29)
-         !
-         DO jj = 1, jpj
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
-               zdx2 = e1u(ji,jj) * e1u(ji,jj)
-!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
-               zdx4 = zdx2 * zdx2
-               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (               (                   pt  (ji+1,jj) + pt  (ji,jj)       &
-                  &                                                     -          zcu * ( pt  (ji+1,jj) - pt  (ji,jj) ) )   &
-                  &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) *     (                   ztu2(ji+1,jj) + ztu2(ji,jj)       &
-                  &                                                     - 0.5_wp * zcu * ( ztu2(ji+1,jj) - ztu2(ji,jj) ) )   &
-                  &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj) + ztu4(ji,jj)       &
-                  &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj) - ztu4(ji,jj) ) ) )
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      CALL wrk_dealloc( jpi,jpj,   ztu1, ztu2, ztu3, ztu4 )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ultimate_x')
-      !
-   END SUBROUTINE ultimate_x
-   
- 
-   SUBROUTINE ultimate_y( k_order, pdt, pt, pvc, pt_v )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE ultimate_y  ***
-      !!     
-      !! **  Purpose :   compute  
-      !!
-      !! **  Method  :   ... ???
-      !!                 TIM = transient interpolation Modeling 
-      !!
-      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
-      !!----------------------------------------------------------------------
-      INTEGER                     , INTENT(in   ) ::   k_order   ! ocean time-step index
-      REAL(wp)                    , INTENT(in   ) ::   pdt       ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvc       ! ice j-velocity component
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pt        ! tracer fields
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_v      ! tracer at v-point 
-      !
-      INTEGER  ::   ji, jj       ! dummy loop indices
-      REAL(wp) ::   zcv, zdy2, zdy4    !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztv1, ztv2, ztv3, ztv4
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ultimate_y')
-      !
-      CALL wrk_alloc( jpi,jpj,   ztv1, ztv2, ztv3, ztv4 )
-      !
-      !                                                     !--  Laplacian in j-direction  --!
-      DO jj = 1, jpjm1         ! First derivative (gradient)
-         DO ji = fs_2, fs_jpim1
-            ztv1(ji,jj) = ( pt(ji,jj+1) - pt(ji,jj) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
-         END DO
-      END DO
-      DO jj = 2, jpjm1         ! Second derivative (Laplacian)
-         DO ji = fs_2, fs_jpim1
-            ztv2(ji,jj) = ( ztv1(ji,jj) - ztv1(ji,jj-1) ) * r1_e2t(ji,jj)
-         END DO
-      END DO
-      CALL lbc_lnk( ztv2, 'T', 1. )
-      !
-      !                                                     !--  BiLaplacian in j-direction  --!
-      DO jj = 1, jpjm1         ! First derivative
-         DO ji = fs_2, fs_jpim1
-            ztv3(ji,jj) = ( ztv2(ji,jj+1) - ztv2(ji,jj) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
-         END DO
-      END DO
-      DO jj = 2, jpjm1         ! Second derivative
-         DO ji = fs_2, fs_jpim1
-            ztv4(ji,jj) = ( ztv3(ji,jj) - ztv3(ji,jj-1) ) * r1_e2t(ji,jj)
-         END DO
-      END DO
-      CALL lbc_lnk( ztv4, 'T', 1. )
-      !
-      !
-      SELECT CASE (k_order )
-         !
-      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21)
-         !        
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1) + pt(ji,jj) )  &
-                  &                                     - SIGN( 1._wp, pvc(ji,jj) ) * ( pt(ji,jj+1) - pt(ji,jj) ) )
-            END DO
-         END DO
-         !
-      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23)
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (        ( pt(ji,jj+1) + pt(ji,jj) )  &
-                  &                                     - zcv * ( pt(ji,jj+1) - pt(ji,jj) ) )
-            END DO
-         END DO
-         CALL lbc_lnk( pt_v(:,:) , 'V',  1. )
-         !
-      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24)
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-               zdy2 = e2v(ji,jj) * e2v(ji,jj)
-!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
-               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                                 ( pt  (ji,jj+1) + pt  (ji,jj)       &
-                  &                                     -                        zcv   * ( pt  (ji,jj+1) - pt  (ji,jj) ) )   &
-                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1) + ztv2(ji,jj)       &
-                  &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) ) )
-            END DO
-         END DO
-         !
-      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27)
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-               zdy2 = e2v(ji,jj) * e2v(ji,jj)
-!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
-               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                           ( pt  (ji,jj+1) + pt  (ji,jj)       &
-                  &                                               -          zcv * ( pt  (ji,jj+1) - pt  (ji,jj) ) )   &
-                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                   ztv2(ji,jj+1) + ztv2(ji,jj)       &
-                  &                                               - 0.5_wp * zcv * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) ) )
-            END DO
-         END DO
-         !
-      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29)
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
-               zdy2 = e2v(ji,jj) * e2v(ji,jj)
-!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
-               zdy4 = zdy2 * zdy2
-               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                                 ( pt  (ji,jj+1) + pt  (ji,jj)      &
-                  &                                                     -          zcv * ( pt  (ji,jj+1) - pt  (ji,jj) ) )  &
-                  &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) *     (                   ztv2(ji,jj+1) + ztv2(ji,jj)      &
-                  &                                                     - 0.5_wp * zcv * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) )  &
-                  &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1) + ztv4(ji,jj)      &
-                  &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1) - ztv4(ji,jj) ) ) )
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      CALL wrk_dealloc( jpi,jpj,   ztv1, ztv2, ztv3, ztv4 )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ultimate_y')
-      !
-   END SUBROUTINE ultimate_y
-   
-  
-   SUBROUTINE nonosc_2d( pbef, paa, pbb, paft, pdt )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE nonosc  ***
-      !!     
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
-      !!       scheme and the before field by a nonoscillatory algorithm 
-      !!
-      !! **  Method  :   ... ???
-      !!       warning : pbef and paft must be masked, but the boundaries
-      !!       conditions on the fluxes are not necessary zalezak (1979)
-      !!       drange (1995) multi-dimensional forward-in-time and upstream-
-      !!       in-space based differencing for fluid
-      !!----------------------------------------------------------------------
-      REAL(wp)                     , INTENT(in   ) ::   pdt          ! tracer time-step
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pbef, paft   ! before & after field
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(inout) ::   paa, pbb     ! monotonic fluxes in the 2 directions
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
-      INTEGER  ::   ikm1      ! local integer
-      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zsml, z1_dt   ! local scalars
-      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('nonosc_2d')
-      !
-      CALL wrk_alloc( jpi,jpj,   zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )
-      !
-      zbig = 1.e+40_wp
-      zsml = 1.e-15_wp
-
-      ! clem test
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.  
-            zdiv(ji,jj) =  - (  paa(ji,jj) - paa(ji-1,jj  )   &
-               &              + pbb(ji,jj) - pbb(ji  ,jj-1) )  
-         END DO
-      END DO
-      CALL lbc_lnk( zdiv, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign)
-
-      ! Determine ice masks for before and after tracers 
-      WHERE( pbef(:,:) == 0._wp .AND. paft(:,:) == 0._wp .AND. zdiv(:,:) == 0._wp )   ;   zmsk(:,:) = 0._wp
-      ELSEWHERE                                                                       ;   zmsk(:,:) = 1._wp * tmask(:,:,1)
-      END WHERE
-
-      ! Search local extrema
-      ! --------------------
-      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
-!      zbup(:,:) = MAX( pbef(:,:) * tmask(:,:,1) - zbig * ( 1.e0 - tmask(:,:,1) ),   &
-!         &             paft(:,:) * tmask(:,:,1) - zbig * ( 1.e0 - tmask(:,:,1) )  )
-!      zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ),   &
-!         &             paft(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) )  )
-      zbup(:,:) = MAX( pbef(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ),   &
-         &             paft(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) )  )
-      zbdo(:,:) = MIN( pbef(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ),   &
-         &             paft(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) )  )
-
-      z1_dt = 1._wp / pdt
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            !
-            zup  = MAX(   zbup(ji,jj), zbup(ji-1,jj  ), zbup(ji+1,jj  ),   &        ! search max/min in neighbourhood
-               &                       zbup(ji  ,jj-1), zbup(ji  ,jj+1)    )
-            zdo  = MIN(   zbdo(ji,jj), zbdo(ji-1,jj  ), zbdo(ji+1,jj  ),   &
-               &                       zbdo(ji  ,jj-1), zbdo(ji  ,jj+1)    )
-               !
-            zpos = MAX( 0., paa(ji-1,jj  ) ) - MIN( 0., paa(ji  ,jj  ) )   &        ! positive/negative  part of the flux
-               & + MAX( 0., pbb(ji  ,jj-1) ) - MIN( 0., pbb(ji  ,jj  ) )
-            zneg = MAX( 0., paa(ji  ,jj  ) ) - MIN( 0., paa(ji-1,jj  ) )   &
-               & + MAX( 0., pbb(ji  ,jj  ) ) - MIN( 0., pbb(ji  ,jj-1) )
-               !
-            zbt = e1e2t(ji,jj) * z1_dt                                   ! up & down beta terms
-            zbetup(ji,jj) = ( zup         - paft(ji,jj) ) / ( zpos + zsml ) * zbt
-            zbetdo(ji,jj) = ( paft(ji,jj) - zdo         ) / ( zneg + zsml ) * zbt
-         END DO
-      END DO
-      CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
-
-      ! monotonic flux in the i & j direction (paa & pbb)
-      ! -------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zau = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji+1,jj) )
-            zbu = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji+1,jj) )
-            zcu = 0.5  + SIGN( 0.5 , paa(ji,jj) )
-            !
-            zav = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji,jj+1) )
-            zbv = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji,jj+1) )
-            zcv = 0.5  + SIGN( 0.5 , pbb(ji,jj) )
-            !
-            paa(ji,jj) = paa(ji,jj) * ( zcu * zau + ( 1._wp - zcu) * zbu )
-            pbb(ji,jj) = pbb(ji,jj) * ( zcv * zav + ( 1._wp - zcv) * zbv )
-            !
-         END DO
-      END DO
-      CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
-      !
-      CALL wrk_dealloc( jpi,jpj,   zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('nonosc_2d')
-      !
-   END SUBROUTINE nonosc_2d
-
-   !!======================================================================
-END MODULE limadv_umx
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 8568)
+++ 	(revision )
@@ -1,315 +1,0 @@
-MODULE limcons
-   !!======================================================================
-   !!                   ***  MODULE  limcons  ***
-   !! LIM-3 Sea Ice :   conservation check
-   !!======================================================================
-   !! History :   -   ! Original code from William H. Lipscomb, LANL
-   !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation 
-   !!            3.5  ! 2011-02  (G. Madec)  add mpp considerations
-   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm
-   !!             -   ! 2015-03  (C. Rousset) add lim_cons_final
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!    lim_cons     :   checks whether energy, mass and salt are conserved 
-   !!----------------------------------------------------------------------
-   USE phycst         ! physical constants
-   USE ice            ! LIM-3 variables
-   USE dom_oce        ! ocean domain
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields
-   USE sbc_ice , ONLY : qevap_ice
-   
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_column_sum
-   PUBLIC   lim_column_sum_energy
-   PUBLIC   lim_cons_check
-   PUBLIC   lim_cons_hsm
-   PUBLIC   lim_cons_final
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_column_sum( ksum, pin, pout )
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_column_sum ***
-      !!
-      !! ** Purpose : Compute the sum of xin over nsum categories
-      !!
-      !! ** Method  : Arithmetics
-      !!
-      !! ** Action  : Gets xin(ji,jj,jl) and computes xout(ji,jj)
-      !!---------------------------------------------------------------------
-      INTEGER                   , INTENT(in   ) ::   ksum   ! number of categories/layers
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pin    ! input field
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   pout   ! output field
-      !
-      INTEGER ::   jl   ! dummy loop indices
-      !!---------------------------------------------------------------------
-      !
-      pout(:,:) = pin(:,:,1)
-      DO jl = 2, ksum
-         pout(:,:) = pout(:,:) + pin(:,:,jl)
-      END DO
-      !
-   END SUBROUTINE lim_column_sum
-
-
-   SUBROUTINE lim_column_sum_energy( ksum, klay, pin, pout)
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_column_sum_energy ***
-      !!
-      !! ** Purpose : Compute the sum of xin over nsum categories
-      !!              and nlay layers
-      !!
-      !! ** Method  : Arithmetics
-      !!---------------------------------------------------------------------
-      INTEGER                                , INTENT(in   ) ::   ksum   !: number of categories
-      INTEGER                                , INTENT(in   ) ::   klay   !: number of vertical layers
-      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in   ) ::   pin    !: input field
-      REAL(wp), DIMENSION(jpi,jpj)           , INTENT(  out) ::   pout   !: output field
-      !
-      INTEGER ::   jk, jl   ! dummy loop indices
-      !!---------------------------------------------------------------------
-      !
-      pout(:,:) = 0._wp
-      DO jl = 1, ksum
-         DO jk = 2, klay 
-            pout(:,:) = pout(:,:) + pin(:,:,jk,jl)
-         END DO
-      END DO
-      !
-   END SUBROUTINE lim_column_sum_energy
-
-
-   SUBROUTINE lim_cons_check( px1, px2, pmax_err, cd_fieldid )
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_cons_check ***
-      !!
-      !! ** Purpose : Test the conservation of a certain variable
-      !!              For each physical grid cell, check that initial 
-      !!              and final values
-      !!              of a conserved field are equal to within a small value.
-      !!
-      !! ** Method  :
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   px1          !: initial field
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   px2          !: final field
-      REAL(wp)                , INTENT(in   ) ::   pmax_err     !: max allowed error
-      CHARACTER(len=15)       , INTENT(in   ) ::   cd_fieldid   !: field identifyer
-      !
-      INTEGER  ::   ji, jj          ! dummy loop indices
-      INTEGER  ::   inb_error       ! number of g.c where there is a cons. error
-      LOGICAL  ::   llconserv_err   ! = .true. if conservation check failed
-      REAL(wp) ::   zmean_error     ! mean error on error points
-      !!---------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*) ' lim_cons_check '
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-
-      llconserv_err = .FALSE.
-      inb_error     = 0
-      zmean_error   = 0._wp
-      IF( MAXVAL( px2(:,:) - px1(:,:) ) > pmax_err )   llconserv_err = .TRUE.
-
-      IF( llconserv_err ) THEN
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               IF( ABS( px2(ji,jj) - px1(ji,jj) ) > pmax_err ) THEN
-                  inb_error   = inb_error + 1
-                  zmean_error = zmean_error + ABS( px2(ji,jj) - px1(ji,jj) )
-                  !
-                  IF(lwp) THEN
-                     WRITE (numout,*) ' ALERTE 99 '
-                     WRITE (numout,*) ' Conservation error: ', cd_fieldid
-                     WRITE (numout,*) ' Point             : ', ji, jj 
-                     WRITE (numout,*) ' lat, lon          : ', gphit(ji,jj), glamt(ji,jj)
-                     WRITE (numout,*) ' Initial value     : ', px1(ji,jj)
-                     WRITE (numout,*) ' Final value       : ', px2(ji,jj)
-                     WRITE (numout,*) ' Difference        : ', px2(ji,jj) - px1(ji,jj)
-                  ENDIF
-               ENDIF
-            END DO
-         END DO
-         !
-      ENDIF
-      IF(lk_mpp)   CALL mpp_sum( inb_error   )
-      IF(lk_mpp)   CALL mpp_sum( zmean_error )
-      !
-      IF( inb_error > 0 .AND. lwp ) THEN
-         zmean_error = zmean_error / REAL( inb_error, wp )
-         WRITE(numout,*) ' Conservation check for : ', cd_fieldid
-         WRITE(numout,*) ' Number of error points : ', inb_error
-         WRITE(numout,*) ' Mean error on these pts: ', zmean_error
-      ENDIF
-      !
-   END SUBROUTINE lim_cons_check
-
-
-   SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b )
-      !!--------------------------------------------------------------------------------------------------------
-      !!                                        ***  ROUTINE lim_cons_hsm ***
-      !!
-      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
-      !!                     + test if ice concentration and volume are > 0
-      !!
-      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true
-      !!              It prints in ocean.output if there is a violation of conservation at each time-step
-      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to
-      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
-      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
-      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
-      !!--------------------------------------------------------------------------------------------------------
-      INTEGER         , INTENT(in)    :: icount        ! determine wether this is the beggining of the routine (0) or the end (1)
-      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
-      REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft
-      REAL(wp)                        :: zvmin, zamin, zamax 
-      REAL(wp)                        :: zvtrp, zetrp
-      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
-      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
-
-      IF( icount == 0 ) THEN
-
-         ! salt flux
-         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &
-            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
-
-         ! water flux
-         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +               &
-            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:)  &
-            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
-
-         ! heat flux
-         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
-
-         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
-
-         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
-
-         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
-            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
-                            ) * e1e2t * tmask(:,:,1) * zconv )
-
-      ELSEIF( icount == 1 ) THEN
-
-         ! salt flux
-         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
-            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
-
-         ! water flux
-         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +                &
-            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:)   &
-            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b
-
-         ! heat flux
-         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zft_b
- 
-         ! outputs
-         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  &
-            &                    * e1e2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday
-
-         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  &
-            &                    * e1e2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday
-
-         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
-            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
-            &                ) * e1e2t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft
-
-         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative
-         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
-         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t * tmask(:,:,1) * zconv )
-
-         zvmin = glob_min( v_i )
-         zamax = glob_max( SUM( a_i, dim=3 ) )
-         zamin = glob_min( a_i )
-
-         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
-         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
-         zv_sill = zarea * 2.5e-5
-         zs_sill = zarea * 25.e-5
-         zh_sill = zarea * 10.e-5
-
-         IF(lwp) THEN
-            IF ( ABS( zvi  ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zvi
-            IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv
-            IF ( ABS( zei  ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zei
-            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN
-                                         WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp
-                                         WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp
-            ENDIF
-            IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin
-            IF (     zamax   > MAX( rn_amax_n, rn_amax_s ) + epsi10 .AND. &
-               &                         cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN
-                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
-            IF (     zamax   > 1._wp   ) WRITE(numout,*) 'violation a_i>1               (',cd_routine,') = ',zamax
-            ENDIF
-            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin
-         ENDIF
-
-      ENDIF
-
-   END SUBROUTINE lim_cons_hsm
-
-   SUBROUTINE lim_cons_final( cd_routine )
-      !!---------------------------------------------------------------------------------------------------------
-      !!                                   ***  ROUTINE lim_cons_final ***
-      !!
-      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step
-      !!
-      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true
-      !!              It prints in ocean.output if there is a violation of conservation at each time-step
-      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to
-      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
-      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
-      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
-      !!--------------------------------------------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
-      REAL(wp)                        :: zhfx, zsfx, zvfx
-      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
-      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
-
-      ! heat flux
-      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es   &
-      !  &              - SUM( qevap_ice * a_i_b, dim=3 )                           & !!clem: I think this line must be commented (but need check)
-         &              ) * e1e2t * tmask(:,:,1) * zconv ) 
-      ! salt flux
-      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday
-      ! water flux
-      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv ) * rday
-
-      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
-      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
-      zv_sill = zarea * 2.5e-5
-      zs_sill = zarea * 25.e-5
-      zh_sill = zarea * 10.e-5
-
-      IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx)
-      IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx)
-      IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx)
-
-   END SUBROUTINE lim_cons_final
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Empty module            NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-#endif
-   !!======================================================================
-END MODULE limcons
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 8568)
+++ 	(revision )
@@ -1,531 +1,0 @@
-MODULE limctl
-   !!======================================================================
-   !!                     ***  MODULE  limctl  ***
-   !!   LIM-3 : control and printing
-   !!======================================================================
-   !! History :  3.5  !  2015-01  (M. Vancoppenolle) Original code
-   !!            3.7  !  2016-10  (C. Rousset)       Add routine lim_prt3D
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!    lim_ctl   : control prints in case of crash
-   !!    lim_prt   : ice control print at a given grid point
-   !!    lim_prt3D : control prints of ice arrays
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ice             ! LIM-3: ice variables
-   USE thd_ice         ! LIM-3: thermodynamical variables
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice   fields
-
-   USE phycst          ! Define parameters for the routines
-
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE lib_fortran     ! 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_ctl
-   PUBLIC   lim_prt
-   PUBLIC   lim_prt3D
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id: limctl.F90 5043 2015-01-28 16:44:18Z clem $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE lim_ctl( kt )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_ctl *** 
-      !!                 
-      !! ** Purpose :   Alerts in case of model crash
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices
-      INTEGER  ::   inb_altests       ! number of alert tests (max 20)
-      INTEGER  ::   ialert_id         ! number of the current alert
-      REAL(wp) ::   ztmelts           ! ice layer melting point
-      CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert
-      INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive
-      !!-------------------------------------------------------------------
-
-      inb_altests = 10
-      inb_alp(:)  =  0
-
-      ! Alert if incompatible volume and concentration
-      ialert_id = 2 ! reference number of this alert
-      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
-
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
-                  !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
-                  !WRITE(numout,*) ' at_i     ', at_i(ji,jj)
-                  !WRITE(numout,*) ' Point - category', ji, jj, jl
-                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl)
-                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl)
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! Alerte if very thick ice
-      ialert_id = 3 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
-      jl = jpl 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN
-               !CALL lim_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if very fast ice
-      ialert_id = 4 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  &
-               &  at_i(ji,jj) > 0._wp   ) THEN
-               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
-               !WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
-               !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
-               !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
-               !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
-               !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
-               !WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj)
-               !WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj)
-               !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
-               !WRITE(numout,*) 
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if there is ice on continents
-      ialert_id = 6 ! reference number of this alert
-      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
-               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
-               !WRITE(numout,*) ' masks s, u, v        : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1) 
-               !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
-               !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
-               !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
-               !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
-               !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
-               !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
-               !
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-!
-!     ! Alert if very fresh ice
-      ialert_id = 7 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-!                 CALL lim_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
-!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
-!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
-!                 WRITE(numout,*) 
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
-!
-
-!     ! Alert if too old ice
-      ialert_id = 9 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
-                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
-                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
-                  !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
- 
-      ! Alert on salt flux
-      ialert_id = 5 ! reference number of this alert
-      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
-               !CALL lim_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
-               !DO jl = 1, jpl
-                  !WRITE(numout,*) ' Category no: ', jl
-                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)   
-                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)   
-                  !WRITE(numout,*) ' '
-               !END DO
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if qns very big
-      ialert_id = 8 ! reference number of this alert
-      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
-               !
-               !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
-               !WRITE(numout,*) ' ji, jj    : ', ji, jj
-               !WRITE(numout,*) ' qns       : ', qns(ji,jj)
-               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj)
-               !
-               !CALL lim_prt( kt, ji, jj, 2, '   ')
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               !
-            ENDIF
-         END DO
-      END DO
-      !+++++
- 
-      ! Alert if very warm ice
-      ialert_id = 10 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
-      inb_alp(ialert_id) = 0
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rt0
-                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
-                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
-                     !WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
-                     !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
-                     !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' ztmelts : ', ztmelts
-                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      END DO
-
-      ! sum of the alerts on all processors
-      IF( lk_mpp ) THEN
-         DO ialert_id = 1, inb_altests
-            CALL mpp_sum(inb_alp(ialert_id))
-         END DO
-      ENDIF
-
-      ! print alerts
-      IF( lwp ) THEN
-         ialert_id = 1                                 ! reference number of this alert
-         cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
-         WRITE(numout,*) ' time step ',kt
-         WRITE(numout,*) ' All alerts at the end of ice model '
-         DO ialert_id = 1, inb_altests
-            WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
-         END DO
-      ENDIF
-     !
-   END SUBROUTINE lim_ctl
- 
-   
-   SUBROUTINE lim_prt( kt, ki, kj, kn, cd1 )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_prt *** 
-      !!                 
-      !! ** Purpose :   Writes global ice state on the (i,j) point 
-      !!                in ocean.ouput 
-      !!                3 possibilities exist 
-      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
-      !!                n = 2    -> exhaustive state
-      !!                n = 3    -> ice/ocean salt fluxes
-      !!
-      !! ** input   :   point coordinates (i,j) 
-      !!                n : number of the option
-      !!-------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt            ! ocean time step
-      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
-      CHARACTER(len=*), INTENT(in) ::   cd1           !
-      !!
-      INTEGER :: jl, ji, jj
-      !!-------------------------------------------------------------------
-
-      DO ji = mi0(ki), mi1(ki)
-         DO jj = mj0(kj), mj1(kj)
-
-            WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title
-
-            !----------------
-            !  Simple state
-            !----------------
-            
-            IF ( kn == 1 .OR. kn == -1 ) THEN
-               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' Simple state '
-               WRITE(numout,*) ' masks s,u,v   : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
-               WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step     : ', numit
-               WRITE(numout,*) ' - Ice drift   '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
-               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
-               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
-               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
-               WRITE(numout,*) ' strength      : ', strength(ji,jj)
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Cell values '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
-               DO jl = 1, jpl
-                  WRITE(numout,*) ' - Category (', jl,')'
-                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl)
-                  WRITE(numout,*) ' ht_i          : ', ht_i(ji,jj,jl)
-                  WRITE(numout,*) ' ht_s          : ', ht_s(ji,jj,jl)
-                  WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl)
-                  WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl)
-                  WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)
-                  WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)
-                  WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl)
-                  WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl)
-                  WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl)
-                  WRITE(numout,*) ' sm_i          : ', sm_i(ji,jj,jl)
-                  WRITE(numout,*) ' smv_i         : ', smv_i(ji,jj,jl)
-                  WRITE(numout,*)
-               END DO
-            ENDIF
-            IF( kn == -1 ) THEN
-               WRITE(numout,*) ' Mechanical Check ************** '
-               WRITE(numout,*) ' Check what means ice divergence '
-               WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
-               WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj)
-               WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj)
-               WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
-            ENDIF
-            
-
-            !--------------------
-            !  Exhaustive state
-            !--------------------
-            
-            IF ( kn .EQ. 2 ) THEN
-               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' Exhaustive state '
-               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step ', numit
-               WRITE(numout,*) 
-               WRITE(numout,*) ' - Cell values '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
-               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
-               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
-               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
-               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
-               WRITE(numout,*) ' strength      : ', strength(ji,jj)
-               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)  
-               WRITE(numout,*)
-               
-               DO jl = 1, jpl
-                  WRITE(numout,*) ' - Category (',jl,')'
-                  WRITE(numout,*) '   ~~~~~~~~         ' 
-                  WRITE(numout,*) ' ht_i       : ', ht_i(ji,jj,jl)             , ' ht_s       : ', ht_s(ji,jj,jl)
-                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
-                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl)
-                  WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl)
-                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
-                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl) 
-                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)  
-                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
-                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl)
-               END DO !jl
-               
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Heat / FW fluxes '
-               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
-               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
-               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
-               WRITE(numout,*)
-               WRITE(numout,*) 
-               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
-               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
-               WRITE(numout,*) 
-               WRITE(numout,*) ' - Stresses '
-               WRITE(numout,*) '   ~~~~~~~~ '
-               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
-               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
-               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
-               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
-               WRITE(numout,*) ' oc. vel. u : ', u_oce   (ji,jj)
-               WRITE(numout,*) ' oc. vel. v : ', v_oce   (ji,jj)
-            ENDIF
-            
-            !---------------------
-            ! Salt / heat fluxes
-            !---------------------
-            
-            IF ( kn .EQ. 3 ) THEN
-               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' - Salt / Heat Fluxes '
-               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step ', numit
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
-               WRITE(numout,*) ' qsr       : ', qsr(ji,jj)
-               WRITE(numout,*) ' qns       : ', qns(ji,jj)
-               WRITE(numout,*)
-               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
-               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj)
-               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj)
-               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)              
-               WRITE(numout,*)
-               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
-               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
-               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
-               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj) 
-               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
-               WRITE(numout,*) ' emp       : ', emp    (ji,jj)
-               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj)
-               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj)
-               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
-               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj)
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Momentum fluxes '
-               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
-               WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
-            ENDIF 
-            WRITE(numout,*) ' '
-            !
-         END DO
-      END DO
-      !
-   END SUBROUTINE lim_prt
-
-   SUBROUTINE lim_prt3D( cd_routine )
-      !!---------------------------------------------------------------------------------------------------------
-      !!                                   ***  ROUTINE lim_prt3D ***
-      !!
-      !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated 
-      !!
-      !!---------------------------------------------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in)  :: cd_routine    ! name of the routine
-      INTEGER                       :: jk, jl        ! dummy loop indices
-      
-      CALL prt_ctl_info(' ========== ')
-      CALL prt_ctl_info( cd_routine )
-      CALL prt_ctl_info(' ========== ')
-      CALL prt_ctl_info(' - Cell values : ')
-      CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-      CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' cell area   :')
-      CALL prt_ctl(tab2d_1=at_i       , clinfo1=' at_i        :')
-      CALL prt_ctl(tab2d_1=ato_i      , clinfo1=' ato_i       :')
-      CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' vt_i        :')
-      CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' vt_s        :')
-      CALL prt_ctl(tab2d_1=divu_i     , clinfo1=' divu_i      :')
-      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :')
-      CALL prt_ctl(tab2d_1=stress1_i  , clinfo1=' stress1_i   :')
-      CALL prt_ctl(tab2d_1=stress2_i  , clinfo1=' stress2_i   :')
-      CALL prt_ctl(tab2d_1=stress12_i , clinfo1=' stress12_i  :')
-      CALL prt_ctl(tab2d_1=strength   , clinfo1=' strength    :')
-      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :')
-      CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
-       
-      DO jl = 1, jpl
-         CALL prt_ctl_info(' ')
-         CALL prt_ctl_info(' - Category : ', ivar1=jl)
-         CALL prt_ctl_info('   ~~~~~~~~~~')
-         CALL prt_ctl(tab2d_1=ht_i       (:,:,jl)        , clinfo1= ' ht_i        : ')
-         CALL prt_ctl(tab2d_1=ht_s       (:,:,jl)        , clinfo1= ' ht_s        : ')
-         CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' t_su        : ')
-         CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' t_snow      : ')
-         CALL prt_ctl(tab2d_1=sm_i       (:,:,jl)        , clinfo1= ' sm_i        : ')
-         CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' o_i         : ')
-         CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' a_i         : ')
-         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ')
-         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ')
-         CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ')
-         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ')
-         CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' smv_i       : ')
-         CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' oa_i        : ')
-         
-         DO jk = 1, nlay_i
-            CALL prt_ctl_info(' - Layer : ', ivar1=jk)
-            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ')
-         END DO
-      END DO
-      
-      CALL prt_ctl_info(' ')
-      CALL prt_ctl_info(' - Heat / FW fluxes : ')
-      CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ')
-      CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ')
-      CALL prt_ctl(tab2d_1=qsr    , clinfo1= ' qsr   : ', tab2d_2=qns       , clinfo2= ' qns       : ')
-      CALL prt_ctl(tab2d_1=emp    , clinfo1= ' emp   : ', tab2d_2=sfx       , clinfo2= ' sfx       : ')
-      
-      CALL prt_ctl_info(' ')
-      CALL prt_ctl_info(' - Stresses : ')
-      CALL prt_ctl_info('   ~~~~~~~~~~ ')
-      CALL prt_ctl(tab2d_1=utau       , clinfo1= ' utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ')
-      CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ')
-      CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ')
-      
-   END SUBROUTINE lim_prt3D
-
-#else
-   !!--------------------------------------------------------------------------
-   !!   Default option         Empty Module               No LIM3 sea-ice model
-   !!--------------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_ctl     ! Empty routine
-   END SUBROUTINE lim_ctl
-   SUBROUTINE lim_prt     ! Empty routine
-   END SUBROUTINE lim_prt
-   SUBROUTINE lim_prt3D   ! Empty routine
-   END SUBROUTINE lim_prt3D
-#endif
-   !!======================================================================
-END MODULE limctl
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 8568)
+++ 	(revision )
@@ -1,247 +1,0 @@
-MODULE limdiahsb
-   !!======================================================================
-   !!                       ***  MODULE limdia_hsb   ***
-   !!  LIM-3 sea ice model :   diagnostics of ice model 
-   !!======================================================================
-   !! History :  3.4  ! 2012-10  (C. Rousset)  original code
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                       LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_dia_hsb        : computation and output of the time evolution of keys variables
-   !!   lim_dia_hsb_init   : initialization and namelist read
-   !!----------------------------------------------------------------------
-   USE ice             ! LIM-3: sea-ice variable
-   USE dom_oce         ! ocean domain
-   USE sbc_oce         ! surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: sea-ice fields
-   USE daymod          ! model calendar
-   USE phycst          ! physical constant
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE timing          ! preformance summary
-   USE iom             ! I/O manager
-   USE lib_fortran     ! glob_sum
-   USE limrst          ! ice restart
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_diahsb        ! routine called by ice_step.F90
-   PUBLIC   lim_diahsb_init   ! routine called in sbcice_lim.F90
-
-   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents
-   REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends
-   
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.4 , NEMO Consortium (2012)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE lim_diahsb( kt )
-      !!---------------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_diahsb  ***
-      !!     
-      !! ** Purpose: Compute the ice global heat content, salt content and volume conservation
-      !!	
-      !!---------------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt    ! number of iteration
-      !!
-      real(wp)   ::   zbg_ivol, zbg_svol, zbg_area, zbg_isal, zbg_item ,zbg_stem
-      REAL(wp)   ::   z_frc_voltop, z_frc_volbot, z_frc_sal, z_frc_temtop, z_frc_tembot  
-      REAL(wp)   ::   zdiff_vol, zdiff_sal, zdiff_tem  
-      !!---------------------------------------------------------------------------
-      IF( nn_timing == 1 )   CALL timing_start('lim_diahsb')
-
-      ! ----------------------- !
-      ! 1 -  Contents !
-      ! ----------------------- !
-      zbg_ivol = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                  ! ice volume (km3)
-      zbg_svol = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                  ! snow volume (km3)
-      zbg_area = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-6 )                  ! area (km2)
-      zbg_isal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt content (pss*km3)
-      zbg_item = glob_sum( et_i * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                      ! heat content (1.e20 J)
-      zbg_stem = glob_sum( et_s * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                      ! heat content (1.e20 J)
-      
-      ! ---------------------------!
-      ! 2 - Trends due to forcing  !
-      ! ---------------------------!
-      z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )  ! freshwater flux ice/snow-ocean 
-      z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                     ! freshwater flux ice/snow-atm
-      z_frc_sal    = r1_rau0 * glob_sum( - sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                                            ! salt fluxes ice/snow-ocean
-      z_frc_tembot =           glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                                         ! heat on top of ocean (and below ice)
-      z_frc_temtop =           glob_sum( hfx_in (:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                                         ! heat on top of ice-coean
-      !
-      frc_voltop  = frc_voltop  + z_frc_voltop  * rdt_ice ! km3
-      frc_volbot  = frc_volbot  + z_frc_volbot  * rdt_ice ! km3
-      frc_sal     = frc_sal     + z_frc_sal     * rdt_ice ! km3*pss
-      frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J
-      frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J
-            
-      ! ----------------------- !
-      ! 3 -  Content variations !
-      ! ----------------------- !
-      zdiff_vol = r1_rau0 * glob_sum( ( rhoic * vt_i(:,:) + rhosn * vt_s(:,:) - vol_loc_ini(:,:)  &  ! freshwater trend (km3) 
-         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) 
-      zdiff_sal = r1_rau0 * glob_sum( ( rhoic * SUM( smv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:)     &  ! salt content trend (km3*pss)
-         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )
-      zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:)                  &  ! heat content trend (1.e20 J)
-      !  &                            + SUM( qevap_ice * a_i_b, dim=3 ) &     !! clem: I think this line should be commented (but needs a check)
-         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )
-
-      ! ----------------------- !
-      ! 4 -  Drifts             !
-      ! ----------------------- !
-      zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot )
-      zdiff_sal = zdiff_sal - frc_sal
-      zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop )
-
-      ! ----------------------- !
-      ! 5 - Diagnostics writing !
-      ! ----------------------- !
-      !
-      IF( iom_use('ibgvolume') )  CALL iom_put( 'ibgvolume' , zdiff_vol        )   ! ice/snow volume  drift            (km3 equivalent ocean water)         
-      IF( iom_use('ibgsaltco') )  CALL iom_put( 'ibgsaltco' , zdiff_sal        )   ! ice salt content drift            (psu*km3 equivalent ocean water)
-      IF( iom_use('ibgheatco') )  CALL iom_put( 'ibgheatco' , zdiff_tem        )   ! ice/snow heat content drift       (1.e20 J)
-      IF( iom_use('ibgheatfx') )  CALL iom_put( 'ibgheatfx' , zdiff_tem /      &   ! ice/snow heat flux drift          (W/m2)
-         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) )
-
-      IF( iom_use('ibgfrcvoltop') )  CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
-      IF( iom_use('ibgfrcvolbot') )  CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
-      IF( iom_use('ibgfrcsal') )     CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)   
-      IF( iom_use('ibgfrctemtop') )  CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)   
-      IF( iom_use('ibgfrctembot') )  CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)   
-      IF( iom_use('ibgfrchfxtop') )  CALL iom_put( 'ibgfrchfxtop' , frc_temtop / & ! heat on top of ice/snw/ocean      (W/m2) 
-         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) )
-      IF( iom_use('ibgfrchfxbot') )  CALL iom_put( 'ibgfrchfxbot' , frc_tembot / & ! heat on top of ocean(below ice)   (W/m2) 
-         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) )
-
-      IF( iom_use('ibgvol_tot' ) )  CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                        (km3)
-      IF( iom_use('sbgvol_tot' ) )  CALL iom_put( 'sbgvol_tot'  , zbg_svol     )   ! snow volume                       (km3)
-      IF( iom_use('ibgarea_tot') )  CALL iom_put( 'ibgarea_tot' , zbg_area     )   ! ice area                          (km2)
-      IF( iom_use('ibgsalt_tot') )  CALL iom_put( 'ibgsalt_tot' , zbg_isal     )   ! ice salinity content              (pss*km3)
-      IF( iom_use('ibgheat_tot') )  CALL iom_put( 'ibgheat_tot' , zbg_item     )   ! ice heat content                  (1.e20 J)
-      IF( iom_use('sbgheat_tot') )  CALL iom_put( 'sbgheat_tot' , zbg_stem     )   ! snow heat content                 (1.e20 J)
-      !
-      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' )
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('lim_diahsb')
-      !
-   END SUBROUTINE lim_diahsb
-
-
-   SUBROUTINE lim_diahsb_init
-      !!---------------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_diahsb_init  ***
-      !!     
-      !! ** Purpose: Initialization for the heat salt volume budgets
-      !!	
-      !! ** Method : Compute initial heat content, salt content and volume
-      !!
-      !! ** Action : - Compute initial heat content, salt content and volume
-      !!             - Initialize forcing trends
-      !!             - Compute coefficients for conversion
-      !!---------------------------------------------------------------------------
-      INTEGER            ::   ierror   ! local integer
-      !!
-      !!NAMELIST/namicehsb/ blabla
-      !!----------------------------------------------------------------------
-      !
-      !!REWIND ( numnam_ice )              ! Read Namelist namicehsb 
-      !!READ   ( numnam_ice, namicehsb )
-      !
-      IF(lwp) THEN                   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_diahsb_init : check the heat and salt budgets'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-      ENDIF
-      !      
-      ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ierror )
-      IF( ierror > 0 )  THEN
-         CALL ctl_stop( 'lim_diahsb: unable to allocate vol_loc_ini' )
-         RETURN
-      ENDIF
-
-      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files
-      !
-   END SUBROUTINE lim_diahsb_init
-
-   SUBROUTINE lim_diahsb_rst( kt, cdrw )
-     !!---------------------------------------------------------------------
-     !!                   ***  ROUTINE limdia_rst  ***
-     !!                     
-     !! ** Purpose :   Read or write DIA file in restart file
-     !!
-     !! ** Method  :   use of IOM library
-     !!----------------------------------------------------------------------
-     INTEGER         , INTENT(in) ::   kt     ! ice time-step
-     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
-     !
-     !!----------------------------------------------------------------------
-     !
-     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
-        IF( ln_rstart ) THEN                   !* Read the restart file
-           !
-           IF(lwp) WRITE(numout,*) '~~~~~~~'
-           IF(lwp) WRITE(numout,*) ' lim_diahsb_rst read at it= ', kt,' date= ', ndastp
-           IF(lwp) WRITE(numout,*) '~~~~~~~'
-           CALL iom_get( numrir, 'frc_voltop' , frc_voltop  )
-           CALL iom_get( numrir, 'frc_volbot' , frc_volbot  )
-           CALL iom_get( numrir, 'frc_temtop' , frc_temtop  )
-           CALL iom_get( numrir, 'frc_tembot' , frc_tembot  )
-           CALL iom_get( numrir, 'frc_sal'    , frc_sal     )
-           CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini )
-           CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini )
-           CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini )
-        ELSE
-           IF(lwp) WRITE(numout,*) '~~~~~~~'
-           IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state '
-           IF(lwp) WRITE(numout,*) '~~~~~~~'
-           ! set trends to 0
-           frc_voltop  = 0._wp                                          
-           frc_volbot  = 0._wp                                          
-           frc_temtop  = 0._wp                                                 
-           frc_tembot  = 0._wp                                                 
-           frc_sal     = 0._wp                                                 
-           ! record initial ice volume, salt and temp
-           vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:)  ! ice/snow volume (kg/m2)
-           tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                  ! ice/snow heat content (J)
-           sal_loc_ini(:,:) = rhoic * SUM( smv_i(:,:,:), dim=3 )     ! ice salt content (pss*kg/m2)
-           
-       ENDIF
-
-     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
-        !                                   ! -------------------
-        IF(lwp) WRITE(numout,*) '~~~~~~~'
-        IF(lwp) WRITE(numout,*) ' lim_diahsb_rst write at it= ', kt,' date= ', ndastp
-        IF(lwp) WRITE(numout,*) '~~~~~~~'
-        CALL iom_rstput( kt, nitrst, numriw, 'frc_voltop' , frc_voltop  )
-        CALL iom_rstput( kt, nitrst, numriw, 'frc_volbot' , frc_volbot  )
-        CALL iom_rstput( kt, nitrst, numriw, 'frc_temtop' , frc_temtop  )
-        CALL iom_rstput( kt, nitrst, numriw, 'frc_tembot' , frc_tembot  )
-        CALL iom_rstput( kt, nitrst, numriw, 'frc_sal'    , frc_sal     )
-        CALL iom_rstput( kt, nitrst, numriw, 'vol_loc_ini', vol_loc_ini )
-        CALL iom_rstput( kt, nitrst, numriw, 'tem_loc_ini', tem_loc_ini )
-        CALL iom_rstput( kt, nitrst, numriw, 'sal_loc_ini', sal_loc_ini )
-        !
-     ENDIF
-     !
-   END SUBROUTINE lim_diahsb_rst
- 
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :         Empty module          NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_diahsb          ! Empty routine
-   END SUBROUTINE lim_diahsb
-#endif
-   !!======================================================================
-END MODULE limdiahsb
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 8568)
+++ 	(revision )
@@ -1,161 +1,0 @@
-MODULE limdyn
-   !!======================================================================
-   !!                     ***  MODULE  limdyn  ***
-   !!   Sea-Ice dynamics :  
-   !!======================================================================
-   !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code 
-   !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid
-   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3' :                                 LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!    lim_dyn      : computes ice velocities
-   !!    lim_dyn_init : initialization and namelist read
-   !!----------------------------------------------------------------------
-   USE phycst           ! physical constants
-   USE dom_oce          ! ocean space and time domain
-   USE sbc_ice          ! Surface boundary condition: ice   fields
-   USE ice              ! LIM-3 variables
-   USE limrhg           ! LIM-3 rheology
-   USE lbclnk           ! lateral boundary conditions - MPP exchanges
-   USE lib_mpp          ! MPP library
-   USE wrk_nemo         ! work arrays
-   USE in_out_manager   ! I/O manager
-   USE lib_fortran      ! glob_sum
-   USE timing           ! Timing
-   USE limcons          ! conservation tests
-   USE limctl           ! control prints
-   USE limvar
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_dyn        ! routine called by sbcice_lim.F90
-   PUBLIC   lim_dyn_init   ! routine called by sbcice_lim.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_dyn( kt )
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_dyn  ***
-      !!               
-      !! ** Purpose :   compute ice velocity
-      !!                
-      !! ** Method  : 
-      !!
-      !! ** Action  : - Initialisation
-      !!              - Call of the dynamic routine for each hemisphere
-      !!------------------------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! number of iteration
-      !!
-      INTEGER  :: jl, jk ! dummy loop indices
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-     !!---------------------------------------------------------------------
-
-      IF( nn_timing == 1 )  CALL timing_start('limdyn')
-
-      CALL lim_var_agg(1)                      ! aggregate ice categories
-      !
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-      
-      ! ice velocities before rheology
-      u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1)
-      v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1)
-      
-      ! Landfast ice parameterization: define max bottom friction
-      tau_icebfr(:,:) = 0._wp
-      IF( ln_landfast ) THEN
-         DO jl = 1, jpl
-            WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma )  tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr
-         END DO
-      ENDIF
-      
-      ! Rheology (ice dynamics)
-      ! ========     
-      CALL lim_rhg
-      !
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      ! Control prints
-      IF( ln_ctl )       CALL lim_prt3D( 'limdyn' )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('limdyn')
-
-   END SUBROUTINE lim_dyn
-
-
-   SUBROUTINE lim_dyn_init
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_dyn_init  ***
-      !!
-      !! ** Purpose : Physical constants and parameters linked to the ice
-      !!      dynamics
-      !!
-      !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic
-      !!       parameter values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namicedyn
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicedyn/ nn_limadv, nn_limadv_ord,  &
-         &                nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, &
-         &                nn_nevp, rn_relast, ln_landfast, rn_gamma, rn_icebfr, rn_lfrelax
-      !!-------------------------------------------------------------------
-
-      REWIND( numnam_ice_ref )              ! Namelist namicedyn in reference namelist : Ice dynamics
-      READ  ( numnam_ice_ref, namicedyn, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicedyn in configuration namelist : Ice dynamics
-      READ  ( numnam_ice_cfg, namicedyn, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicedyn )
-      
-      IF(lwp) THEN                        ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         ! limtrp
-         WRITE(numout,*)'    choose the advection scheme (-1=Prather, 0=Ulimate-Macho)   nn_limadv     = ', nn_limadv 
-         WRITE(numout,*)'    choose the order of the scheme (if ultimate)                nn_limadv_ord = ', nn_limadv_ord  
-         ! limrhg
-         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)         nn_icestr     = ', nn_icestr 
-         WRITE(numout,*)'    Including brine volume in ice strength comp.                ln_icestr_bvf = ', ln_icestr_bvf
-         WRITE(numout,*)'    Ratio of ridging work to PotEner change in ridging          rn_pe_rdg     = ', rn_pe_rdg 
-         WRITE(numout,*) '   drag coefficient for oceanic stress                         rn_cio        = ', rn_cio
-         WRITE(numout,*) '   first bulk-rheology parameter                               rn_pstar      = ', rn_pstar
-         WRITE(numout,*) '   second bulk-rhelogy parameter                               rn_crhg       = ', rn_crhg
-         WRITE(numout,*) '   creep limit                                                 rn_creepl     = ', rn_creepl
-         WRITE(numout,*) '   eccentricity of the elliptical yield curve                  rn_ecc        = ', rn_ecc
-         WRITE(numout,*) '   number of iterations for subcycling                         nn_nevp       = ', nn_nevp
-         WRITE(numout,*) '   ratio of elastic timescale over ice time step               rn_relast     = ', rn_relast
-         WRITE(numout,*) '   Landfast: param (T or F)                                    ln_landfast   = ', ln_landfast
-         WRITE(numout,*) '   Landfast: fraction of ocean depth that ice must reach       rn_gamma      = ', rn_gamma
-         WRITE(numout,*) '   Landfast: maximum bottom stress per unit area of contact    rn_icebfr     = ', rn_icebfr
-         WRITE(numout,*) '   Landfast: relax time scale (s-1) to reach static friction   rn_lfrelax    = ', rn_lfrelax
-      ENDIF
-      !
-   END SUBROUTINE lim_dyn_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option          Empty module           NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_dyn         ! Empty routine
-   END SUBROUTINE lim_dyn
-#endif 
-
-   !!======================================================================
-END MODULE limdyn
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 8568)
+++ 	(revision )
@@ -1,303 +1,0 @@
-MODULE limhdf
-   !!======================================================================
-   !!                    ***  MODULE limhdf   ***
-   !! LIM ice model : horizontal diffusion of sea-ice quantities
-   !!======================================================================
-   !! History :  LIM  !  2000-01 (LIM) Original code
-   !!             -   !  2001-05 (G. Madec, R. Hordoir) opa norm
-   !!            1.0  !  2002-08 (C. Ethe)  F90, free form
-   !!            3.6  !  2015-08 (O. Tintó and M. Castrillo)  added lim_hdf (multiple)
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_hdf       : diffusion trend on sea-ice variable
-   !!   lim_hdf_init  : initialisation of diffusion trend on sea-ice variable
-   !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean domain
-   USE ice            ! LIM-3: ice variables
-   USE lbclnk         ! lateral boundary condition - MPP exchanges
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE prtctl         ! Print control
-   USE in_out_manager ! I/O manager
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_hdf         ! called by lim_trp
-   PUBLIC   lim_hdf_init    ! called by sbc_lim_init
-
-   LOGICAL  ::   linit = .TRUE.                             ! initialization flag (set to flase after the 1st call)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient
-
-   !! * Substitution 
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_hdf( ptab, ihdf_vars )
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_hdf  ***
-      !!
-      !! ** purpose :   Compute and add the diffusive trend on sea-ice variables
-      !!
-      !! ** method  :   Second order diffusive operator evaluated using a
-      !!              Cranck-Nicholson time Scheme.
-      !!
-      !! ** Action  :    update ptab with the diffusive contribution
-      !!-------------------------------------------------------------------
-      INTEGER,                    INTENT( in )            ::  ihdf_vars ! number of fields to diffuse
-      REAL(wp), DIMENSION(:,:,:), INTENT( inout ), TARGET ::  ptab      ! Field on which the diffusion is applied
-      !
-      INTEGER                             ::  ji, jj, jk, jl, jm        ! dummy loop indices
-      INTEGER                             ::  iter, ierr, isize         ! local integers
-      REAL(wp)                            ::  zrlxint
-      CHARACTER(lc)                       ::  charout                   ! local character
-      REAL(wp), PARAMETER                 ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure
-      REAL(wp), PARAMETER                 ::  zalfa  = 0.5_wp           ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
-      INTEGER , PARAMETER                 ::  num_iter_max = 100        ! Maximum number of iteration
-      INTEGER , PARAMETER                 ::  num_convfrq  = 5          ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization)
-      REAL(wp), POINTER, DIMENSION(:)     ::  zconv
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zrlx, zdiv0, ztab0
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  zflu, zflv, zdiv
-      !!-------------------------------------------------------------------
-      TYPE(arrayptr)   , ALLOCATABLE, DIMENSION(:) ::   pt2d_array, zrlx_array
-      CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) ::   type_array      ! define the nature of ptab array grid-points
-      !                                                                 ! = T , U , V , F , W and I points
-      REAL(wp)         , ALLOCATABLE, DIMENSION(:) ::   psgn_array      ! =-1 the sign change across the north fold boundary
-      !!-------------------------------------------------------------------
-      
-      !                       !==  Initialisation  ==!
-      ! +1 open water diffusion
-      isize = jpl * ( ihdf_vars + nlay_i ) + 1
-      ALLOCATE( zconv (isize) )
-      ALLOCATE( pt2d_array(isize) , zrlx_array(isize) )
-      ALLOCATE( type_array(isize) )
-      ALLOCATE( psgn_array(isize) )
-
-      CALL wrk_alloc( jpi,jpj,       zflu, zflv, zdiv )
-      CALL wrk_alloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )
-      
-      DO jk= 1, isize
-         pt2d_array(jk)%pt2d => ptab(:,:,jk)
-         zrlx_array(jk)%pt2d => zrlx(:,:,jk)
-         type_array(jk) = 'T'
-         psgn_array(jk) = 1.
-      END DO
-
-      !
-      IF( linit ) THEN              ! Metric coefficient (compute at the first call and saved in efact)
-         ALLOCATE( efact(jpi,jpj) , STAT=ierr )
-         IF( lk_mpp    )   CALL mpp_sum( ierr )
-         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' )
-         DO jj = 2, jpjm1  
-            DO ji = fs_2 , fs_jpim1   ! vector opt.
-               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj)
-            END DO
-         END DO
-         linit = .FALSE.
-      ENDIF
-      !
-      ! Arrays initialization
-      zflu(jpi,:) = 0._wp   
-      zflv(jpi,:) = 0._wp
-      DO jk=1 , isize
-         ztab0(:, : , jk ) = ptab(:,:,jk)
-         zdiv0(:, 1 , jk ) = 0._wp
-         zdiv0(:,jpj, jk ) = 0._wp
-         zdiv0(1,  :, jk ) = 0._wp
-         zdiv0(jpi,:, jk ) = 0._wp
-      END DO
-
-      !                !==  horizontal diffusion using a Crant-Nicholson scheme  ==!
-      zconv(:) = 1._wp
-      iter     = 0
-      !
-      DO WHILE( MAXVAL( zconv(:) ) > ( 2._wp * 1.e-04 ) .AND. iter <= num_iter_max )   ! Sub-time step loop
-         !
-         iter = iter + 1                                 ! incrementation of the sub-time step number
-         !
-         DO jk = 1 , isize
-            jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1
-            IF ( zconv(jk) > ( 2._wp * 1.e-04 ) ) THEN
-               DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
-                  DO ji = 1 , fs_jpim1   ! vector opt.
-                     zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) )
-                     zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) )
-                  END DO
-               END DO
-               !
-               DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
-                  DO ji = fs_2 , fs_jpim1   ! vector opt. 
-                     zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
-                  END DO
-               END DO
-               !
-               IF( iter == 1 )   zdiv0(:,:,jk) = zdiv(:,:)        ! save the 1st evaluation of the diffusive trend in zdiv0
-               !
-               DO jj = 2, jpjm1                                ! iterative evaluation
-                  DO ji = fs_2 , fs_jpim1   ! vector opt.
-                     zrlxint = (   ztab0(ji,jj,jk)    &
-                        &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj,jk) )   &
-                        &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj,jk) )                               &
-                        &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
-                     zrlx(ji,jj,jk) = ptab(ji,jj,jk) + zrelax * ( zrlxint - ptab(ji,jj,jk) )
-                  END DO
-               END DO
-            END IF
-
-         END DO
-
-         CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
-         !
-
-         IF ( MOD( iter-1 , num_convfrq ) == 0 )  THEN   ! Convergence test every num_convfrq iterations (perf. optimization ) 
-            DO jk = 1, isize
-               zconv(jk) = 0._wp                                   ! convergence test
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zconv(jk) = MAX( zconv(jk), ABS( zrlx(ji,jj,jk) - ptab(ji,jj,jk) )  )
-                  END DO
-               END DO
-            END DO
-            IF( lk_mpp ) CALL mpp_max_multiple( zconv , isize )            ! max over the global domain for all the variables
-         ENDIF
-         !
-         DO jk=1,isize
-            ptab(:,:,jk) = zrlx(:,:,jk)
-         END DO
-         !
-      END DO  ! end of sub-time step loop
-
-     ! --- final step --- !
-      DO jk = 1, isize
-         jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1
-         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
-            DO ji = 1 , fs_jpim1   ! vector opt.
-               zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) )
-               zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) )
-            END DO
-         END DO
-         !
-         DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
-            DO ji = fs_2 , fs_jpim1   ! vector opt. 
-               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
-               ptab(ji,jj,jk) = ztab0(ji,jj,jk) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-
-      CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
-
-      !
-      IF(ln_ctl)   THEN
-         DO jk = 1 , isize
-            zrlx(:,:,jk) = ptab(:,:,jk) - ztab0(:,:,jk)
-            WRITE(charout,FMT="(' lim_hdf  : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter
-            CALL prt_ctl( tab2d_1=zrlx(:,:,jk), clinfo1=charout )
-         END DO
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj,       zflu, zflv, zdiv )
-      CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )
-      !
-      DEALLOCATE( zconv )
-      DEALLOCATE( pt2d_array , zrlx_array )
-      DEALLOCATE( type_array )
-      DEALLOCATE( psgn_array )
-      !
-   END SUBROUTINE lim_hdf
-
-   
-   SUBROUTINE lim_hdf_init
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_hdf_init  ***
-      !!
-      !! ** Purpose : Initialisation of horizontal diffusion of sea-ice 
-      !!
-      !! ** Method  : Read the namicehdf namelist
-      !!
-      !! ** input   : Namelist namicehdf
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicehdf/ nn_ahi0, rn_ahi0_ref
-      INTEGER  ::   ji, jj
-      REAL(wp) ::   za00, zd_max
-      !!-------------------------------------------------------------------
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion
-      READ  ( numnam_ice_ref, namicehdf, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicehdf in configuration namelist : Ice horizontal diffusion
-      READ  ( numnam_ice_cfg, namicehdf, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicehdf )
-      !
-      IF(lwp) THEN                          ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_hdf_init : Ice horizontal diffusion'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   horizontal diffusivity calculation                          nn_ahi0      = ', nn_ahi0
-         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)                  rn_ahi0_ref  = ', rn_ahi0_ref
-      ENDIF
-      !
-      !  Diffusion coefficients
-      SELECT CASE( nn_ahi0 )
-
-      CASE( 0 )
-         ahiu(:,:) = rn_ahi0_ref
-         ahiv(:,:) = rn_ahi0_ref
-
-         IF(lwp) WRITE(numout,*) ''
-         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref'
-
-      CASE( 1 ) 
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain
-         
-         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60deg latitude in orca2
-                                                        !                    (60deg = min latitude for ice cover)  
-         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp
-
-         IF(lwp) WRITE(numout,*) ''
-         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')'
-         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp 
-         
-      CASE( 2 ) 
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-         
-         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60deg latitude in orca2
-                                                 !                    (60deg = min latitude for ice cover)  
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1)
-               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1)
-            END DO
-         END DO
-         !
-         IF(lwp) WRITE(numout,*) ''
-         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1'
-         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max
-         
-      END SELECT
-      !
-   END SUBROUTINE lim_hdf_init
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option          Dummy module           NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-#endif
-
-   !!======================================================================
-END MODULE limhdf
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 8568)
+++ 	(revision )
@@ -1,571 +1,0 @@
-MODULE limistate
-   !!======================================================================
-   !!                     ***  MODULE  limistate  ***
-   !!              Initialisation of diagnostics ice variables
-   !!======================================================================
-   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
-   !!            3.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!             -   ! 2014    (C. Rousset) add N/S initializations
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3' :                                    LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_istate      :  Initialisation of diagnostics ice variables
-   !!   lim_istate_init :  initialization of ice state and namelist read
-   !!----------------------------------------------------------------------
-   USE phycst           ! physical constant
-   USE oce              ! dynamics and tracers variables
-   USE dom_oce          ! ocean domain
-   USE sbc_oce          ! Surface boundary condition: ocean fields
-   USE sbc_ice          ! Surface boundary condition: ice fields
-   USE eosbn2           ! equation of state
-   USE ice              ! sea-ice variables
-   USE par_oce          ! ocean parameters
-   USE limvar           ! lim_var_salprof
-   !
-   USE in_out_manager   ! I/O manager
-   USE lib_mpp          ! MPP library
-   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE wrk_nemo         ! work arrays
-   USE fldread          ! read input fields
-   USE iom
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_istate      ! routine called by lim_init.F90
-
-   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read
-   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point
-   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snow thicknes (m)    at T-point
-   INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction (%) at T-point
-   INTEGER , PARAMETER ::   jp_tsu = 4           ! index of ice surface temp (K)    at T-point
-   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point
-   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read)
-   !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_istate
-      !!-------------------------------------------------------------------
-      !!                    ***  ROUTINE lim_istate  ***
-      !!
-      !! ** Purpose :   defined the sea-ice initial state
-      !!
-      !! ** Method  :   This routine will put some ice where ocean
-      !!                is at the freezing point, then fill in ice 
-      !!                state variables using prescribed initial 
-      !!                values in the namelist            
-      !!
-      !! ** Steps   :   1) Read namelist
-      !!                2) Basal temperature; ice and hemisphere masks
-      !!                3) Fill in the ice thickness distribution using gaussian
-      !!                4) Fill in space-dependent arrays for state variables
-      !!                5) Diagnostic arrays
-      !!                6) Lateral boundary conditions
-      !!
-      !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even
-      !!              where there is no ice (clem: I do not know why, is it mandatory?) 
-      !!
-      !! History :
-      !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code
-      !!   3.0  !  2007   (M. Vancoppenolle)   Rewrite for ice cats
-      !!   4.0  !  09-11  (M. Vancoppenolle)   Enhanced version for ice cats
-      !!--------------------------------------------------------------------
-      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
-      REAL(wp) :: ztmelts, zdh
-      INTEGER  :: i_hemis, i_fill, jl0  
-      REAL(wp)   :: zarg, zV, zconv, zdv 
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini                         !data by cattegories to fill
-      INTEGER , POINTER, DIMENSION(:)     :: itest
-      !--------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini )
-      CALL wrk_alloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
-      CALL wrk_alloc( jpi, jpj,      zswitch )
-      Call wrk_alloc( 4,             itest )
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'lim_istate : sea-ice initialization '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~ '
-
-      !--------------------------------------------------------------------
-      ! 1) Read namelist
-      !--------------------------------------------------------------------
-      !
-      CALL lim_istate_init
-
-      ! init surface temperature
-      DO jl = 1, jpl
-         t_su  (:,:,jl) = rt0 * tmask(:,:,1)
-         tn_ice(:,:,jl) = rt0 * tmask(:,:,1)
-      END DO
-
-      ! init basal temperature (considered at freezing point)
-      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
-      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
-
-
-      !--------------------------------------------------------------------
-      ! 2) Initialization of sea ice state variables
-      !--------------------------------------------------------------------
-      IF( ln_limini ) THEN
-         !
-         IF( ln_limini_file )THEN
-         !
-            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1)
-            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1)
-            zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1)
-            zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1)
-            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1)
-            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1)
-            !
-            WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 
-            ELSEWHERE                       ; zswitch(:,:) = 0._wp
-            END WHERE
-            !
-         ELSE ! ln_limini_file = F
-
-            !--------------------------------------------------------------------
-            ! 3) Basal temperature, ice mask
-            !--------------------------------------------------------------------
-            ! no ice if sst <= t-freez + ttest
-            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 
-            ELSEWHERE                                                                  ; zswitch(:,:) = tmask(:,:,1)
-            END WHERE
-
-            !-----------------------------
-            ! 3.1) Hemisphere-dependent arrays
-            !-----------------------------
-            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( ff_t(ji,jj) >= 0._wp ) THEN
-                     zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj)
-                     zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj)
-                     zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj)
-                     zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj)
-                     zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj)
-                     ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj)
-                  ELSE
-                     zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj)
-                     zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj)
-                     zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj)
-                     zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj)
-                     zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj)
-                     ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj)
-                  ENDIF
-               END DO
-            END DO
-            !
-         ENDIF ! ln_limini_file
-         
-         zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume
-         !---------------------------------------------------------------------
-         ! 3.2) Distribute ice concentration and thickness into the categories
-         !---------------------------------------------------------------------
-         ! a gaussian distribution for ice concentration is used
-         ! then we check whether the distribution fullfills
-         ! volume and area conservation, positivity and ice categories bounds
-         zh_i_ini(:,:,:) = 0._wp 
-         za_i_ini(:,:,:) = 0._wp
-         !
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN
-
-                  !--- jl0: most likely index where cc will be maximum
-                  jl0 = jpl
-                  DO jl = 1, jpl
-                     IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN
-                        jl0 = jl
-                        CYCLE
-                     ENDIF
-                  END DO
-                  !
-                  ! initialisation of tests
-                  itest(:)  = 0
-                  
-                  i_fill = jpl + 1                                             !====================================
-                  DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories
-                     ! iteration                                               !====================================
-                     i_fill = i_fill - 1
-
-                     ! initialisation of ice variables for each try
-                     zh_i_ini(ji,jj,:) = 0._wp 
-                     za_i_ini(ji,jj,:) = 0._wp
-                     itest(:) = 0
-                     !
-                     ! *** case very thin ice: fill only category 1
-                     IF ( i_fill == 1 ) THEN
-                        zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj)
-                        za_i_ini(ji,jj,1) = zat_i_ini(ji,jj)
-
-                     ! *** case ice is thicker: fill categories >1
-                     ELSE
-
-                        ! Fill ice thicknesses in the (i_fill-1) cat by hmean 
-                        DO jl = 1, i_fill-1
-                           zh_i_ini(ji,jj,jl) = hi_mean(jl)
-                        END DO
-                        !
-                        !--- Concentrations
-                        za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl))
-                        DO jl = 1, i_fill - 1
-                           IF( jl /= jl0 )THEN
-                              zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) )
-                              za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2)
-                           ENDIF
-                        END DO
-                        !
-                        ! Concentration in the last (i_fill) category
-                        za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) )
-
-                        ! Ice thickness in the last (i_fill) category
-                        zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) )
-                        zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 
-
-                        ! clem: correction if concentration of upper cat is greater than lower cat
-                        !       (it should be a gaussian around jl0 but sometimes it is not)
-                        IF ( jl0 /= jpl ) THEN
-                           DO jl = jpl, jl0+1, -1
-                              IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN
-                                 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl)
-                                 zh_i_ini(ji,jj,jl    ) = 0._wp
-                                 za_i_ini(ji,jj,jl    ) = 0._wp
-                                 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  &
-                                    &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 )
-                              END IF
-                           ENDDO
-                        ENDIF
-                        !
-                     ENDIF ! case ice is thick or thin
-
-                     !---------------------
-                     ! Compatibility tests
-                     !---------------------
-                     ! Test 1: area conservation
-                     zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) )
-                     IF ( zconv < epsi06 ) itest(1) = 1
-                     
-                     ! Test 2: volume conservation
-                     zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   &
-                        &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) )
-                     IF ( zconv < epsi06 ) itest(2) = 1
-                     
-                     ! Test 3: thickness of the last category is in-bounds ?
-                     IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
-                     
-                     ! Test 4: positivity of ice concentrations
-                     itest(4) = 1
-                     DO jl = 1, i_fill
-                        IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0
-                     END DO
-                     !                                      !============================
-                  END DO                                    ! end iteration on categories
-                  !                                         !============================
-                  !
-                  IF( lwp .AND. SUM(itest) /= 4 ) THEN 
-                     WRITE(numout,*)
-                     WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! '
-                     WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
-                     WRITE(numout,*)
-                     WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:)
-                     WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj)
-                     WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj)
-                  ENDIF
-               
-               ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp
-               !
-            END DO   
-         END DO   
-
-         !---------------------------------------------------------------------
-         ! 3.3) Space-dependent arrays for ice state variables
-         !---------------------------------------------------------------------
-
-         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
-         DO jl = 1, jpl ! loop over categories
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration
-                  ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness
-                  sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity
-                  o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                                    ! age (1 day)
-                  t_su(ji,jj,jl)  = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
-
-                  IF( zht_i_ini(ji,jj) > 0._wp )THEN
-                    ht_s(ji,jj,jl)= ht_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth
-                  ELSE
-                    ht_s(ji,jj,jl)= 0._wp
-                  ENDIF
-
-                  ! This case below should not be used if (ht_s/ht_i) is ok in namelist
-                  ! In case snow load is in excess that would lead to transformation from snow to ice
-                  ! Then, transfer the snow excess into the ice (different from limthd_dh)
-                  zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 ) 
-                  ! recompute ht_i, ht_s avoiding out of bounds values
-                  ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
-                  ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
-
-                  ! ice volume, salt content, age content
-                  v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
-                  v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
-                  smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
-                  oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
-               END DO
-            END DO
-         END DO
-
-         ! for constant salinity in time
-         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
-            CALL lim_var_salprof
-            smv_i = sm_i * v_i
-         ENDIF
-            
-         ! Snow temperature and heat content
-         DO jk = 1, nlay_s
-            DO jl = 1, jpl ! loop over categories
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0
-                     ! Snow energy of melting
-                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
-
-                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
-                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
-                  END DO
-               END DO
-            END DO
-         END DO
-
-         ! Ice salinity, temperature and heat content
-         DO jk = 1, nlay_i
-            DO jl = 1, jpl ! loop over categories
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
-                     s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin
-                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
-
-                     ! heat content per unit volume
-                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
-                        +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
-                        -   rcp     * ( ztmelts - rt0 ) )
-
-                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
-                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
-                  END DO
-               END DO
-            END DO
-         END DO
-
-         tn_ice (:,:,:) = t_su (:,:,:)
-
-      ELSE ! if ln_limini=false
-         a_i  (:,:,:) = 0._wp
-         v_i  (:,:,:) = 0._wp
-         v_s  (:,:,:) = 0._wp
-         smv_i(:,:,:) = 0._wp
-         oa_i (:,:,:) = 0._wp
-         ht_i (:,:,:) = 0._wp
-         ht_s (:,:,:) = 0._wp
-         sm_i (:,:,:) = 0._wp
-         o_i  (:,:,:) = 0._wp
-
-         e_i(:,:,:,:) = 0._wp
-         e_s(:,:,:,:) = 0._wp
-
-         DO jl = 1, jpl
-            DO jk = 1, nlay_i
-               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
-            END DO
-            DO jk = 1, nlay_s
-               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
-            END DO
-         END DO
-
-      ENDIF ! ln_limini
-      
-      at_i (:,:) = 0.0_wp
-      DO jl = 1, jpl
-         at_i (:,:) = at_i (:,:) + a_i (:,:,jl)
-      END DO
-      !
-      !--------------------------------------------------------------------
-      ! 4) Global ice variables for output diagnostics                    | 
-      !--------------------------------------------------------------------
-      u_ice (:,:)     = 0._wp
-      v_ice (:,:)     = 0._wp
-      stress1_i(:,:)  = 0._wp
-      stress2_i(:,:)  = 0._wp
-      stress12_i(:,:) = 0._wp
-
-      !--------------------------------------------------------------------
-      ! 5) Moments for advection
-      !--------------------------------------------------------------------
-
-      sxopw (:,:) = 0._wp 
-      syopw (:,:) = 0._wp 
-      sxxopw(:,:) = 0._wp 
-      syyopw(:,:) = 0._wp 
-      sxyopw(:,:) = 0._wp
-
-      sxice (:,:,:)  = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:)  = 0._wp
-      syice (:,:,:)  = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:)  = 0._wp
-      sxxice(:,:,:)  = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:)  = 0._wp
-      syyice(:,:,:)  = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:)  = 0._wp
-      sxyice(:,:,:)  = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:)  = 0._wp
-
-      sxc0  (:,:,:)  = 0._wp   ;   sxe  (:,:,:,:)= 0._wp   
-      syc0  (:,:,:)  = 0._wp   ;   sye  (:,:,:,:)= 0._wp   
-      sxxc0 (:,:,:)  = 0._wp   ;   sxxe (:,:,:,:)= 0._wp   
-      syyc0 (:,:,:)  = 0._wp   ;   syye (:,:,:,:)= 0._wp   
-      sxyc0 (:,:,:)  = 0._wp   ;   sxye (:,:,:,:)= 0._wp   
-
-      sxsal  (:,:,:)  = 0._wp
-      sysal  (:,:,:)  = 0._wp
-      sxxsal (:,:,:)  = 0._wp
-      syysal (:,:,:)  = 0._wp
-      sxysal (:,:,:)  = 0._wp
-
-      sxage  (:,:,:)  = 0._wp
-      syage  (:,:,:)  = 0._wp
-      sxxage (:,:,:)  = 0._wp
-      syyage (:,:,:)  = 0._wp
-      sxyage (:,:,:)  = 0._wp
-
-      !------------------------------------
-      ! 6) store fields at before time-step
-      !------------------------------------
-      ! it is only necessary for the 1st interpolation by Agrif
-      a_i_b  (:,:,:)   = a_i  (:,:,:)
-      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)
-      v_i_b  (:,:,:)   = v_i  (:,:,:)
-      v_s_b  (:,:,:)   = v_s  (:,:,:)
-      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)
-      smv_i_b(:,:,:)   = smv_i(:,:,:)
-      oa_i_b (:,:,:)   = oa_i (:,:,:)
-      u_ice_b(:,:)     = u_ice(:,:)
-      v_ice_b(:,:)     = v_ice(:,:)
-
-!!!clem
-!!      ! Output the initial state and forcings
-!!      CALL dia_wri_state( 'output.init', nit000 )
-!!!      
-
-      CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini )
-      CALL wrk_dealloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
-      CALL wrk_dealloc( jpi, jpj,      zswitch )
-      Call wrk_dealloc( 4,             itest )
-
-   END SUBROUTINE lim_istate
-
-   SUBROUTINE lim_istate_init
-      !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_istate_init  ***
-      !!        
-      !! ** Purpose : Definition of initial state of the ice 
-      !!
-      !! ** Method : Read the namiceini namelist and check the parameter 
-      !!       values called at the first timestep (nit000)
-      !!
-      !! ** input : 
-      !!        Namelist namiceini
-      !!
-      !! history :
-      !!  8.5  ! 03-08 (C. Ethe) original code 
-      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
-      !!-----------------------------------------------------------------------------
-      !
-      INTEGER :: ios,ierr,inum_ice                 ! Local integer output status for namelist read
-      INTEGER :: ji,jj
-      INTEGER :: ifpr, ierror
-      !
-      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ice files
-      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi
-      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read
-      !
-      NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  &
-         &                rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, &
-         &                rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             &
-         &                sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir
-      !!-----------------------------------------------------------------------------
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namiceini in reference namelist : Ice initial state
-      READ  ( numnam_ice_ref, namiceini, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namiceini in configuration namelist : Ice initial state
-      READ  ( numnam_ice_cfg, namiceini, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namiceini )
-
-      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts
-      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu
-      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi
-
-      ! Define the initial parameters
-      ! -------------------------
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
-         WRITE(numout,*) '~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini     = ', ln_limini
-         WRITE(numout,*) '   ice initialization from a netcdf file      ln_limini_file  = ', ln_limini_file
-         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst
-         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n
-         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s 
-         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n
-         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s
-         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n
-         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s
-         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n
-         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s
-         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n
-         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s
-      ENDIF
-
-      IF( ln_limini_file ) THEN                      ! Ice initialization using input file
-         !
-         ! set si structure
-         ALLOCATE( si(jpfldi), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'Ice_ini in limistate: unable to allocate si structure' )   ;   RETURN
-         ENDIF
-
-         DO ifpr = 1, jpfldi
-            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
-            ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
-         END DO
-
-         ! fill si with slf_i and control print
-         CALL fld_fill( si, slf_i, cn_dir, 'lim_istate', 'lim istate ini', 'numnam_ice' )
-
-         CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step
-
-      ENDIF
-
-   END SUBROUTINE lim_istate_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :         Empty module          NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_istate          ! Empty routine
-   END SUBROUTINE lim_istate
-#endif
-
-   !!======================================================================
-END MODULE limistate
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 8568)
+++ 	(revision )
@@ -1,962 +1,0 @@
-MODULE limitd_me
-   !!======================================================================
-   !!                       ***  MODULE limitd_me ***
-   !! LIM-3 : Mechanical impact on ice thickness distribution      
-   !!======================================================================
-   !! History :  LIM  ! 2006-02  (M. Vancoppenolle) Original code 
-   !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn
-   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-   USE par_oce          ! ocean parameters
-   USE dom_oce          ! ocean domain
-   USE phycst           ! physical constants (ocean directory) 
-   USE sbc_oce          ! surface boundary condition: ocean fields
-   USE thd_ice          ! LIM thermodynamics
-   USE ice              ! LIM variables
-   USE limvar           ! LIM
-   USE lbclnk           ! lateral boundary condition - MPP exchanges
-   USE lib_mpp          ! MPP library
-   USE wrk_nemo         ! work arrays
-
-   USE in_out_manager   ! I/O manager
-   USE iom              ! I/O manager
-   USE lib_fortran      ! glob_sum
-   USE timing           ! Timing
-   USE limcons          ! conservation tests
-   USE limctl           ! control prints
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_itd_me               ! called by ice_stp
-   PUBLIC   lim_itd_me_icestrength
-   PUBLIC   lim_itd_me_init
-   PUBLIC   lim_itd_me_alloc        ! called by sbc_lim_init 
-
-   !-----------------------------------------------------------------------
-   ! Variables shared among ridging subroutines
-   !-----------------------------------------------------------------------
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   asum     ! sum of total ice and open water area
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   aksum    ! ratio of area removed to area ridged
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/closing associated w/ category n
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hraft    ! thickness of rafted ice
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   krdg     ! thickness of ridging ice / mean ridge thickness
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   aridge   ! participating ice ridging
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   araft    ! participating ice rafting
-
-   REAL(wp), PARAMETER ::   krdgmin = 1.1_wp    ! min ridge thickness multiplier
-   REAL(wp), PARAMETER ::   kraft   = 0.5_wp    ! rafting multipliyer
-
-   REAL(wp) ::   Cp                             ! 
-   !
-   !
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION lim_itd_me_alloc()
-      !!---------------------------------------------------------------------!
-      !!                ***  ROUTINE lim_itd_me_alloc ***
-      !!---------------------------------------------------------------------!
-      ALLOCATE(                                                                      &
-         !* Variables shared among ridging subroutines
-         &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,   &
-         &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl)    , aridge(jpi,jpj,jpl) ,   &
-         &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl)    , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc )
-         !
-      IF( lim_itd_me_alloc /= 0 )   CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' )
-      !
-   END FUNCTION lim_itd_me_alloc
-
-
-   SUBROUTINE lim_itd_me
-      !!---------------------------------------------------------------------!
-      !!                ***  ROUTINE lim_itd_me ***
-      !!
-      !! ** Purpose :   computes the mechanical redistribution of ice thickness
-      !!
-      !! ** Method  :   Steps :
-      !!       1) Thickness categories boundaries, ice / o.w. concentrations
-      !!          Ridge preparation
-      !!       2) Dynamical inputs (closing rate, divu_adv, opning)
-      !!       3) Ridging iteration
-      !!       4) Ridging diagnostics
-      !!       5) Heat, salt and freshwater fluxes
-      !!       6) Compute increments of tate variables and come back to old values
-      !!
-      !! References :   Flato, G. M., and W. D. Hibler III, 1995, JGR, 100, 18,611-18,626.
-      !!                Hibler, W. D. III, 1980, MWR, 108, 1943-1973, 1980.
-      !!                Rothrock, D. A., 1975: JGR, 80, 4514-4519.
-      !!                Thorndike et al., 1975, JGR, 80, 4501-4513. 
-      !!                Bitz et al., JGR, 2001
-      !!                Amundrud and Melling, JGR 2005
-      !!                Babko et al., JGR 2002 
-      !!
-      !!     This routine is based on CICE code and authors William H. Lipscomb,
-      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged
-      !!--------------------------------------------------------------------!
-      INTEGER  ::   ji, jj, jk, jl        ! dummy loop index
-      INTEGER  ::   niter                 ! local integer 
-      INTEGER  ::   iterate_ridging       ! if true, repeat the ridging
-      REAL(wp) ::   za, zfac              ! local scalar
-      CHARACTER (len = 15) ::   fieldid
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_net     ! net rate at which area is removed    (1/s)
-                                                               ! (ridging ice area - area of new ridges) / dt
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   divu_adv        ! divu as implied by transport scheme  (1/s)
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges
-      !
-      INTEGER, PARAMETER ::   nitermax = 20    
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      !!-----------------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('limitd_me')
-
-      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross )
-
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      !-----------------------------------------------------------------------------!
-      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons
-      !-----------------------------------------------------------------------------!
-      Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0             ! proport const for PE
-      !
-      CALL lim_itd_me_ridgeprep                                    ! prepare ridging
-      !
-
-      DO jj = 1, jpj                                     ! Initialize arrays.
-         DO ji = 1, jpi
-
-            !-----------------------------------------------------------------------------!
-            ! 2) Dynamical inputs (closing rate, divu_adv, opning)
-            !-----------------------------------------------------------------------------!
-            !
-            ! 2.1 closing_net
-            !-----------------
-            ! Compute the net rate of closing due to convergence 
-            ! and shear, based on Flato and Hibler (1995).
-            ! 
-            ! The energy dissipation rate is equal to the net closing rate
-            ! times the ice strength.
-            !
-            ! NOTE: The NET closing rate is equal to the rate that open water 
-            !  area is removed, plus the rate at which ice area is removed by 
-            !  ridging, minus the rate at which area is added in new ridges.
-            !  The GROSS closing rate is equal to the first two terms (open
-            !  water closing and thin ice ridging) without the third term
-            !  (thick, newly ridged ice).
-
-            closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
-
-            ! 2.2 divu_adv
-            !--------------
-            ! Compute divu_adv, the divergence rate given by the transport/
-            ! advection scheme, which may not be equal to divu as computed 
-            ! from the velocity field.
-            !
-            ! If divu_adv < 0, make sure the closing rate is large enough
-            ! to give asum = 1.0 after ridging.
-            
-            divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep
-
-            IF( divu_adv(ji,jj) < 0._wp )   closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) )
-
-            ! 2.3 opning
-            !------------
-            ! Compute the (non-negative) opening rate that will give asum = 1.0 after ridging.
-            opning(ji,jj) = closing_net(ji,jj) + divu_adv(ji,jj)
-         END DO
-      END DO
-
-      !-----------------------------------------------------------------------------!
-      ! 3) Ridging iteration
-      !-----------------------------------------------------------------------------!
-      niter           = 1                 ! iteration counter
-      iterate_ridging = 1
-
-      DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax )
-
-         ! 3.2 closing_gross
-         !-----------------------------------------------------------------------------!
-         ! Based on the ITD of ridging and ridged ice, convert the net
-         !  closing rate to a gross closing rate.  
-         ! NOTE: 0 < aksum <= 1
-         closing_gross(:,:) = closing_net(:,:) / aksum(:,:)
-
-         ! correction to closing rate and opening if closing rate is excessive
-         !---------------------------------------------------------------------
-         ! Reduce the closing rate if more than 100% of the open water 
-         ! would be removed.  Reduce the opening rate proportionately.
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               za   = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice
-               IF    ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN                  ! would lead to negative ato_i
-                  zfac          = - ato_i(ji,jj) / za
-                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice 
-               ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN  ! would lead to ato_i > asum
-                  zfac          = ( asum(ji,jj) - ato_i(ji,jj) ) / za
-                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice 
-               ENDIF
-            END DO
-         END DO
-
-         ! correction to closing rate / opening if excessive ice removal
-         !---------------------------------------------------------------
-         ! Reduce the closing rate if more than 100% of any ice category 
-         ! would be removed.  Reduce the opening rate proportionately.
-         DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
-                  IF( za  >  a_i(ji,jj,jl) ) THEN
-                     zfac = a_i(ji,jj,jl) / za
-                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-         ! 3.3 Redistribute area, volume, and energy.
-         !-----------------------------------------------------------------------------!
-
-         CALL lim_itd_me_ridgeshift( opning, closing_gross )
-
-         
-         ! 3.4 Compute total area of ice plus open water after ridging.
-         !-----------------------------------------------------------------------------!
-         ! This is in general not equal to one because of divergence during transport
-         asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 )
-
-         ! 3.5 Do we keep on iterating ???
-         !-----------------------------------------------------------------------------!
-         ! Check whether asum = 1.  If not (because the closing and opening
-         ! rates were reduced above), ridge again with new rates.
-
-         iterate_ridging = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( ABS( asum(ji,jj) - 1._wp ) < epsi10 ) THEN
-                  closing_net(ji,jj) = 0._wp
-                  opning     (ji,jj) = 0._wp
-                  ato_i      (ji,jj) = MAX( 0._wp, 1._wp - SUM( a_i(ji,jj,:) ) )
-               ELSE
-                  iterate_ridging    = 1
-                  divu_adv   (ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice
-                  closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) )
-                  opning     (ji,jj) = MAX( 0._wp,  divu_adv(ji,jj) )
-               ENDIF
-            END DO
-         END DO
-
-         IF( lk_mpp )   CALL mpp_max( iterate_ridging )
-
-         ! Repeat if necessary.
-         ! NOTE: If strength smoothing is turned on, the ridging must be
-         ! iterated globally because of the boundary update in the 
-         ! smoothing.
-
-         niter = niter + 1
-
-         IF( iterate_ridging == 1 ) THEN
-            CALL lim_itd_me_ridgeprep
-            IF( niter  >  nitermax ) THEN
-               WRITE(numout,*) ' ALERTE : non-converging ridging scheme '
-               WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging
-            ENDIF
-         ENDIF
-
-      END DO !! on the do while over iter
-
-      CALL lim_var_agg( 1 ) 
-
-      !-----------------------------------------------------------------------------!
-      ! control prints
-      !-----------------------------------------------------------------------------!
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      ! control prints
-      IF( ln_ctl )       CALL lim_prt3D( 'limitd_me' )
-
-      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('limitd_me')
-   END SUBROUTINE lim_itd_me
-
-   SUBROUTINE lim_itd_me_ridgeprep
-      !!---------------------------------------------------------------------!
-      !!                ***  ROUTINE lim_itd_me_ridgeprep ***
-      !!
-      !! ** Purpose :   preparation for ridging and strength calculations
-      !!
-      !! ** Method  :   Compute the thickness distribution of the ice and open water 
-      !!              participating in ridging and of the resulting ridges.
-      !!---------------------------------------------------------------------!
-      INTEGER ::   ji,jj, jl    ! dummy loop indices
-      REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n
-      !------------------------------------------------------------------------------!
-
-      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
-
-      Gstari     = 1.0/rn_gstar    
-      astari     = 1.0/rn_astar    
-      aksum(:,:)    = 0.0
-      athorn(:,:,:) = 0.0
-      aridge(:,:,:) = 0.0
-      araft (:,:,:) = 0.0
-
-      ! Zero out categories with very small areas
-      CALL lim_var_zapsmall
-
-      ! Ice thickness needed for rafting
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
-               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-           END DO
-         END DO
-      END DO
-
-      !------------------------------------------------------------------------------!
-      ! 1) Participation function 
-      !------------------------------------------------------------------------------!
-
-      ! Compute total area of ice plus open water.
-      ! This is in general not equal to one because of divergence during transport
-      asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 )
-
-      ! Compute cumulative thickness distribution function
-      ! Compute the cumulative thickness distribution function Gsum,
-      ! where Gsum(n) is the fractional area in categories 0 to n.
-      ! initial value (in h = 0) equals open water area
-      Gsum(:,:,-1) = 0._wp
-      Gsum(:,:,0 ) = ato_i(:,:)
-      ! for each value of h, you have to add ice concentration then
-      DO jl = 1, jpl
-         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)
-      END DO
-
-      ! Normalize the cumulative distribution to 1
-      DO jl = 0, jpl
-         Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:)
-      END DO
-
-      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn)
-      !--------------------------------------------------------------------------------------------------
-      ! Compute the participation function athorn; this is analogous to
-      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
-      ! area lost from category n due to ridging/closing
-      ! athorn(n)   = total area lost due to ridging/closing
-      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 
-      !
-      ! The expressions for athorn are found by integrating b(h)g(h) between
-      ! the category boundaries.
-      ! athorn is always >= 0 and SUM(athorn(0:jpl))=1
-      !-----------------------------------------------------------------
-
-      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
-         DO jl = 0, jpl    
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  IF    ( Gsum(ji,jj,jl)   < rn_gstar ) THEN
-                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &
-                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )
-                  ELSEIF( Gsum(ji,jj,jl-1) < rn_gstar ) THEN
-                     athorn(ji,jj,jl) = Gstari * ( rn_gstar       - Gsum(ji,jj,jl-1) ) *  &
-                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + rn_gstar       ) * Gstari )
-                  ELSE
-                     athorn(ji,jj,jl) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007)
-         !                        
-         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array
-         DO jl = -1, jpl
-            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
-         END DO
-         DO jl = 0, jpl
-             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
-         END DO
-         !
-      ENDIF
-
-      ! --- Ridging and rafting participation concentrations --- !
-      IF( ln_rafting .AND. ln_ridging ) THEN
-         !
-         DO jl = 1, jpl
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  zdummy           = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) )
-                  aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl)
-                  araft (ji,jj,jl) = athorn(ji,jj,jl) - aridge(ji,jj,jl)
-               END DO
-            END DO
-         END DO
-         !
-      ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN
-         !
-         DO jl = 1, jpl
-            aridge(:,:,jl) = athorn(:,:,jl)
-         END DO
-         !
-      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN
-         !
-         DO jl = 1, jpl
-            araft(:,:,jl) = athorn(:,:,jl)
-         END DO
-         !
-      ENDIF
-
-      !-----------------------------------------------------------------
-      ! 2) Transfer function
-      !-----------------------------------------------------------------
-      ! Compute max and min ridged ice thickness for each ridging category.
-      ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
-      ! 
-      ! This parameterization is a modified version of Hibler (1980).
-      ! The mean ridging thickness, hrmean, is proportional to hi^(0.5)
-      !  and for very thick ridging ice must be >= krdgmin*hi
-      !
-      ! The minimum ridging thickness, hrmin, is equal to 2*hi 
-      !  (i.e., rafting) and for very thick ridging ice is
-      !  constrained by hrmin <= (hrmean + hi)/2.
-      ! 
-      ! The maximum ridging thickness, hrmax, is determined by
-      !  hrmean and hrmin.
-      !
-      ! These modifications have the effect of reducing the ice strength
-      ! (relative to the Hibler formulation) when very thick ice is
-      ! ridging.
-      !
-      ! aksum = net area removed/ total area removed
-      ! where total area removed = area of ice that ridges
-      !         net area removed = total area removed - area of new ridges
-      !-----------------------------------------------------------------
-
-      aksum(:,:) = athorn(:,:,0)
-      ! Transfer function
-      DO jl = 1, jpl !all categories have a specific transfer function
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               
-               IF( athorn(ji,jj,jl) > 0._wp ) THEN
-                  hrmean          = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin )
-                  hrmin(ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( hrmean + ht_i(ji,jj,jl) ) )
-                  hrmax(ji,jj,jl) = 2._wp * hrmean - hrmin(ji,jj,jl)
-                  hraft(ji,jj,jl) = ht_i(ji,jj,jl) / kraft
-                  krdg(ji,jj,jl)  = ht_i(ji,jj,jl) / MAX( hrmean, epsi20 )
-
-                  ! Normalization factor : aksum, ensures mass conservation
-                  aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) )    &
-                     &                        + araft (ji,jj,jl) * ( 1._wp - kraft          )
-
-               ELSE
-                  hrmin(ji,jj,jl)  = 0._wp 
-                  hrmax(ji,jj,jl)  = 0._wp 
-                  hraft(ji,jj,jl)  = 0._wp 
-                  krdg (ji,jj,jl)  = 1._wp
-               ENDIF
-
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
-      !
-   END SUBROUTINE lim_itd_me_ridgeprep
-
-
-   SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_me_icestrength ***
-      !!
-      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness
-      !!
-      !! ** Method  :   Remove area, volume, and energy from each ridging category
-      !!              and add to thicker ice categories.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges
-      !
-      CHARACTER (len=80) ::   fieldid   ! field identifier
-      !
-      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
-      INTEGER ::   ij                ! horizontal index, combines i and j loops
-      INTEGER ::   icells            ! number of cells with a_i > puny
-      REAL(wp) ::   hL, hR, farea    ! left and right limits of integration
-
-      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices
-      REAL(wp), POINTER, DIMENSION(:) ::   zswitch, fvol   ! new ridge volume going to n2
-
-      REAL(wp), POINTER, DIMENSION(:) ::   afrac            ! fraction of category area ridged 
-      REAL(wp), POINTER, DIMENSION(:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges
-      REAL(wp), POINTER, DIMENSION(:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice
-      REAL(wp), POINTER, DIMENSION(:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2
-
-      REAL(wp), POINTER, DIMENSION(:) ::   vrdg1   ! volume of ice ridged
-      REAL(wp), POINTER, DIMENSION(:) ::   vrdg2   ! volume of new ridges
-      REAL(wp), POINTER, DIMENSION(:) ::   vsw     ! volume of seawater trapped into ridges
-      REAL(wp), POINTER, DIMENSION(:) ::   srdg1   ! sal*volume of ice ridged
-      REAL(wp), POINTER, DIMENSION(:) ::   srdg2   ! sal*volume of new ridges
-      REAL(wp), POINTER, DIMENSION(:) ::   smsw    ! sal*volume of water trapped into ridges
-      REAL(wp), POINTER, DIMENSION(:) ::   oirdg1, oirdg2   ! ice age of ice ridged
-
-      REAL(wp), POINTER, DIMENSION(:) ::   afrft            ! fraction of category area rafted
-      REAL(wp), POINTER, DIMENSION(:) ::   arft1 , arft2    ! area of ice rafted and new rafted zone
-      REAL(wp), POINTER, DIMENSION(:) ::   virft , vsrft    ! ice & snow volume of rafting ice
-      REAL(wp), POINTER, DIMENSION(:) ::   esrft , smrft    ! snow energy & salinity of rafting ice
-      REAL(wp), POINTER, DIMENSION(:) ::   oirft1, oirft2   ! ice age of ice rafted
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   eirft      ! ice energy of rafting ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg1      ! enth*volume of ice ridged
-      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg2      ! enth*volume of new ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ersw       ! enth of water trapped into ridges
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpij,        indxi, indxj )
-      CALL wrk_alloc( jpij,        zswitch, fvol )
-      CALL wrk_alloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
-      CALL wrk_alloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
-      CALL wrk_alloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )
-
-      !-------------------------------------------------------------------------------
-      ! 1) Compute change in open water area due to closing and opening.
-      !-------------------------------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ato_i(ji,jj) = MAX( 0._wp, ato_i(ji,jj) +  &
-               &                     ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice )
-         END DO
-      END DO
-
-      !-----------------------------------------------------------------
-      ! 3) Pump everything from ice which is being ridged / rafted
-      !-----------------------------------------------------------------
-      ! Compute the area, volume, and energy of ice ridging in each
-      ! category, along with the area of the resulting ridge.
-
-      DO jl1 = 1, jpl !jl1 describes the ridging category
-
-         !------------------------------------------------
-         ! 3.1) Identify grid cells with nonzero ridging
-         !------------------------------------------------
-         icells = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( athorn(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN
-                  icells = icells + 1
-                  indxi(icells) = ji
-                  indxj(icells) = jj
-               ENDIF
-            END DO
-         END DO
-
-         DO ij = 1, icells
-            ji = indxi(ij) ; jj = indxj(ij)
-
-            !--------------------------------------------------------------------
-            ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2)
-            !--------------------------------------------------------------------
-            ardg1(ij) = aridge(ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice
-            arft1(ij) = araft (ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice
-
-            !---------------------------------------------------------------
-            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 
-            !---------------------------------------------------------------
-            afrac(ij) = ardg1(ij) / a_i(ji,jj,jl1) !ridging
-            afrft(ij) = arft1(ij) / a_i(ji,jj,jl1) !rafting
-            ardg2(ij) = ardg1(ij) * krdg(ji,jj,jl1)
-            arft2(ij) = arft1(ij) * kraft
-
-            !--------------------------------------------------------------------------
-            ! 3.4) Subtract area, volume, and energy from ridging 
-            !     / rafting category n1.
-            !--------------------------------------------------------------------------
-            vrdg1(ij) = v_i(ji,jj,jl1) * afrac(ij)
-            vrdg2(ij) = vrdg1(ij) * ( 1. + rn_por_rdg )
-            vsw  (ij) = vrdg1(ij) * rn_por_rdg
-
-            vsrdg (ij) = v_s  (ji,jj,  jl1) * afrac(ij)
-            esrdg (ij) = e_s  (ji,jj,1,jl1) * afrac(ij)
-            srdg1 (ij) = smv_i(ji,jj,  jl1) * afrac(ij)
-            oirdg1(ij) = oa_i (ji,jj,  jl1) * afrac(ij)
-            oirdg2(ij) = oa_i (ji,jj,  jl1) * afrac(ij) * krdg(ji,jj,jl1) 
-
-            ! rafting volumes, heat contents ...
-            virft (ij) = v_i  (ji,jj,  jl1) * afrft(ij)
-            vsrft (ij) = v_s  (ji,jj,  jl1) * afrft(ij)
-            esrft (ij) = e_s  (ji,jj,1,jl1) * afrft(ij)
-            smrft (ij) = smv_i(ji,jj,  jl1) * afrft(ij) 
-            oirft1(ij) = oa_i (ji,jj,  jl1) * afrft(ij) 
-            oirft2(ij) = oa_i (ji,jj,  jl1) * afrft(ij) * kraft 
-
-            !-----------------------------------------------------------------
-            ! 3.5) Compute properties of new ridges
-            !-----------------------------------------------------------------
-            smsw(ij)  = vsw(ij) * sss_m(ji,jj)                   ! salt content of seawater frozen in voids
-            srdg2(ij) = srdg1(ij) + smsw(ij)                     ! salt content of new ridge
-            
-            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ij) * rhoic * r1_rdtice
-            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids
-
-            ! virtual salt flux to keep salinity constant
-            IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
-               srdg2(ij)      = srdg2(ij) - vsw(ij) * ( sss_m(ji,jj) - sm_i(ji,jj,jl1) )           ! ridge salinity = sm_i
-               sfx_bri(ji,jj) = sfx_bri(ji,jj) + sss_m(ji,jj)    * vsw(ij) * rhoic * r1_rdtice  &  ! put back sss_m into the ocean
-                  &                            - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice     ! and get  sm_i  from the ocean 
-            ENDIF
-               
-            !------------------------------------------            
-            ! 3.7 Put the snow somewhere in the ocean
-            !------------------------------------------            
-            !  Place part of the snow lost by ridging into the ocean. 
-            !  Note that esrdg > 0; the ocean must cool to melt snow.
-            !  If the ocean temp = Tf already, new ice must grow.
-            !  During the next time step, thermo_rates will determine whether
-            !  the ocean cools or new ice grows.
-            wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( rhosn * vsrdg(ij) * ( 1._wp - rn_fsnowrdg )   & 
-               &                              + rhosn * vsrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice  ! fresh water source for ocean
-
-            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg )         & 
-               &                                - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice        ! heat sink for ocean (<0, W.m-2)
-
-            !-----------------------------------------------------------------
-            ! 3.8 Compute quantities used to apportion ice among categories
-            ! in the n2 loop below
-            !-----------------------------------------------------------------
-            dhr (ij) = 1._wp / ( hrmax(ji,jj,jl1)                    - hrmin(ji,jj,jl1)                    )
-            dhr2(ij) = 1._wp / ( hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) )
-
-
-            ! update jl1 (removing ridged/rafted area)
-            a_i  (ji,jj,  jl1) = a_i  (ji,jj,  jl1) - ardg1 (ij) - arft1 (ij)
-            v_i  (ji,jj,  jl1) = v_i  (ji,jj,  jl1) - vrdg1 (ij) - virft (ij)
-            v_s  (ji,jj,  jl1) = v_s  (ji,jj,  jl1) - vsrdg (ij) - vsrft (ij)
-            e_s  (ji,jj,1,jl1) = e_s  (ji,jj,1,jl1) - esrdg (ij) - esrft (ij)
-            smv_i(ji,jj,  jl1) = smv_i(ji,jj,  jl1) - srdg1 (ij) - smrft (ij)
-            oa_i (ji,jj,  jl1) = oa_i (ji,jj,  jl1) - oirdg1(ij) - oirft1(ij)
-
-         END DO
-
-         !--------------------------------------------------------------------
-         ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and
-         !      compute ridged ice enthalpy 
-         !--------------------------------------------------------------------
-         DO jk = 1, nlay_i
-            DO ij = 1, icells
-               ji = indxi(ij) ; jj = indxj(ij)
-               ! heat content of ridged ice
-               erdg1(ij,jk) = e_i(ji,jj,jk,jl1) * afrac(ij) 
-               eirft(ij,jk) = e_i(ji,jj,jk,jl1) * afrft(ij)               
-               
-               ! enthalpy of the trapped seawater (J/m2, >0)
-               ! clem: if sst>0, then ersw <0 (is that possible?)
-               ersw(ij,jk)  = - rhoic * vsw(ij) * rcp * sst_m(ji,jj) * r1_nlay_i
-
-               ! heat flux to the ocean
-               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ij,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux 
-
-               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
-               erdg2(ij,jk) = erdg1(ij,jk) + ersw(ij,jk)
-
-               ! update jl1
-               e_i  (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ij,jk) - eirft(ij,jk)
-
-            END DO
-         END DO
-
-         !-------------------------------------------------------------------------------
-         ! 4) Add area, volume, and energy of new ridge to each category jl2
-         !-------------------------------------------------------------------------------
-         DO jl2  = 1, jpl 
-            ! over categories to which ridged/rafted ice is transferred
-            DO ij = 1, icells
-               ji = indxi(ij) ; jj = indxj(ij)
-
-               ! Compute the fraction of ridged ice area and volume going to thickness category jl2.
-               IF( hrmin(ji,jj,jl1) <= hi_max(jl2) .AND. hrmax(ji,jj,jl1) > hi_max(jl2-1) ) THEN
-                  hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) )
-                  hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2)   )
-                  farea    = ( hR      - hL      ) * dhr(ij) 
-                  fvol(ij) = ( hR * hR - hL * hL ) * dhr2(ij)
-               ELSE
-                  farea    = 0._wp 
-                  fvol(ij) = 0._wp                  
-               ENDIF
-
-               ! Compute the fraction of rafted ice area and volume going to thickness category jl2
-               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
-                  zswitch(ij) = 1._wp
-               ELSE
-                  zswitch(ij) = 0._wp                  
-               ENDIF
-
-               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ( ardg2 (ij) * farea    + arft2 (ij) * zswitch(ij) )
-               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + ( oirdg2(ij) * farea    + oirft2(ij) * zswitch(ij) )
-               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + ( vrdg2 (ij) * fvol(ij) + virft (ij) * zswitch(ij) )
-               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + ( srdg2 (ij) * fvol(ij) + smrft (ij) * zswitch(ij) )
-               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + ( vsrdg (ij) * rn_fsnowrdg * fvol(ij)  +  &
-                  &                                        vsrft (ij) * rn_fsnowrft * zswitch(ij) )
-               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsnowrdg * fvol(ij)  +  &
-                  &                                        esrft (ij) * rn_fsnowrft * zswitch(ij) )
-
-            END DO
-
-            ! Transfer ice energy to category jl2 by ridging
-            DO jk = 1, nlay_i
-               DO ij = 1, icells
-                  ji = indxi(ij) ; jj = indxj(ij)
-                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + erdg2(ij,jk) * fvol(ij) + eirft(ij,jk) * zswitch(ij)                  
-               END DO
-            END DO
-            !
-         END DO ! jl2
-         
-      END DO ! jl1 (deforming categories)
-
-      !
-      CALL wrk_dealloc( jpij,        indxi, indxj )
-      CALL wrk_dealloc( jpij,        zswitch, fvol )
-      CALL wrk_dealloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
-      CALL wrk_dealloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
-      CALL wrk_dealloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )
-      !
-   END SUBROUTINE lim_itd_me_ridgeshift
-
-   SUBROUTINE lim_itd_me_icestrength( kstrngth )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_me_icestrength ***
-      !!
-      !! ** Purpose :   computes ice strength used in dynamics routines of ice thickness
-      !!
-      !! ** Method  :   Compute the strength of the ice pack, defined as the energy (J m-2) 
-      !!              dissipated per unit area removed from the ice pack under compression,
-      !!              and assumed proportional to the change in potential energy caused
-      !!              by ridging. Note that only Hibler's formulation is stable and that
-      !!              ice strength has to be smoothed
-      !!
-      !! ** Inputs / Ouputs : kstrngth (what kind of ice strength we are using)
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979)
-      INTEGER             ::   ji,jj, jl   ! dummy loop indices
-      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation
-      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing
-      REAL(wp)            ::   zp, z1_3    ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka           ! temporary array used here
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zstrp1, zstrp2   ! strength at previous time steps
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 )
-
-      !------------------------------------------------------------------------------!
-      ! 1) Initialize
-      !------------------------------------------------------------------------------!
-      strength(:,:) = 0._wp
-
-      !------------------------------------------------------------------------------!
-      ! 2) Compute thickness distribution of ridging and ridged ice
-      !------------------------------------------------------------------------------!
-      CALL lim_itd_me_ridgeprep
-
-      !------------------------------------------------------------------------------!
-      ! 3) Rothrock(1975)'s method
-      !------------------------------------------------------------------------------!
-      IF( kstrngth == 1 ) THEN
-         z1_3 = 1._wp / 3._wp
-         DO jl = 1, jpl
-            DO jj= 1, jpj
-               DO ji = 1, jpi
-                  !
-                  IF( athorn(ji,jj,jl) > 0._wp ) THEN
-                     !----------------------------
-                     ! PE loss from deforming ice
-                     !----------------------------
-                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)
-
-                     !--------------------------
-                     ! PE gain from rafting ice
-                     !--------------------------
-                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)
-
-                     !----------------------------
-                     ! PE gain from ridging ice
-                     !----------------------------
-                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) * krdg(ji,jj,jl) * z1_3 *  &
-                        &                              ( hrmax(ji,jj,jl) * hrmax(ji,jj,jl) +         &
-                        &                                hrmin(ji,jj,jl) * hrmin(ji,jj,jl) +         &
-                        &                                hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )  
-                        !!(a**3-b**3)/(a-b) = a*a+ab+b*b                      
-                  ENDIF
-                  !
-               END DO
-            END DO
-         END DO
-   
-         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1)
-                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation
-         ksmooth = 1
-
-      !------------------------------------------------------------------------------!
-      ! 4) Hibler (1979)' method
-      !------------------------------------------------------------------------------!
-      ELSE                      ! kstrngth ne 1:  Hibler (1979) form
-         !
-         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) * tmask(:,:,1)
-         !
-         ksmooth = 1
-         !
-      ENDIF                     ! kstrngth
-      !
-      !------------------------------------------------------------------------------!
-      ! 5) Impact of brine volume
-      !------------------------------------------------------------------------------!
-      ! CAN BE REMOVED
-      IF( ln_icestr_bvf ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0)))
-            END DO
-         END DO
-      ENDIF
-      !
-      !------------------------------------------------------------------------------!
-      ! 6) Smoothing ice strength
-      !------------------------------------------------------------------------------!
-      !
-      !-------------------
-      ! Spatial smoothing
-      !-------------------
-      IF ( ksmooth == 1 ) THEN
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 
-                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
-                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
-                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
-                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
-               ELSE
-                  zworka(ji,jj) = 0._wp
-               ENDIF
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               strength(ji,jj) = zworka(ji,jj)
-            END DO
-         END DO
-         CALL lbc_lnk( strength, 'T', 1. )
-
-      ENDIF
-
-      !--------------------
-      ! Temporal smoothing
-      !--------------------
-      IF ( ksmooth == 2 ) THEN
-
-         IF ( numit == nit000 + nn_fsbc - 1 ) THEN
-            zstrp1(:,:) = 0._wp
-            zstrp2(:,:) = 0._wp
-         ENDIF
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 
-                  numts_rm = 1 ! number of time steps for the running mean
-                  IF ( zstrp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1
-                  IF ( zstrp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1
-                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / numts_rm
-                  zstrp2(ji,jj) = zstrp1(ji,jj)
-                  zstrp1(ji,jj) = strength(ji,jj)
-                  strength(ji,jj) = zp
-               ENDIF
-            END DO
-         END DO
-
-         CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions
-
-      ENDIF ! ksmooth
-
-      CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 )
-      !
-   END SUBROUTINE lim_itd_me_icestrength
-
-   SUBROUTINE lim_itd_me_init
-      !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_itd_me_init ***
-      !!
-      !! ** Purpose :   Physical constants and parameters linked 
-      !!                to the mechanical ice redistribution
-      !!
-      !! ** Method  :   Read the namiceitdme namelist 
-      !!                and check the parameters values 
-      !!                called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namiceitdme
-      !!-------------------------------------------------------------------
-      INTEGER :: ios                 ! Local integer output status for namelist read
-      NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar,             & 
-        &                   ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, ln_rafting, rn_hraft, rn_craft, rn_fsnowrft
-      !!-------------------------------------------------------------------
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution
-      READ  ( numnam_ice_ref, namiceitdme, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitdme in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namiceitdme in configuration namelist : Ice mechanical ice redistribution
-      READ  ( numnam_ice_cfg, namiceitdme, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitdme in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namiceitdme )
-      !
-      IF (lwp) THEN                          ! control print
-         WRITE(numout,*)
-         WRITE(numout,*)'lim_itd_me_init : ice parameters for mechanical ice redistribution '
-         WRITE(numout,*)'~~~~~~~~~~~~~~~'
-         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs 
-         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun
-         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar
-         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar
-         WRITE(numout,*)'   Ridging of ice sheets or not                            ln_ridging  = ', ln_ridging
-         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar
-         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg
-         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg 
-         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting
-         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft
-         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft  
-         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft 
-      ENDIF
-      !
-   END SUBROUTINE lim_itd_me_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Empty module          NO LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_itd_me           ! Empty routines
-   END SUBROUTINE lim_itd_me
-   SUBROUTINE lim_itd_me_icestrength
-   END SUBROUTINE lim_itd_me_icestrength
-   SUBROUTINE lim_itd_me_init
-   END SUBROUTINE lim_itd_me_init
-#endif
-   !!======================================================================
-END MODULE limitd_me
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 8568)
+++ 	(revision )
@@ -1,795 +1,0 @@
-MODULE limitd_th
-   !!======================================================================
-   !!                       ***  MODULE limitd_th ***
-   !!   LIM3 ice model : ice thickness distribution: Thermodynamics
-   !!======================================================================
-   !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code
-   !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3
-   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age
-   !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3' :                                   LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_itd_th_rem   :
-   !!   lim_itd_th_reb   :
-   !!   lim_itd_fitline  :
-   !!   lim_itd_shiftice :
-   !!----------------------------------------------------------------------
-   USE par_oce          ! ocean parameters
-   USE dom_oce          ! ocean domain
-   USE phycst           ! physical constants (ocean directory) 
-   USE thd_ice          ! LIM-3 thermodynamic variables
-   USE ice              ! LIM-3 variables
-   USE limvar           ! LIM-3 variables
-   USE prtctl           ! Print control
-   USE in_out_manager   ! I/O manager
-   USE lib_mpp          ! MPP library
-   USE wrk_nemo         ! work arrays
-   USE lib_fortran      ! to use key_nosignedzero
-   USE limcons          ! conservation tests
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_itd_th_rem
-   PUBLIC   lim_itd_th_reb
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_th_rem ***
-      !!
-      !! ** Purpose :   computes the redistribution of ice thickness
-      !!              after thermodynamic growth of ice thickness
-      !!
-      !! ** Method  : Linear remapping 
-      !!
-      !! References : W.H. Lipscomb, JGR 2001
-      !!------------------------------------------------------------------
-      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
-      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
-      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
-      !
-      INTEGER  ::   ji, jj, jl     ! dummy loop index
-      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji
-      INTEGER  ::   nd             ! local integer
-      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
-      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      -
-      REAL(wp) ::   zx3        
-      CHARACTER (len = 15) :: fieldid
-
-      INTEGER , POINTER, DIMENSION(:,:,:) ::   zdonor   ! donor category index
-
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdhice      ! ice thickness increment
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   g0          ! coefficients for fitting the line of the ITD
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   g1          ! coefficients for fitting the line of the ITD
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hL          ! left boundary for the ITD for each thickness
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hR          ! left boundary for the ITD for each thickness
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_b     ! old ice thickness
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   dummy_es
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice          ! local increment of ice area and volume
-      REAL(wp), POINTER, DIMENSION(:)     ::   zvetamin, zvetamax      ! maximum values for etas
-      INTEGER , POINTER, DIMENSION(:)     ::   nind_i, nind_j          ! compressed indices for i/j directions
-      INTEGER                             ::   nbrem                   ! number of cells with ice to transfer
-      REAL(wp)                            ::   zslope                  ! used to compute local thermodynamic "speeds"
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zhb0, zhb1              ! category boundaries for thinnes categories
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final   !  ice volume summed over categories
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_s_init, vt_s_final   !  snow volume summed over categories
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   et_i_init, et_i_final   !  ice energy summed over categories
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   et_s_init, et_s_final   !  snow energy summed over categories
-      INTEGER , POINTER, DIMENSION(:,:)   ::   zremap_flag      ! compute remapping or not ????
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhbnew           ! new boundaries of ice categories
-      !!------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj, zremap_flag )
-      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )
-      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
-      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )   
-      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
-      CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
-      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
-      CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
-
-      !!----------------------------------------------------------------------------------------------
-      !! 0) Conservation checkand changes in each ice category
-      !!----------------------------------------------------------------------------------------------
-      IF( con_i ) THEN
-         CALL lim_column_sum (jpl,   v_i, vt_i_init)
-         CALL lim_column_sum (jpl,   v_s, vt_s_init)
-         CALL lim_column_sum_energy (jpl, nlay_i,   e_i, et_i_init)
-         dummy_es(:,:,:) = e_s(:,:,1,:)
-         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init)
-      ENDIF
-
-      !!----------------------------------------------------------------------------------------------
-      !! 1) Compute thickness and changes in each ice category
-      !!----------------------------------------------------------------------------------------------
-      IF( kt == nit000 .AND. lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_itd_th_rem  : Remapping the ice thickness distribution'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~'
-         WRITE(numout,*) ' klbnd :       ', klbnd
-         WRITE(numout,*) ' kubnd :       ', kubnd
-      ENDIF
-
-      zdhice(:,:,:) = 0._wp
-      DO jl = klbnd, kubnd
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes
-               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch
-               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )
-               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch
-               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement? 
-            END DO
-         END DO
-      END DO
-
-      !-----------------------------------------------------------------------------------------------
-      !  2) Compute fractional ice area in each grid cell
-      !-----------------------------------------------------------------------------------------------
-      at_i(:,:) = 0._wp
-      DO jl = klbnd, kubnd
-         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
-      END DO
-
-      !-----------------------------------------------------------------------------------------------
-      !  3) Identify grid cells with ice
-      !-----------------------------------------------------------------------------------------------
-      nbrem = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( at_i(ji,jj) > epsi10 ) THEN
-               nbrem         = nbrem + 1
-               nind_i(nbrem) = ji
-               nind_j(nbrem) = jj
-               zremap_flag(ji,jj) = 1
-            ELSE
-               zremap_flag(ji,jj) = 0
-            ENDIF
-         END DO
-      END DO
-
-      !-----------------------------------------------------------------------------------------------
-      !  4) Compute new category boundaries
-      !-----------------------------------------------------------------------------------------------
-      !- 4.1 Compute category boundaries
-      zhbnew(:,:,:) = 0._wp
-
-      DO jl = klbnd, kubnd - 1
-         DO ji = 1, nbrem
-            ii = nind_i(ji)
-            ij = nind_j(ji)
-            !
-            zhbnew(ii,ij,jl) = hi_max(jl)
-            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
-               !interpolate between adjacent category growth rates
-               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) )
-               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) )
-            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN
-               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl)
-            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN
-               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1)
-            ENDIF
-         END DO
-
-         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness
-         DO ji = 1, nbrem
-            ii = nind_i(ji)
-            ij = nind_j(ji)
-
-            ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible 
-            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
-            IF    ( a_i(ii,ij,jl  ) > epsi10 .AND. ht_i(ii,ij,jl  ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN
-               zremap_flag(ii,ij) = 0
-            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN
-               zremap_flag(ii,ij) = 0
-            ENDIF
-
-            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max  
-            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
-            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0
-            ! clem bug: why is not the following instead?
-            !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
-            !!IF( zhbnew(ii,ij,jl) > hi_max(jl  ) ) zremap_flag(ii,ij) = 0
- 
-         END DO
-
-      END DO
-
-      !-----------------------------------------------------------------------------------------------
-      !  5) Identify cells where ITD is to be remapped
-      !-----------------------------------------------------------------------------------------------
-      nbrem = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( zremap_flag(ji,jj) == 1 ) THEN
-               nbrem         = nbrem + 1
-               nind_i(nbrem) = ji
-               nind_j(nbrem) = jj
-            ENDIF
-         END DO 
-      END DO 
-
-      !-----------------------------------------------------------------------------------------------
-      !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories
-      !-----------------------------------------------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zhb0(ji,jj) = hi_max(0)
-            zhb1(ji,jj) = hi_max(1)
-
-            IF( a_i(ji,jj,kubnd) > epsi10 ) THEN
-               zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) )
-            ELSE
-!clem bug               zhbnew(ji,jj,kubnd) = hi_max(kubnd)  
-               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway
-            ENDIF
-
-            ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible 
-            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
-            IF    ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) )  THEN
-               zremap_flag(ji,jj) = 0
-            ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) )  THEN
-               zremap_flag(ji,jj) = 0
-            ENDIF
-
-         END DO
-      END DO
-
-      !-----------------------------------------------------------------------------------------------
-      !  7) Compute g(h) 
-      !-----------------------------------------------------------------------------------------------
-      !- 7.1 g(h) for category 1 at start of time step
-      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   &
-         &                  hR(:,:,klbnd), zremap_flag )
-
-      !- 7.2 Area lost due to melting of thin ice (first category,  klbnd)
-      DO ji = 1, nbrem
-         ii = nind_i(ji) 
-         ij = nind_j(ji) 
-
-         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN
-
-            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category
-
-            IF( zdh0 < 0.0 ) THEN      !remove area from category 1
-               zdh0 = MIN( -zdh0, hi_max(klbnd) )
-               !Integrate g(1) from 0 to dh0 to estimate area melted
-               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd)
-
-               IF( zetamax > 0.0 ) THEN
-                  zx1    = zetamax
-                  zx2    = 0.5 * zetamax * zetamax 
-                  zda0   = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1                        ! ice area removed
-                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i                
-                  zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting 
-                                                                                                !     of thin ice (zdamax > 0)
-                  ! Remove area, conserving volume
-                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
-                  a_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) - zda0
-                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ?
-               ENDIF
-
-            ELSE ! if ice accretion zdh0 > 0
-               ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1)
-               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) ) 
-            ENDIF
-
-         ENDIF
-
-      END DO
-
-      !- 7.3 g(h) for each thickness category  
-      DO jl = klbnd, kubnd
-         CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl),  &
-            &                  g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag )
-      END DO
-
-      !-----------------------------------------------------------------------------------------------
-      !  8) Compute area and volume to be shifted across each boundary
-      !-----------------------------------------------------------------------------------------------
-
-      DO jl = klbnd, kubnd - 1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdonor(ji,jj,jl) = 0
-               zdaice(ji,jj,jl) = 0.0
-               zdvice(ji,jj,jl) = 0.0
-            END DO
-         END DO
-
-         DO ji = 1, nbrem
-            ii = nind_i(ji)
-            ij = nind_j(ji)
-
-            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1
-               ! left and right integration limits in eta space
-               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl)
-               zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl)
-               zdonor(ii,ij,jl) = jl
-
-            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
-               ! left and right integration limits in eta space
-               zvetamin(ji) = 0.0
-               zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1)
-               zdonor(ii,ij,jl) = jl + 1
-
-            ENDIF
-
-            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin
-            zetamin = zvetamin(ji)
-
-            zx1  = zetamax - zetamin
-            zwk1 = zetamin * zetamin
-            zwk2 = zetamax * zetamax
-            zx2  = 0.5 * ( zwk2 - zwk1 )
-            zwk1 = zwk1 * zetamin
-            zwk2 = zwk2 * zetamax
-            zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 )
-            nd   = zdonor(ii,ij,jl)
-            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1
-            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd)
-
-         END DO
-      END DO
-
-      !!----------------------------------------------------------------------------------------------
-      !! 9) Shift ice between categories
-      !!----------------------------------------------------------------------------------------------
-      CALL lim_itd_shiftice ( klbnd, kubnd, zdonor, zdaice, zdvice )
-
-      !!----------------------------------------------------------------------------------------------
-      !! 10) Make sure ht_i >= minimum ice thickness hi_min
-      !!----------------------------------------------------------------------------------------------
-
-      DO ji = 1, nbrem
-         ii = nind_i(ji)
-         ij = nind_j(ji)
-         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN
-            a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 
-            ht_i(ii,ij,1) = rn_himin
-         ENDIF
-      END DO
-
-      !!----------------------------------------------------------------------------------------------
-      !! 11) Conservation check
-      !!----------------------------------------------------------------------------------------------
-      IF ( con_i ) THEN
-         CALL lim_column_sum (jpl,   v_i, vt_i_final)
-         fieldid = ' v_i : limitd_th '
-         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 
-
-         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, et_i_final)
-         fieldid = ' e_i : limitd_th '
-         CALL lim_cons_check (et_i_init, et_i_final, 1.0e-3, fieldid) 
-
-         CALL lim_column_sum (jpl,   v_s, vt_s_final)
-         fieldid = ' v_s : limitd_th '
-         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 
-
-         dummy_es(:,:,:) = e_s(:,:,1,:)
-         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_final)
-         fieldid = ' e_s : limitd_th '
-         CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid) 
-      ENDIF
-
-      CALL wrk_dealloc( jpi,jpj, zremap_flag )
-      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )
-      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
-      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )   
-      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
-      CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
-      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
-      CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
-
-   END SUBROUTINE lim_itd_th_rem
-
-
-   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_fitline ***
-      !!
-      !! ** Purpose :   fit g(h) with a line using area, volume constraints
-      !!
-      !! ** Method  :   Fit g(h) with a line, satisfying area and volume constraints.
-      !!              To reduce roundoff errors caused by large values of g0 and g1,
-      !!              we actually compute g(eta), where eta = h - hL, and hL is the
-      !!              left boundary.
-      !!------------------------------------------------------------------
-      INTEGER                     , INTENT(in   ) ::   num_cat      ! category index
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   HbL, HbR     ! left and right category boundaries
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   hice         ! ice thickness
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   g0, g1       ! coefficients in linear equation for g(eta)
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   hL           ! min value of range over which g(h) > 0
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   hR           ! max value of range over which g(h) > 0
-      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  !
-      !
-      INTEGER  ::   ji,jj        ! horizontal indices
-      REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL)
-      REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL)
-      REAL(wp) ::   zdhr         ! 1 / (hR - hL)
-      REAL(wp) ::   zwk1, zwk2   ! temporary variables
-      !!------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   &
-               &                        .AND. hice(ji,jj)        > 0._wp )  THEN
-
-               ! Initialize hL and hR
-               hL(ji,jj) = HbL(ji,jj)
-               hR(ji,jj) = HbR(ji,jj)
-
-               ! Change hL or hR if hice falls outside central third of range
-               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) )
-               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) )
-
-               IF    ( hice(ji,jj) < zh13 ) THEN   ;   hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj)
-               ELSEIF( hice(ji,jj) > zh23 ) THEN   ;   hL(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hR(ji,jj)
-               ENDIF
-
-               ! Compute coefficients of g(eta) = g0 + g1*eta
-               zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj))
-               zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr
-               zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr
-               g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 )
-               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 )
-               !
-            ELSE  ! remap_flag = .false. or a_i < epsi10 
-               hL(ji,jj) = 0._wp
-               hR(ji,jj) = 0._wp
-               g0(ji,jj) = 0._wp
-               g1(ji,jj) = 0._wp
-            ENDIF
-            !
-         END DO
-      END DO
-      !
-   END SUBROUTINE lim_itd_fitline
-
-
-   SUBROUTINE lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_shiftice ***
-      !!
-      !! ** Purpose :   shift ice across category boundaries, conserving everything
-      !!              ( area, volume, energy, age*vol, and mass of salt )
-      !!
-      !! ** Method  :
-      !!------------------------------------------------------------------
-      INTEGER                           , INTENT(in   ) ::   klbnd    ! Start thickness category index point
-      INTEGER                           , INTENT(in   ) ::   kubnd    ! End point on which the  the computation is applied
-      INTEGER , DIMENSION(jpi,jpj,jpl-1), INTENT(in   ) ::   zdonor   ! donor category index
-      REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) ::   zdaice   ! ice area transferred across boundary
-      REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) ::   zdvice   ! ice volume transferred across boundary
-
-      INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices
-      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done
-
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka            ! temporary array used here
-
-      REAL(wp) ::   zdvsnow, zdesnow   ! snow volume and energy transferred
-      REAL(wp) ::   zdeice             ! ice energy transferred
-      REAL(wp) ::   zdsm_vice          ! ice salinity times volume transferred
-      REAL(wp) ::   zdo_aice           ! ice age times volume transferred
-      REAL(wp) ::   zdaTsf             ! aicen*Tsfcn transferred
-
-      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions
-
-      INTEGER  ::   nbrem             ! number of cells with ice to transfer
-      !!------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )
-      CALL wrk_alloc( jpi,jpj, zworka )
-      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )
-
-      !----------------------------------------------------------------------------------------------
-      ! 1) Define a variable equal to a_i*T_su
-      !----------------------------------------------------------------------------------------------
-
-      DO jl = klbnd, kubnd
-         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl)
-      END DO
-
-      !-------------------------------------------------------------------------------
-      ! 2) Transfer volume and energy between categories
-      !-------------------------------------------------------------------------------
-
-      DO jl = klbnd, kubnd - 1
-         nbrem = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny
-                  nbrem = nbrem + 1
-                  nind_i(nbrem) = ji
-                  nind_j(nbrem) = jj
-               ENDIF
-            END DO
-         END DO
-
-         DO ji = 1, nbrem 
-            ii = nind_i(ji)
-            ij = nind_j(ji)
-
-            jl1 = zdonor(ii,ij,jl)
-            rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) )
-            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch
-            IF( jl1 == jl) THEN   ;   jl2 = jl1+1
-            ELSE                  ;   jl2 = jl 
-            ENDIF
-
-            !--------------
-            ! Ice areas
-            !--------------
-            a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl)
-            a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl)
-
-            !--------------
-            ! Ice volumes
-            !--------------
-            v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl) 
-            v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl)
-
-            !--------------
-            ! Snow volumes
-            !--------------
-            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij)
-            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow
-            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow 
-
-            !--------------------
-            ! Snow heat content  
-            !--------------------
-            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij)
-            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow
-            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow
-
-            !--------------
-            ! Ice age 
-            !--------------
-            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl)
-            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice
-            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice
-
-            !--------------
-            ! Ice salinity
-            !--------------
-            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij)
-            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice
-            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice
-
-            !---------------------
-            ! Surface temperature
-            !---------------------
-            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl)
-            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf
-            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf 
-
-         END DO
-
-         !------------------
-         ! Ice heat content
-         !------------------
-
-         DO jk = 1, nlay_i
-            DO ji = 1, nbrem
-               ii = nind_i(ji)
-               ij = nind_j(ji)
-
-               jl1 = zdonor(ii,ij,jl)
-               IF (jl1 == jl) THEN
-                  jl2 = jl+1
-               ELSE             ! n1 = n+1
-                  jl2 = jl 
-               ENDIF
-
-               zdeice = e_i(ii,ij,jk,jl1) * zworka(ii,ij)
-               e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice
-               e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice 
-            END DO
-         END DO
-
-      END DO                   ! boundaries, 1 to ncat-1
-
-      !-----------------------------------------------------------------
-      ! Update ice thickness and temperature
-      !-----------------------------------------------------------------
-
-      DO jl = klbnd, kubnd
-         DO jj = 1, jpj
-            DO ji = 1, jpi 
-               IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
-                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl) 
-                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 
-               ELSE
-                  ht_i(ji,jj,jl)  = 0._wp
-                  t_su(ji,jj,jl)  = rt0
-               ENDIF
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )
-      CALL wrk_dealloc( jpi,jpj, zworka )
-      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )
-      !
-   END SUBROUTINE lim_itd_shiftice
-   
-
-   SUBROUTINE lim_itd_th_reb( klbnd, kubnd )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_th_reb ***
-      !!
-      !! ** Purpose : rebin - rebins thicknesses into defined categories
-      !!
-      !! ** Method  :
-      !!------------------------------------------------------------------
-      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
-      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
-      !
-      INTEGER ::   ji,jj, jl   ! dummy loop indices
-      INTEGER ::   zshiftflag          ! = .true. if ice must be shifted
-      CHARACTER (len = 15) :: fieldid
-
-      INTEGER , POINTER, DIMENSION(:,:,:) ::   zdonor           ! donor category index
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice   ! ice area and volume transferred
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final   ! ice volume summed over categories
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories
-      !!------------------------------------------------------------------
-      
-      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger
-      CALL wrk_alloc( jpi,jpj,jpl, zdaice, zdvice )
-      CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )
-      !     
-      IF( con_i ) THEN                 ! conservation check
-         CALL lim_column_sum (jpl,   v_i, vt_i_init)
-         CALL lim_column_sum (jpl,   v_s, vt_s_init)
-      ENDIF
-
-      !
-      !------------------------------------------------------------------------------
-      ! 1) Compute ice thickness.
-      !------------------------------------------------------------------------------
-      DO jl = klbnd, kubnd
-         DO jj = 1, jpj
-            DO ji = 1, jpi 
-               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
-               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
-            END DO
-         END DO
-      END DO
-
-      !------------------------------------------------------------------------------
-      ! 2) If a category thickness is not in bounds, shift the
-      ! entire area, volume, and energy to the neighboring category
-      !------------------------------------------------------------------------------
-      !-------------------------
-      ! Initialize shift arrays
-      !-------------------------
-      DO jl = klbnd, kubnd
-         zdonor(:,:,jl) = 0
-         zdaice(:,:,jl) = 0._wp
-         zdvice(:,:,jl) = 0._wp
-      END DO
-
-      !-------------------------
-      ! Move thin categories up
-      !-------------------------
-
-      DO jl = klbnd, kubnd - 1  ! loop over category boundaries
-
-         !---------------------------------------
-         ! identify thicknesses that are too big
-         !---------------------------------------
-         zshiftflag = 0
-
-         DO jj = 1, jpj 
-            DO ji = 1, jpi 
-               IF( a_i(ji,jj,jl) > epsi10 .AND. ht_i(ji,jj,jl) > hi_max(jl) ) THEN 
-                  zshiftflag        = 1
-                  zdonor(ji,jj,jl)  = jl 
-                  ! begin TECLIM change
-                  !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * 0.5_wp
-                  !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp
-                  ! end TECLIM change 
-                  ! clem: how much of a_i you send in cat sup is somewhat arbitrary
-                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi20 ) / ht_i(ji,jj,jl)  
-                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi20 )
-               ENDIF
-            END DO
-         END DO
-         IF(lk_mpp)   CALL mpp_max( zshiftflag )
-
-         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories
-            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )
-            ! Reset shift parameters
-            zdonor(:,:,jl) = 0
-            zdaice(:,:,jl) = 0._wp
-            zdvice(:,:,jl) = 0._wp
-         ENDIF
-         !
-      END DO
-
-      !----------------------------
-      ! Move thick categories down
-      !----------------------------
-
-      DO jl = kubnd - 1, 1, -1       ! loop over category boundaries
-
-         !-----------------------------------------
-         ! Identify thicknesses that are too small
-         !-----------------------------------------
-         zshiftflag = 0
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN
-                  !
-                  zshiftflag = 1
-                  zdonor(ji,jj,jl) = jl + 1
-                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 
-                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1)
-               ENDIF
-            END DO
-         END DO
-
-         IF(lk_mpp)   CALL mpp_max( zshiftflag )
-         
-         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories
-            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )
-            ! Reset shift parameters
-            zdonor(:,:,jl) = 0
-            zdaice(:,:,jl) = 0._wp
-            zdvice(:,:,jl) = 0._wp
-         ENDIF
-
-      END DO
-
-      !------------------------------------------------------------------------------
-      ! 3) Conservation check
-      !------------------------------------------------------------------------------
-
-      IF( con_i ) THEN
-         CALL lim_column_sum (jpl,   v_i, vt_i_final)
-         fieldid = ' v_i : limitd_reb '
-         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 
-
-         CALL lim_column_sum (jpl,   v_s, vt_s_final)
-         fieldid = ' v_s : limitd_reb '
-         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj,jpl, zdonor )
-      CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice )
-      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )
-
-   END SUBROUTINE lim_itd_th_reb
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option            Dummy module         NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_itd_th_rem
-   END SUBROUTINE lim_itd_th_rem
-   SUBROUTINE lim_itd_fitline
-   END SUBROUTINE lim_itd_fitline
-   SUBROUTINE lim_itd_shiftice
-   END SUBROUTINE lim_itd_shiftice
-   SUBROUTINE lim_itd_th_reb
-   END SUBROUTINE lim_itd_th_reb
-#endif
-   !!======================================================================
-END MODULE limitd_th
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90	(revision 8586)
+++ branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90	(revision 8586)
@@ -0,0 +1,2140 @@
+MODULE limmp 
+   !!======================================================================
+   !!                     ***  MODULE  limmp   ***
+   !!   Melt ponds
+   !!======================================================================
+   !! history :       ! Original code by Daniela Flocco and Adrian Turner
+   !!            1.0  ! 2012    (O. Lecomte) Adaptation for scientific tests (NEMO3.1)
+   !!            2.0  ! 2017    (M. Vancoppenolle, O. Lecomte, C. Rousset) Implementation in NEMO3.6
+   !!                 ! NB: Only lim_mp_cstt and lim_mp_cesm work in this
+   !!                       version
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                 LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_mp_init      : some initialization and namelist read
+   !!   lim_mp           : main calling routine
+   !!   lim_mp_topo      : main melt pond routine for the "topographic" formulation (FloccoFeltham)
+   !!   lim_mp_area      : ??? compute melt pond fraction per category
+   !!   lim_mp_perm      : computes permeability (should be a FUNCTION!)
+   !!   calc_hpond       : computes melt pond depth
+   !!   permeability_phy : computes permeability
+
+   !!----------------------------------------------------------------------
+   USE phycst           ! physical constants
+   USE dom_oce          ! ocean space and time domain
+!  USE sbc_ice          ! Surface boundary condition: ice   fields
+   USE ice              ! LIM-3 variables
+!  USE icecons          ! conservation tests
+!  USE limctl           ! control prints
+!  USE limvar
+   !
+   USE lbclnk           ! lateral boundary conditions - MPP exchanges
+   USE lib_mpp          ! MPP library
+   USE in_out_manager   ! I/O manager
+   USE lib_fortran      ! glob_sum
+   USE timing           ! Timing
+
+!OLI_CODE    USE ice_oce, ONLY: rdt_ice, tatm_ice
+!OLI_CODE    USE phycst
+!OLI_CODE    USE dom_ice
+!OLI_CODE    USE dom_oce
+!OLI_CODE    USE sbc_oce
+!OLI_CODE    USE sbc_ice
+!OLI_CODE    USE par_ice
+!OLI_CODE    USE par_oce
+!OLI_CODE    USE ice
+!OLI_CODE    USE thd_ice
+!OLI_CODE    USE in_out_manager
+!OLI_CODE    USE lbclnk
+!OLI_CODE    USE lib_mpp
+!OLI_CODE 
+!OLI_CODE    IMPLICIT NONE
+!OLI_CODE    PRIVATE
+!OLI_CODE 
+!OLI_CODE    PUBLIC   lim_mp_init
+!OLI_CODE    PUBLIC   lim_mp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_mp_init    ! routine called by icestp.F90
+   PUBLIC   lim_mp         ! routine called by icestp.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id: limdyn.F90 6994 2016-10-05 13:07:10Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_mp_init 
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_mp_init   ***
+      !!
+      !! ** Purpose : Physical constants and parameters linked to melt ponds
+      !!      over sea ice
+      !!
+      !! ** Method  :  Read the nammp  namelist and check the melt pond  
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist nammp  
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/nammp/  ln_pnd, ln_pnd_rad, ln_pnd_fw, nn_pnd_scheme, rn_apnd, rn_hpnd
+      !!-------------------------------------------------------------------
+
+      REWIND( numnam_ice_ref )              ! Namelist nammp  in reference namelist : Melt Ponds  
+      READ  ( numnam_ice_ref, nammp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammp  in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist nammp  in configuration namelist : Melt Ponds
+      READ  ( numnam_ice_cfg, nammp, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, nammp )
+      
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_mp_init : ice parameters for melt ponds'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Active melt ponds                                           ln_pnd        = ', ln_pnd
+         WRITE(numout,*) '   Active melt ponds radiative coupling                        ln_pnd_rad    = ', ln_pnd_rad
+         WRITE(numout,*) '   Active melt ponds freshwater coupling                       ln_pnd_fw     = ', ln_pnd_fw
+         WRITE(numout,*) '   Type of melt pond scheme =0 presc, =1 empirical = 2 topo    nn_pnd_scheme = ', nn_pnd_scheme
+         WRITE(numout,*) '   Prescribed pond fraction                                    rn_apnd       = ', rn_apnd
+         WRITE(numout,*) '   Prescribed pond depth                                       rn_hpnd       = ', rn_hpnd
+      ENDIF
+
+      IF ( .NOT. ln_pnd ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' Melt ponds are not activated '
+         IF(lwp) WRITE(numout,*) ' ln_pnd_rad and ln_pnd_fw set to .FALSE. '
+         IF(lwp) WRITE(numout,*) ' nn_pnd_scheme, rn_apnd, rn_hpnd set to zero '
+         ln_pnd_rad    = .FALSE.
+         ln_pnd_fw     = .FALSE.
+         nn_pnd_scheme = 0
+         rn_apnd       = 0._wp
+         rn_hpnd       = 0._wp
+
+         IF(lwp) THEN                     ! control print
+            WRITE(numout,*) '    Active melt ponds radiative coupling                        ln_pnd_rad    = ', ln_pnd_rad
+            WRITE(numout,*) '    Active melt ponds freshwater coupling                       ln_pnd_fw     = ', ln_pnd_fw
+            WRITE(numout,*) '    Type of melt pond scheme =0 presc, =1 empirical = 2 topo    nn_pnd_scheme = ', nn_pnd_scheme
+            WRITE(numout,*) '    Prescribed pond fraction                                    rn_apnd       = ', rn_apnd
+            WRITE(numout,*) '    Prescribed pond depth                                       rn_hpnd       = ', rn_hpnd
+         ENDIF
+      ENDIF
+
+      IF ( ln_pnd .AND. ( nn_pnd_scheme == 0 ) .AND. ( ln_pnd_fw ) ) THEN
+         IF(lwp) WRITE(numout,*) ' Prescribed melt ponds do not conserve fresh water mass, hence ln_pnd_fw must be set to false ' 
+         ln_pnd_fw     = .FALSE.
+         IF(lwp) THEN                     ! control print
+            WRITE(numout,*) '    Active melt ponds freshwater coupling                       ln_pnd_fw     = ', ln_pnd_fw
+         ENDIF
+      ENDIF
+
+      IF ( ln_pnd .AND. ( nn_pnd_scheme == 2 ) .AND. ( jpl == 1 ) ) THEN
+         IF(lwp) WRITE(numout,*) ' Topographic melt ponds are incompatible with jpl = 1 '
+         IF(lwp) WRITE(numout,*) ' Run aborted '
+         CALL ctl_stop( 'STOP', 'lim_mp_init: uncompatible options, reset namelist_ice_ref ' )
+      ENDIF
+
+      !
+   END SUBROUTINE lim_mp_init
+   
+
+   SUBROUTINE lim_mp( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_mp   ***
+      !!               
+      !! ** Purpose :   change melt pond fraction
+      !!                
+      !! ** Method  :   brutal force
+      !!
+      !! ** Action  : - 
+      !!              - 
+      !!------------------------------------------------------------------------------------
+
+      INTEGER, INTENT(in) :: kt    ! number of iteration
+      INTEGER  ::   ji, jj, jl     ! dummy loop indices
+
+      !!-------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('lim_mp')
+
+      SELECT CASE ( nn_pnd_scheme )
+
+         CASE (0)
+
+            CALL lim_mp_cstt       ! staircase melt ponds
+
+         CASE (1)
+
+            CALL lim_mp_cesm       ! empirical melt ponds
+
+         CASE (2)
+
+            CALL lim_mp_topo   &   ! topographic melt ponds 
+                      &          (at_i, a_i,                                       &
+                      &          vt_i, v_i, v_s,            t_i, sz_i, a_ip_frac,   &
+                      &          h_ip,     t_su)
+
+      END SELECT
+
+      IF( nn_timing == 1 )  CALL timing_stop('lim_mp')
+
+   END SUBROUTINE lim_mp 
+
+   SUBROUTINE lim_mp_cstt 
+       !!-------------------------------------------------------------------
+       !!                ***  ROUTINE lim_mp_cstt  ***
+       !!
+       !! ** Purpose    : Compute melt pond evolution
+       !!
+       !! ** Method     : Melt pond fraction and thickness are prescribed 
+       !!                 to non-zero values when t_su = 0C
+       !!
+       !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd)
+       !!                
+       !! ** Note       : Coupling with such melt ponds is only radiative
+       !!                 Advection, ridging, rafting... are bypassed
+       !!
+       !! ** References : Bush, G.W., and Trump, D.J. (2017)
+       !!    
+       !!-------------------------------------------------------------------
+       INTEGER                             :: ji, jj, jl
+       REAL(wp)                            :: z1_jpl            ! 1/jpl
+       !!-------------------------------------------------------------------
+
+       z1_jpl     = 1. / FLOAT(jpl)
+
+       WHERE ( ( a_i > epsi10 ) .AND. ( t_su >= rt0-epsi06 ) ) 
+          a_ip_frac = rn_apnd
+          h_ip      = rn_hpnd    
+          v_ip      = a_ip_frac * a_i * h_ip 
+          a_ip      = a_ip_frac * a_i
+       ELSE WHERE
+          a_ip      = 0._wp
+          h_ip      = 0._wp
+          v_ip      = 0._wp
+          a_ip_frac = 0._wp
+       END WHERE
+
+       wfx_pnd(:,:) = 0._wp
+
+   END SUBROUTINE lim_mp_cstt
+
+   SUBROUTINE lim_mp_cesm
+       !!-------------------------------------------------------------------
+       !!                ***  ROUTINE lim_mp_cesm  ***
+       !!
+       !! ** Purpose    : Compute melt pond evolution
+       !!
+       !! ** Method     : Empirical method. A fraction of meltwater is accumulated 
+       !!                 in pond volume. It is then released exponentially when
+       !!                 surface is freezing.
+       !!
+       !! ** Tunable parameters : (no real expertise yet, ideas?)
+       !! 
+       !! ** Note       : Stolen from CICE for quick test of the melt pond
+       !!                 radiation and freshwater interfaces
+       !!                 Coupling can be radiative AND freshwater
+       !!                 Advection, ridging, rafting are called
+       !!
+       !! ** References : Holland, M. M. et al (J Clim 2012)
+       !!    
+       !!-------------------------------------------------------------------
+
+       INTEGER, DIMENSION(jpij)         :: indxi             ! compressed indices for cells with ice melting
+       INTEGER, DIMENSION(jpij)         :: indxj             !
+
+       REAL(wp), DIMENSION(jpi,jpj)     :: zwfx_mlw          ! available meltwater for melt ponding
+       REAL(wp), DIMENSION(jpi,jpj,jpl) :: zrfrac            ! fraction of available meltwater retained for melt ponding
+
+       REAL(wp), PARAMETER :: zrmin  = 0.15_wp  ! minimum fraction of available meltwater retained for melt ponding
+       REAL(wp), PARAMETER :: zrmax  = 0.70_wp  ! maximum   ''           ''       ''        ''            ''
+       REAL(wp), PARAMETER :: zrexp  = 0.01_wp  ! rate constant to refreeze melt ponds
+       REAL(wp), PARAMETER :: zpnd_aspect = 0.8_wp ! pond aspect ratio
+
+       REAL(wp) :: zhi               ! dummy ice thickness
+       REAL(wp) :: zhs               ! dummy snow depth
+       REAL(wp) :: zTp               ! reference temperature
+       REAL(wp) :: zdTs              ! dummy temperature difference
+       REAL(wp) :: z1_rhofw          ! inverse freshwater density
+       REAL(wp) :: z1_zpnd_aspect    ! inverse pond aspect ratio
+       REAL(wp) :: zvpold            ! dummy pond volume
+
+       INTEGER  :: ji, jj, jl, ij    ! loop indices
+       INTEGER  :: icells            ! size of dummy array
+       !!-------------------------------------------------------------------
+        z1_rhofw       = 1. / rhofw 
+        z1_zpnd_aspect = 1. / zpnd_aspect
+        zTp            = -2. 
+
+        a_ip_frac(:,:,:) = 0._wp
+        h_ip     (:,:,:) = 0._wp
+ 
+        !------------------------------------------------------------------
+        ! Available melt water for melt ponding and corresponding fraction
+        !------------------------------------------------------------------
+ 
+        zwfx_mlw(:,:) = MAX( wfx_sum(:,:) + wfx_snw_sum(:,:), 0._wp )        ! available meltwater for melt ponding
+
+                ! NB: zwfx_mlw can be slightly negative for very small values (why?)
+                ! This can in some occasions give negative
+                ! v_ip in the first category, which then gives crazy pond
+                ! fractions and crashes the code as soon as the melt-pond
+                ! radiative coupling is activated
+                ! if we understand and remove why wfx_sum or wfx_snw could be
+                ! negative, then, we can remove the MAX
+                ! NB: I now changed to wfx_snw_sum, this may fix the problem. 
+                ! We should check
+ 
+        zrfrac(:,:,:) = zrmin + ( zrmax - zrmin ) * a_i(:,:,:)  
+ 
+        DO jl = 1, jpl   
+
+           !------------------------------------------------------------------------------
+           ! Identify grid cells where ponds should be updated (can probably be improved)
+           !------------------------------------------------------------------------------
+ 
+           indxi(:) = 0
+           indxj(:) = 0
+           icells   = 0
+ 
+           DO jj = 1, jpj
+             DO ji = 1, jpi
+                IF ( a_i(ji,jj,jl) > epsi10 ) THEN
+                   icells = icells + 1
+                   indxi(icells) = ji
+                   indxj(icells) = jj
+                ENDIF
+             END DO                 ! ji
+          END DO                    ! jj
+ 
+          DO ij = 1, icells
+ 
+             ji = indxi(ij)
+             jj = indxj(ij)
+ 
+             zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+             zhs = v_s(ji,jj,jl) / a_i(ji,jj,jl)
+ 
+             IF ( zhi < rn_himin) THEN   !--- Remove ponds on thin ice if ice is too thin
+ 
+                a_ip(ji,jj,jl)      = 0._wp                               !--- Dump ponds
+                v_ip(ji,jj,jl)      = 0._wp
+                a_ip_frac(ji,jj,jl) = 0._wp
+                h_ip(ji,jj,jl)      = 0._wp
+ 
+                IF ( ln_pnd_fw ) & !--- Give freshwater to the ocean
+                   wfx_pnd(ji,jj)   = wfx_pnd(ji,jj) + v_ip(ji,jj,jl) 
+ 
+ 
+             ELSE                        !--- Update pond characteristics
+ 
+                !--- Add retained melt water to melt ponds
+                ! v_ip should never be positive, otherwise code crashes
+                ! MV: as far as I saw, UM5 can create very small negative v_ip values
+                ! hence I added the max, which was not required with Prather (1 yr run)
+                v_ip(ji,jj,jl)      = MAX( v_ip(ji,jj,jl), 0._wp ) + zrfrac(ji,jj,jl) * z1_rhofw * zwfx_mlw(ji,jj) * a_i(ji,jj,jl) * rdt_ice
+ 
+                !--- Shrink pond due to refreezing
+                zdTs                = MAX ( zTp - t_su(ji,jj,jl) + rt0 , 0. )
+                
+                zvpold              = v_ip(ji,jj,jl)
+ 
+                v_ip(ji,jj,jl)      = v_ip(ji,jj,jl) * EXP( zrexp * zdTs / zTp )
+ 
+                !--- Dump meltwater due to refreezing ( of course this is wrong
+                !--- but this parameterization is too simple )
+                IF ( ln_pnd_fw ) &
+                   wfx_pnd(ji,jj)   = wfx_pnd(ji,jj) + rhofw * ( v_ip(ji,jj,jl) - zvpold ) * r1_rdtice
+ 
+                a_ip_frac(ji,jj,jl) = MIN( 1._wp , SQRT( v_ip(ji,jj,jl) * z1_zpnd_aspect / a_i(ji,jj,jl) ) )
+                   !NB: the SQRT has been a recurring source of crash when v_ip or a_i tuns to be even only slightly negative
+ 
+                h_ip(ji,jj,jl)      = zpnd_aspect * a_ip_frac(ji,jj,jl)
+ 
+                a_ip(ji,jj,jl)      = a_ip_frac(ji,jj,jl) * a_i(ji,jj,jl)
+ 
+             !-----------------------------------------------------------
+             ! Limit pond depth
+             !-----------------------------------------------------------
+             ! The original version has pond depth limitation, which I did not
+             ! keep here. Maybe we need it later on
+             !
+             
+             ENDIF
+ 
+           END DO
+ 
+        END DO ! jpl
+ 
+        !--- Remove retained meltwater from surface fluxes 
+ 
+        IF ( ln_pnd_fw ) THEN
+ 
+            wfx_snw_sum(:,:) = wfx_snw_sum(:,:) *  ( 1. - zrmin - ( zrmax - zrmin ) * at_i(:,:) ) 
+
+            wfx_sum(:,:)     = wfx_sum(:,:) * ( 1. - zrmin - ( zrmax - zrmin ) * at_i(:,:) )
+
+        ENDIF
+
+   END SUBROUTINE lim_mp_cesm
+
+   SUBROUTINE lim_mp_topo    (aice,      aicen,     &
+                              vice,      vicen,     &
+                              vsnon,                &
+                              ticen,     salin,     &
+                              a_ip_frac, h_ip,      &
+                                         Tsfc )
+       !!-------------------------------------------------------------------
+       !!                ***  ROUTINE lim_mp_topo  ***
+       !!
+       !! ** Purpose :   Compute melt pond evolution based on the ice 
+       !!                topography as inferred from the ice thickness 
+       !!                distribution.  
+       !!
+       !! ** Method  :   This code is initially based on Flocco and Feltham 
+       !!                (2007) and Flocco et al. (2010). More to come...
+       !!
+       !! ** Tunable parameters :
+       !! 
+       !! ** Note :
+       !!
+       !! ** References
+       !!    Flocco, D. and D. L. Feltham, 2007.  A continuum model of melt pond 
+       !!    evolution on Arctic sea ice.  J. Geophys. Res. 112, C08016, doi: 
+       !!    10.1029/2006JC003836.
+       !!    Flocco, D., D. L. Feltham and A. K. Turner, 2010.  Incorporation of
+       !!    a physically based melt pond scheme into the sea ice component of a
+       !!    climate model.  J. Geophys. Res. 115, C08012, 
+       !!    doi: 10.1029/2009JC005568.
+       !!    
+       !!-------------------------------------------------------------------
+ 
+       REAL (wp), DIMENSION (jpi,jpj), &
+          INTENT(IN) :: &
+          aice, &    ! total ice area fraction
+          vice       ! total ice volume (m)
+ 
+       REAL (wp), DIMENSION (jpi,jpj,jpl), &
+          INTENT(IN) :: &
+          aicen, &   ! ice area fraction, per category
+          vsnon, &   ! snow volume, per category (m)
+          vicen      ! ice volume, per category (m)
+ 
+       REAL (wp), DIMENSION (jpi,jpj,nlay_i,jpl), &
+          INTENT(IN) :: &
+          ticen, &   ! ice enthalpy, per category
+          salin
+ 
+       REAL (wp), DIMENSION (jpi,jpj,jpl), &
+          INTENT(INOUT) :: &
+          a_ip_frac , &   ! pond area fraction of ice, per ice category
+          h_ip       ! pond depth, per ice category (m)
+ 
+       REAL (wp), DIMENSION (jpi,jpj,jpl), &
+          INTENT(IN) :: &
+          Tsfc       ! snow/sea ice surface temperature
+ 
+       ! local variables
+       REAL (wp), DIMENSION (jpi,jpj,jpl) :: &
+          zTsfcn, & ! ice/snow surface temperature (C)
+          zvolpn, & ! pond volume per unit area, per category (m)
+          zvuin     ! water-equivalent volume of ice lid on melt pond ('upper ice', m)
+ 
+       REAL (wp), DIMENSION (jpi,jpj,jpl) :: &
+          zapondn,& ! pond area fraction, per category
+          zhpondn   ! pond depth, per category (m)
+ 
+       REAL (wp), DIMENSION (jpi,jpj) :: &
+          zvolp       ! total volume of pond, per unit area of pond (m)
+ 
+       REAL (wp) :: &
+          zhi,    & ! ice thickness (m)
+          zdHui,  & ! change in thickness of ice lid (m)
+          zomega, & ! conduction
+          zdTice, & ! temperature difference across ice lid (C)
+          zdvice, & ! change in ice volume (m)
+          zTavg,  & ! mean surface temperature across categories (C)
+          zTp,    & ! pond freezing temperature (C)
+          zdvn      ! change in melt pond volume for fresh water budget
+       INTEGER, DIMENSION (jpi*jpj) :: &
+          indxi, indxj    ! compressed indices for cells with ice melting
+ 
+       INTEGER :: n,k,i,j,ij,icells,indxij ! loop indices
+ 
+       INTEGER, DIMENSION (jpl) :: &
+          kcells          ! cells where ice lid combines with vice
+ 
+       INTEGER, DIMENSION (jpi*jpj,jpl) :: &
+          indxii, indxjj  ! i,j indices for kcells loop
+ 
+       REAL (wp), parameter :: &
+          zhicemin  = 0.1_wp , & ! minimum ice thickness with ponds (m) 
+          zTd       = 0.15_wp, & ! temperature difference for freeze-up (C)
+          zr1_rlfus = 1._wp / 0.334e+6 / 917._wp , & ! (J/m^3)
+          zmin_volp = 1.e-4_wp, & ! minimum pond volume (m)
+          z0       = 0._wp,    & 
+          zTimelt   = 0._wp,    &
+          z01      = 0.01_wp,  &
+          z25      = 0.25_wp,  &
+          z5       = 0.5_wp
+
+       !---------------------------------------------------------------
+       ! Initialization
+       !---------------------------------------------------------------
+ 
+       zhpondn(:,:,:) = 0._wp
+       zapondn(:,:,:) = 0._wp
+       indxii(:,:) = 0
+       indxjj(:,:) = 0
+       kcells(:)   = 0
+
+       zvolp(:,:) = wfx_sum(:,:) + wfx_snw_sum(:,:) + vt_ip(:,:) ! Total available melt water, to be distributed as melt ponds
+       zTsfcn(:,:,:) = zTsfcn(:,:,:) - rt0                   ! Convert in Celsius
+ 
+       ! The freezing temperature for meltponds is assumed slightly below 0C,
+       ! as if meltponds had a little salt in them.  The salt budget is not
+       ! altered for meltponds, but if it were then an actual pond freezing 
+       ! temperature could be computed.
+ 
+       ! zTp = zTimelt - zTd  ---> for lids
+ 
+       !-----------------------------------------------------------------
+       ! Identify grid cells with ponds
+       !-----------------------------------------------------------------
+ 
+       icells = 0
+       DO j = 1, jpj
+       DO i = 1, jpi
+          zhi = z0
+          IF (aice(i,j) > epsi10 ) zhi = vice(i,j)/aice(i,j)
+          IF ( aice(i,j) > z01 .and. zhi > zhicemin .and. &
+             zvolp(i,j) > zmin_volp*aice(i,j)) THEN
+             icells = icells + 1
+             indxi(icells) = i
+             indxj(icells) = j
+          ELSE  ! remove ponds on thin ice
+             !fpond(i,j) = fpond(i,j) - zvolp(i,j)
+             zvolpn(i,j,:) = z0
+             zvuin (i,j,:) = z0
+             zvolp (i,j) = z0
+          END IF
+       END DO                     ! i
+       END DO                     ! j
+ 
+       DO ij = 1, icells
+          i = indxi(ij)
+          j = indxj(ij)
+ 
+          !--------------------------------------------------------------
+          ! calculate pond area and depth
+          !--------------------------------------------------------------
+          CALL lim_mp_area(aice(i,j),vice(i,j), &
+                    aicen(i,j,:), vicen(i,j,:), vsnon(i,j,:), &
+                    ticen(i,j,:,:), salin(i,j,:,:), &
+                    zvolpn(i,j,:), zvolp(i,j), &
+                    zapondn(i,j,:),zhpondn(i,j,:), zdvn)
+         ! outputs are
+         ! - zdvn
+         ! - zvolpn
+         ! - zvolp
+         ! - zapondn
+         ! - zhpondn
+
+          wfx_pnd(i,j) = wfx_pnd(i,j) + zdvn ! update flux from ponds to ocean
+ 
+          ! mean surface temperature MV - why do we need that ? --> for the lid
+
+          ! zTavg = z0
+          ! DO n = 1, jpl
+          !   zTavg = zTavg + zTsfcn(i,j,n)*aicen(i,j,n)
+          ! END DO
+          ! zTavg = zTavg / aice(i,j)
+ 
+       END DO ! ij
+ 
+       !---------------------------------------------------------------
+       ! Update pond volume and fraction
+       !---------------------------------------------------------------
+ 
+       a_ip(:,:,:) = zapondn(:,:,:)
+       v_ip(:,:,:) = zapondn(:,:,:) * zhpondn(:,:,:)
+       a_ip_frac(:,:,:) = 0._wp
+       h_ip     (:,:,:) = 0._wp
+
+    END SUBROUTINE lim_mp_topo
+
+    SUBROUTINE lim_mp_area(aice,vice, &
+                         aicen, vicen, vsnon, ticen, &
+                         salin, zvolpn, zvolp,         &
+                         zapondn,zhpondn,dvolp)
+
+       !!-------------------------------------------------------------------
+       !!                ***  ROUTINE lim_mp_area ***
+       !!
+       !! ** Purpose : Given the total volume of meltwater, update
+       !!              pond fraction (a_ip) and depth (should be volume)
+       !!
+       !! **
+       !!              
+       !!------------------------------------------------------------------
+
+       REAL (wp), INTENT(IN) :: &
+          aice,vice
+ 
+       REAL (wp), DIMENSION(jpl), INTENT(IN) :: &
+          aicen, vicen, vsnon
+ 
+       REAL (wp), DIMENSION(nlay_i,jpl), INTENT(IN) :: &
+          ticen, salin
+ 
+       REAL (wp), DIMENSION(jpl), INTENT(INOUT) :: &
+          zvolpn
+ 
+       REAL (wp), INTENT(INOUT) :: &
+          zvolp, dvolp
+ 
+       REAL (wp), DIMENSION(jpl), INTENT(OUT) :: &
+          zapondn, zhpondn
+ 
+       INTEGER :: &
+          n, ns,   &
+          m_index, &
+          permflag
+ 
+       REAL (wp), DIMENSION(jpl) :: &
+          hicen, &
+          hsnon, &
+          asnon, &
+          alfan, &
+          betan, &
+          cum_max_vol, &
+          reduced_aicen        
+ 
+       REAL (wp), DIMENSION(0:jpl) :: &
+          cum_max_vol_tmp
+ 
+       REAL (wp) :: &
+          hpond, &
+          drain, &
+          floe_weight, &
+          pressure_head, &
+          hsl_rel, &
+          deltah, &
+          perm, &
+          msno
+ 
+       REAL (wp), parameter :: & 
+          viscosity = 1.79e-3_wp, &  ! kinematic water viscosity in kg/m/s
+          z0        = 0.0_wp    , &
+          c1        = 1.0_wp    , &
+          p4        = 0.4_wp    , &
+          p6        = 0.6_wp    , &
+          epsi10      = 1.0e-11_wp
+          
+      !-----------|
+      !           |
+      !           |-----------|
+      !___________|___________|______________________________________sea-level
+      !           |           |
+      !           |           |---^--------|
+      !           |           |   |        |
+      !           |           |   |        |-----------|              |-------
+      !           |           |   |alfan(n)|           |              |
+      !           |           |   |        |           |--------------|
+      !           |           |   |        |           |              |
+      !---------------------------v-------------------------------------------
+      !           |           |   ^        |           |              |
+      !           |           |   |        |           |--------------|
+      !           |           |   |betan(n)|           |              |
+      !           |           |   |        |-----------|              |-------
+      !           |           |   |        |
+      !           |           |---v------- |
+      !           |           |
+      !           |-----------|
+      !           |
+      !-----------|
+     
+       !-------------------------------------------------------------------
+       ! initialize
+       !-------------------------------------------------------------------
+ 
+       DO n = 1, jpl
+ 
+          zapondn(n) = z0
+          zhpondn(n) = z0
+ 
+          !----------------------------------------
+          ! X) compute the effective snow fraction
+          !----------------------------------------
+          IF (aicen(n) < epsi10)  THEN
+             hicen(n) =  z0 
+             hsnon(n) = z0
+             reduced_aicen(n) = z0
+          ELSE
+             hicen(n) = vicen(n) / aicen(n)
+             hsnon(n) = vsnon(n) / aicen(n)
+             reduced_aicen(n) = c1 ! n=jpl
+             IF (n < jpl) reduced_aicen(n) = aicen(n) &
+                                  * (-0.024_wp*hicen(n) + 0.832_wp) 
+             asnon(n) = reduced_aicen(n)  ! effective snow fraction (empirical)
+             ! MV should check whether this makes sense to have the same effective snow fraction in here
+          END IF
+ 
+ ! This choice for alfa and beta ignores hydrostatic equilibium of categories.
+ ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming
+ ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all
+ ! categories.  alfa and beta partition the ITD - they are areas not thicknesses!
+ ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area.
+ ! Here, alfa = 60% of the ice area (and since hice is constant in a category, 
+ ! alfan = 60% of the ice volume) in each category lies above the reference line, 
+ ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required.
+
+ ! MV:  
+ ! Note that this choice is not in the original FF07 paper and has been adopted in CICE
+ ! No reason why is explained in the doc, but I guess there is a reason. I'll try to investigate, maybe
+
+ ! Where does that choice come from
+ 
+          alfan(n) = 0.6 * hicen(n)
+          betan(n) = 0.4 * hicen(n)
+        
+          cum_max_vol(n)     = z0
+          cum_max_vol_tmp(n) = z0
+     
+       END DO ! jpl
+ 
+       cum_max_vol_tmp(0) = z0
+       drain = z0
+       dvolp = z0
+
+       !----------------------------------------------------------
+       ! x) Drain overflow water, update pond fraction and volume
+       !----------------------------------------------------------
+       
+       !--------------------------------------------------------------------------
+       ! the maximum amount of water that can be contained up to each ice category
+       !--------------------------------------------------------------------------
+
+       ! MV
+       ! If melt ponds are too deep to be sustainable given the ITD (OVERFLOW)
+       ! Then the excess volume cum_max_vol(jl) drains out of the system
+       ! It should be added to wfx_pnd
+       ! END MV
+     
+       DO n = 1, jpl-1 ! last category can not hold any volume
+ 
+          IF (alfan(n+1) >= alfan(n) .and. alfan(n+1) > z0) THEN
+ 
+             ! total volume in level including snow
+             cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1) + &
+                (alfan(n+1) - alfan(n)) * sum(reduced_aicen(1:n)) 
+ 
+             ! subtract snow solid volumes from lower categories in current level
+             DO ns = 1, n 
+                cum_max_vol_tmp(n) = cum_max_vol_tmp(n) &
+                   - rhosn/rhofw * &   ! free air fraction that can be filled by water
+                     asnon(ns)  * &    ! effective areal fraction of snow in that category
+                     max(min(hsnon(ns)+alfan(ns)-alfan(n), alfan(n+1)- &
+                                   alfan(n)), z0)  
+             END DO
+
+          ELSE ! assume higher categories unoccupied
+             cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1)
+          END IF
+          !IF (cum_max_vol_tmp(n) < z0) THEN
+          !   call abort_ice('negative melt pond volume')
+          !END IF
+       END DO
+       cum_max_vol_tmp(jpl) = cum_max_vol_tmp(jpl-1)  ! last category holds no volume
+       cum_max_vol  (1:jpl) = cum_max_vol_tmp(1:jpl)
+     
+       !----------------------------------------------------------------
+       ! is there more meltwater than can be held in the floe?
+       !----------------------------------------------------------------
+       IF (zvolp >= cum_max_vol(jpl)) THEN
+          drain = zvolp - cum_max_vol(jpl) + epsi10
+          zvolp = zvolp - drain ! update meltwater volume available
+          dvolp = drain         ! this is the drained water
+          IF (zvolp < epsi10) THEN
+             dvolp = dvolp + zvolp
+             zvolp = z0
+          END IF
+       END IF
+     
+       ! height and area corresponding to the remaining volume
+ 
+!      call calc_hpond(reduced_aicen, asnon, hsnon, rhos, alfan, &
+!           zvolp, cum_max_vol, hpond, m_index)
+     
+       DO n=1, m_index
+          zhpondn(n) = hpond - alfan(n) + alfan(1) ! here oui choulde update
+                                                   !  volume instead, no ?
+          zapondn(n) = reduced_aicen(n) 
+          ! in practise, pond fraction depends on the empirical snow fraction
+          ! so in turn on ice thickness
+       END DO
+     
+       !------------------------------------------------------------------------
+       ! Drainage through brine network (permeability)
+       !------------------------------------------------------------------------
+       !!! drainage due to ice permeability - Darcy's law
+     
+       ! sea water level 
+       msno = z0
+       DO n=1,jpl
+         msno = msno + vsnon(n) * rhosn
+       END DO
+       floe_weight = (msno + rhoic*vice + rau0*zvolp) / aice
+       hsl_rel = floe_weight / rau0 &
+               - ((sum(betan(:)*aicen(:))/aice) + alfan(1))
+     
+       deltah = hpond - hsl_rel
+       pressure_head = grav * rau0 * max(deltah, z0)
+ 
+       ! drain IF ice is permeable    
+       permflag = 0
+       IF (pressure_head > z0) THEN
+       DO n = 1, jpl-1
+          IF (hicen(n) /= z0) THEN
+             perm = 0. ! MV ugly dummy patch
+             CALL lim_mp_perm(ticen(:,n), salin(:,n), vicen(n), perm)
+             IF (perm > z0) permflag = 1
+
+             drain = perm*zapondn(n)*pressure_head*rdt_ice / &
+                                      (viscosity*hicen(n))
+             dvolp = dvolp + min(drain, zvolp)
+             zvolp = max(zvolp - drain, z0)
+             IF (zvolp < epsi10) THEN
+                dvolp = dvolp + zvolp
+                zvolp = z0
+             END IF
+          END IF
+       END DO
+  
+       ! adjust melt pond DIMENSIONs
+       IF (permflag > 0) THEN
+          ! recompute pond depth    
+!         CALL calc_hpond(reduced_aicen, asnon, hsnon, rhos, alfan, &
+!                         zvolp, cum_max_vol, hpond, m_index)
+          DO n=1, m_index
+             zhpondn(n) = hpond - alfan(n) + alfan(1)
+             zapondn(n) = reduced_aicen(n) 
+          END DO
+       END IF
+       END IF ! pressure_head
+ 
+       !-------------------------------
+       ! X) remove water from the snow
+       !-------------------------------
+       !------------------------------------------------------------------------
+       ! total melt pond volume in category DOes not include snow volume
+       ! snow in melt ponds is not melted
+       !------------------------------------------------------------------------
+ 
+       ! Calculate pond volume for lower categories
+       DO n=1,m_index-1
+          zvolpn(n) = zapondn(n) * zhpondn(n) & ! what is not in the snow
+                   - (rhosn/rhofw) * asnon(n) * min(hsnon(n), zhpondn(n))
+       END DO
+ 
+       ! Calculate pond volume for highest category = remaining pond volume
+
+       ! The following is completely unclear to Martin at least
+       ! Could we redefine properly and recode in a more readable way ?
+
+       ! m_index = last category with melt pond
+
+       IF (m_index == 1) zvolpn(m_index) = zvolp ! volume of mw in 1st category is the total volume of melt water
+
+       IF (m_index > 1) THEN
+         IF (zvolp > sum(zvolpn(1:m_index-1))) THEN
+           zvolpn(m_index) = zvolp - sum(zvolpn(1:m_index-1)) ! 
+         ELSE
+           zvolpn(m_index) = z0
+           zhpondn(m_index) = z0
+           zapondn(m_index) = z0
+           ! If remaining pond volume is negative reduce pond volume of 
+           ! lower category
+           IF (zvolp+epsi10 < sum(zvolpn(1:m_index-1))) & 
+             zvolpn(m_index-1) = zvolpn(m_index-1)-sum(zvolpn(1:m_index-1))&
+                                + zvolp
+         END IF
+       END IF
+ 
+       DO n=1,m_index
+          IF (zapondn(n) > epsi10) THEN
+              zhpondn(n) = zvolpn(n) / zapondn(n)
+          ELSE
+             dvolp = dvolp + zvolpn(n)
+             zhpondn(n) = z0
+             zvolpn(n) = z0
+             zapondn(n) = z0
+          end IF
+       END DO
+       DO n = m_index+1, jpl
+          zhpondn(n) = z0
+          zapondn(n) = z0
+          zvolpn (n) = z0
+       END DO
+ 
+    END SUBROUTINE lim_mp_area
+
+!OLI_CODE   
+!OLI_CODE 
+!OLI_CODE    SUBROUTINE calc_hpond(aicen, asnon, hsnon, rhos, alfan, &
+!OLI_CODE                          zvolp, cum_max_vol,                &
+!OLI_CODE                          hpond, m_index)
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       !!                ***  ROUTINE calc_hpond  ***
+!OLI_CODE       !!
+!OLI_CODE       !! ** Purpose :   Compute melt pond depth
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE     
+!OLI_CODE       REAL (wp), DIMENSION(jpl), INTENT(IN) :: &
+!OLI_CODE          aicen, &
+!OLI_CODE          asnon, &
+!OLI_CODE          hsnon, &
+!OLI_CODE          rhos,  &
+!OLI_CODE          alfan, &
+!OLI_CODE          cum_max_vol
+!OLI_CODE     
+!OLI_CODE       REAL (wp), INTENT(IN) :: &
+!OLI_CODE          zvolp
+!OLI_CODE     
+!OLI_CODE       REAL (wp), INTENT(OUT) :: &
+!OLI_CODE          hpond
+!OLI_CODE     
+!OLI_CODE       INTEGER, INTENT(OUT) :: &
+!OLI_CODE          m_index
+!OLI_CODE     
+!OLI_CODE       INTEGER :: n, ns
+!OLI_CODE     
+!OLI_CODE       REAL (wp), DIMENSION(0:jpl+1) :: &
+!OLI_CODE          hitl, &
+!OLI_CODE          aicetl
+!OLI_CODE     
+!OLI_CODE       REAL (wp) :: &
+!OLI_CODE          rem_vol, &
+!OLI_CODE          area, &
+!OLI_CODE          vol, &
+!OLI_CODE          tmp, &
+!OLI_CODE          z0   = 0.0_wp,    &   
+!OLI_CODE          epsi10 = 1.0e-11_wp
+!OLI_CODE     
+!OLI_CODE       !----------------------------------------------------------------
+!OLI_CODE       ! hpond is zero if zvolp is zero - have we fully drained? 
+!OLI_CODE       !----------------------------------------------------------------
+!OLI_CODE     
+!OLI_CODE       IF (zvolp < epsi10) THEN
+!OLI_CODE        hpond = z0
+!OLI_CODE        m_index = 0
+!OLI_CODE       ELSE
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! Calculate the category where water fills up to 
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        !----------|
+!OLI_CODE        !          |
+!OLI_CODE        !          |
+!OLI_CODE        !          |----------|                                     -- --
+!OLI_CODE        !__________|__________|_________________________________________ ^
+!OLI_CODE        !          |          |             rem_vol     ^                | Semi-filled
+!OLI_CODE        !          |          |----------|-- -- -- - ---|-- ---- -- -- --v layer
+!OLI_CODE        !          |          |          |              |
+!OLI_CODE        !          |          |          |              |hpond
+!OLI_CODE        !          |          |          |----------|   |     |-------
+!OLI_CODE        !          |          |          |          |   |     |
+!OLI_CODE        !          |          |          |          |---v-----|
+!OLI_CODE        !          |          | m_index  |          |         |
+!OLI_CODE        !-------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        m_index = 0  ! 1:m_index categories have water in them
+!OLI_CODE        DO n = 1, jpl
+!OLI_CODE           IF (zvolp <= cum_max_vol(n)) THEN
+!OLI_CODE              m_index = n
+!OLI_CODE              IF (n == 1) THEN
+!OLI_CODE                 rem_vol = zvolp
+!OLI_CODE              ELSE
+!OLI_CODE                 rem_vol = zvolp - cum_max_vol(n-1)
+!OLI_CODE              END IF
+!OLI_CODE              exit ! to break out of the loop
+!OLI_CODE           END IF
+!OLI_CODE        END DO
+!OLI_CODE        m_index = min(jpl-1, m_index)
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! semi-filled layer may have m_index different snow in it
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        !-----------------------------------------------------------  ^
+!OLI_CODE        !                                                             |  alfan(m_index+1)
+!OLI_CODE        !                                                             |
+!OLI_CODE        !hitl(3)-->                             |----------|          |
+!OLI_CODE        !hitl(2)-->                |------------| * * * * *|          |
+!OLI_CODE        !hitl(1)-->     |----------|* * * * * * |* * * * * |          |
+!OLI_CODE        !hitl(0)-->-------------------------------------------------  |  ^
+!OLI_CODE        !                various snow from lower categories          |  |alfa(m_index)
+!OLI_CODE        
+!OLI_CODE        ! hitl - heights of the snow layers from thinner and current categories
+!OLI_CODE        ! aicetl - area of each snow depth in this layer
+!OLI_CODE        
+!OLI_CODE        hitl(:) = z0
+!OLI_CODE        aicetl(:) = z0
+!OLI_CODE        DO n = 1, m_index
+!OLI_CODE           hitl(n)   = max(min(hsnon(n) + alfan(n) - alfan(m_index), &
+!OLI_CODE                                  alfan(m_index+1) - alfan(m_index)), z0)
+!OLI_CODE           aicetl(n) = asnon(n)
+!OLI_CODE           
+!OLI_CODE           aicetl(0) = aicetl(0) + (aicen(n) - asnon(n))
+!OLI_CODE        END DO
+!OLI_CODE        hitl(m_index+1) = alfan(m_index+1) - alfan(m_index)
+!OLI_CODE        aicetl(m_index+1) = z0
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! reorder array according to hitl 
+!OLI_CODE        ! snow heights not necessarily in height order
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        DO ns = 1, m_index+1
+!OLI_CODE           DO n = 0, m_index - ns + 1
+!OLI_CODE              IF (hitl(n) > hitl(n+1)) THEN ! swap order
+!OLI_CODE                 tmp = hitl(n)
+!OLI_CODE                 hitl(n) = hitl(n+1)
+!OLI_CODE                 hitl(n+1) = tmp
+!OLI_CODE                 tmp = aicetl(n)
+!OLI_CODE                 aicetl(n) = aicetl(n+1)
+!OLI_CODE                 aicetl(n+1) = tmp
+!OLI_CODE              END IF
+!OLI_CODE           END DO
+!OLI_CODE        END DO
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! divide semi-filled layer into set of sublayers each vertically homogenous
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        !hitl(3)----------------------------------------------------------------
+!OLI_CODE        !                                                       | * * * * * * * *  
+!OLI_CODE        !                                                       |* * * * * * * * * 
+!OLI_CODE        !hitl(2)----------------------------------------------------------------
+!OLI_CODE        !                                    | * * * * * * * *  | * * * * * * * *  
+!OLI_CODE        !                                    |* * * * * * * * * |* * * * * * * * * 
+!OLI_CODE        !hitl(1)----------------------------------------------------------------
+!OLI_CODE        !                 | * * * * * * * *  | * * * * * * * *  | * * * * * * * *  
+!OLI_CODE        !                 |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * 
+!OLI_CODE        !hitl(0)----------------------------------------------------------------
+!OLI_CODE        !    aicetl(0)         aicetl(1)           aicetl(2)          aicetl(3)            
+!OLI_CODE        
+!OLI_CODE        ! move up over layers incrementing volume
+!OLI_CODE        DO n = 1, m_index+1
+!OLI_CODE           
+!OLI_CODE           area = sum(aicetl(:)) - &                 ! total area of sub-layer
+!OLI_CODE                (rhos(n)/rau0) * sum(aicetl(n:jpl+1)) ! area of sub-layer occupied by snow
+!OLI_CODE           
+!OLI_CODE           vol = (hitl(n) - hitl(n-1)) * area      ! thickness of sub-layer times area
+!OLI_CODE           
+!OLI_CODE           IF (vol >= rem_vol) THEN  ! have reached the sub-layer with the depth within
+!OLI_CODE              hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - &
+!OLI_CODE                           alfan(1)
+!OLI_CODE              exit
+!OLI_CODE           ELSE  ! still in sub-layer below the sub-layer with the depth
+!OLI_CODE              rem_vol = rem_vol - vol
+!OLI_CODE           END IF
+!OLI_CODE           
+!OLI_CODE        END DO
+!OLI_CODE        
+!OLI_CODE       END IF
+!OLI_CODE     
+!OLI_CODE    END SUBROUTINE calc_hpond
+!OLI_CODE   
+!OLI_CODE 
+    SUBROUTINE lim_mp_perm(ticen, salin, vicen, perm)
+       !!-------------------------------------------------------------------
+       !!                ***  ROUTINE lim_mp_perm ***
+       !!
+       !! ** Purpose :   Determine the liquid fraction of brine in the ice
+       !!                and its permeability
+       !!-------------------------------------------------------------------
+       REAL (wp), DIMENSION(nlay_i), INTENT(IN) :: &
+          ticen,  & ! energy of melting for each ice layer (J/m2)
+          salin
+ 
+       REAL (wp), INTENT(IN) :: &
+          vicen     ! ice volume
+     
+       REAL (wp), INTENT(OUT) :: &
+          perm      ! permeability
+ 
+       REAL (wp) ::   &
+          Sbr        ! brine salinity
+ 
+       REAL (wp), DIMENSION(nlay_i) ::   &
+          Tin, &    ! ice temperature
+          phi       ! liquid fraction
+ 
+       INTEGER :: k
+     
+       REAL (wp) :: &
+          c2    = 2.0_wp
+  
+       !-----------------------------------------------------------------
+       ! Compute ice temperatures from enthalpies using quadratic formula
+       !-----------------------------------------------------------------
+ 
+       DO k = 1,nlay_i
+          Tin(k) = ticen(k) 
+       END DO
+ 
+       !-----------------------------------------------------------------
+       ! brine salinity and liquid fraction
+       !-----------------------------------------------------------------
+ 
+       IF (maxval(Tin-rtt) <= -c2) THEN
+ 
+          DO k = 1,nlay_i
+             Sbr = - 1.2_wp                 &
+                   -21.8_wp     * (Tin(k)-rtt)    &
+                   - 0.919_wp   * (Tin(k)-rtt)**2 &
+                   - 0.01878_wp * (Tin(k)-rtt)**3
+             phi(k) = salin(k)/Sbr ! liquid fraction
+          END DO ! k
+        
+       ELSE
+ 
+          DO k = 1,nlay_i
+             Sbr = -17.6_wp    * (Tin(k)-rtt)    &
+                   - 0.389_wp  * (Tin(k)-rtt)**2 &
+                   - 0.00362_wp* (Tin(k)-rtt)**3
+             phi(k) = salin(k)/Sbr ! liquid fraction
+          END DO
+ 
+       END IF
+     
+       !-----------------------------------------------------------------
+       ! permeability
+       !-----------------------------------------------------------------
+ 
+       perm = 3.0e-08_wp * (minval(phi))**3 ! REFERENCE PLEASE (this fucking
+                                            ! bastard of Golden)
+     
+    END SUBROUTINE lim_mp_perm
+!OLI_CODE   
+!OLI_CODE #else
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE    !!   Default option         Dummy Module          No LIM-3 sea-ice model
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE CONTAINS
+!OLI_CODE    SUBROUTINE lim_mp_init          ! Empty routine
+!OLI_CODE    END SUBROUTINE lim_mp_init   
+!OLI_CODE    SUBROUTINE lim_mp               ! Empty routine
+!OLI_CODE    END SUBROUTINE lim_mp
+!OLI_CODE    SUBROUTINE compute_mp_topo      ! Empty routine
+!OLI_CODE    END SUBROUTINE compute_mp_topo        
+!OLI_CODE    SUBROUTINE pond_area            ! Empty routine
+!OLI_CODE    END SUBROUTINE pond_area   
+!OLI_CODE    SUBROUTINE calc_hpond           ! Empty routine
+!OLI_CODE    END SUBROUTINE calc_hpond   
+!OLI_CODE    SUBROUTINE permeability_phy     ! Empty routine
+!OLI_CODE    END SUBROUTINE permeability_phy   
+!OLI_CODE #endif
+!OLI_CODE    !!======================================================================
+!OLI_CODE END MODULE limmp_topo
+
+
+!OLI_CODE MODULE limmp_topo
+!OLI_CODE    !!======================================================================
+!OLI_CODE    !!                       ***  MODULE limmp_topo ***
+!OLI_CODE    !! LIM-3 sea-ice :  computation of melt ponds' properties
+!OLI_CODE    !!======================================================================
+!OLI_CODE    !! History :  Original code by Daniela Flocco and Adrian Turner
+!OLI_CODE    !!            ! 2012-09 (O. Lecomte) Adaptation for routine inclusion in 
+!OLI_CODE    !!                      NEMO-LIM3.1
+!OLI_CODE    !!            ! 2016-11 (O. Lecomte, C. Rousset, M. Vancoppenolle) 
+!OLI_CODE    !!                      Adaptation for merge with NEMO-LIM3.6
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE #if defined key_lim3
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE    !!   'key_lim3'                                      LIM-3 sea-ice model
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE    !!   lim_mp_init     : melt pond properties initialization
+!OLI_CODE    !!   lim_mp          : melt pond routine caller
+!OLI_CODE    !!   compute_mp_topo : Actual melt pond routine
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE    USE ice_oce, ONLY: rdt_ice, tatm_ice
+!OLI_CODE    USE phycst
+!OLI_CODE    USE dom_ice
+!OLI_CODE    USE dom_oce
+!OLI_CODE    USE sbc_oce
+!OLI_CODE    USE sbc_ice
+!OLI_CODE    USE par_ice
+!OLI_CODE    USE par_oce
+!OLI_CODE    USE ice
+!OLI_CODE    USE thd_ice
+!OLI_CODE    USE in_out_manager
+!OLI_CODE    USE lbclnk
+!OLI_CODE    USE lib_mpp
+!OLI_CODE 
+!OLI_CODE    IMPLICIT NONE
+!OLI_CODE    PRIVATE
+!OLI_CODE 
+!OLI_CODE    PUBLIC   lim_mp_init
+!OLI_CODE    PUBLIC   lim_mp
+!OLI_CODE 
+!OLI_CODE CONTAINS
+!OLI_CODE 
+!OLI_CODE    SUBROUTINE lim_mp_init
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       !!                ***  ROUTINE lim_mp_init  ***
+!OLI_CODE       !!
+!OLI_CODE       !! ** Purpose :   Initialize melt ponds
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       a_ip_frac(:,:,:)    = 0._wp
+!OLI_CODE       a_ip(:,:,:)         = 0._wp
+!OLI_CODE       h_ip(:,:,:)         = 0._wp
+!OLI_CODE       v_ip(:,:,:)         = 0._wp
+!OLI_CODE       h_il(:,:,:)         = 0._wp
+!OLI_CODE       v_il(:,:,:)         = 0._wp
+!OLI_CODE         
+!OLI_CODE    END SUBROUTINE lim_mp_init
+!OLI_CODE 
+!OLI_CODE 
+!OLI_CODE    SUBROUTINE lim_mp
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       !!                ***  ROUTINE lim_mp  ***
+!OLI_CODE       !!
+!OLI_CODE       !! ** Purpose :   Compute surface heat flux and call main melt pond
+!OLI_CODE       !!                routine
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       INTEGER  ::   ji, jj, jl   ! dummy loop indices
+!OLI_CODE 
+!OLI_CODE       fsurf(:,:) = 0.e0
+!OLI_CODE       DO jl = 1, jpl
+!OLI_CODE          DO jj = 1, jpj
+!OLI_CODE             DO ji = 1, jpi
+!OLI_CODE                fsurf(ji,jj) = fsurf(ji,jj) + a_i(ji,jj,jl) * &
+!OLI_CODE                      (qns_ice(ji,jj,jl) + (1.0 - izero(ji,jj,jl)) &
+!OLI_CODE                        * qsr_ice(ji,jj,jl))
+!OLI_CODE             END DO
+!OLI_CODE          END DO
+!OLI_CODE       END DO
+!OLI_CODE 
+!OLI_CODE       CALL compute_mp_topo(at_i, a_i,                               &
+!OLI_CODE                          vt_i, v_i, v_s, rhosn_glo, t_i, sz_i, a_ip_frac,  &
+!OLI_CODE                       h_ip, h_il, t_su, tatm_ice, diag_sur_me*rdt_ice, &
+!OLI_CODE                          fsurf, fwoc)
+!OLI_CODE 
+!OLI_CODE       at_ip(:,:) = 0.0
+!OLI_CODE       vt_ip(:,:) = 0.0
+!OLI_CODE       vt_il(:,:) = 0.0
+!OLI_CODE       DO jl = 1, jpl
+!OLI_CODE         DO jj = 1, jpj
+!OLI_CODE            DO ji = 1, jpi
+!OLI_CODE               a_ip(ji,jj,jl) = MAX(0.0_wp, a_ip_frac(ji,jj,jl) * &
+!OLI_CODE                                                   a_i(ji,jj,jl))
+!OLI_CODE               v_ip(ji,jj,jl) = MAX(0.0_wp, a_ip_frac(ji,jj,jl) * &
+!OLI_CODE                                   a_i(ji,jj,jl) * h_ip(ji,jj,jl))
+!OLI_CODE               v_il(ji,jj,jl) = MAX(0.0_wp, a_ip_frac(ji,jj,jl) * &
+!OLI_CODE                                   a_i(ji,jj,jl) * h_il(ji,jj,jl))
+!OLI_CODE               at_ip(ji,jj)   = at_ip(ji,jj) + a_ip(ji,jj,jl)
+!OLI_CODE               vt_ip(ji,jj)   = vt_ip(ji,jj) + v_ip(ji,jj,jl)
+!OLI_CODE               vt_il(ji,jj)   = vt_il(ji,jj) + v_il(ji,jj,jl)
+!OLI_CODE            END DO
+!OLI_CODE         END DO
+!OLI_CODE       END DO
+!OLI_CODE 
+!OLI_CODE    END SUBROUTINE lim_mp
+!OLI_CODE 
+!OLI_CODE 
+!OLI_CODE    SUBROUTINE compute_mp_topo(aice,      aicen,     &
+!OLI_CODE                               vice,      vicen,     &
+!OLI_CODE                               vsnon,     rhos,      &
+!OLI_CODE                               ticen,     salin,     &
+!OLI_CODE                               a_ip_frac, h_ip,      &
+!OLI_CODE                               h_il,      Tsfc,      &
+!OLI_CODE                               potT,      meltt,     &
+!OLI_CODE                               fsurf,     fwoc)
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       !!                ***  ROUTINE compute_mp_topo  ***
+!OLI_CODE       !!
+!OLI_CODE       !! ** Purpose :   Compute melt pond evolution based on the ice 
+!OLI_CODE       !!                topography as inferred from the ice thickness 
+!OLI_CODE       !!                distribution.  
+!OLI_CODE       !!
+!OLI_CODE       !! ** Method  :   This code is initially based on Flocco and Feltham 
+!OLI_CODE       !!                (2007) and Flocco et al. (2010). More to come...
+!OLI_CODE       !!
+!OLI_CODE       !! ** Tunable parameters :
+!OLI_CODE       !! 
+!OLI_CODE       !! ** Note :
+!OLI_CODE       !!
+!OLI_CODE       !! ** References
+!OLI_CODE       !!    Flocco, D. and D. L. Feltham, 2007.  A continuum model of melt pond 
+!OLI_CODE       !!    evolution on Arctic sea ice.  J. Geophys. Res. 112, C08016, doi: 
+!OLI_CODE       !!    10.1029/2006JC003836.
+!OLI_CODE       !!    Flocco, D., D. L. Feltham and A. K. Turner, 2010.  Incorporation of
+!OLI_CODE       !!    a physically based melt pond scheme into the sea ice component of a
+!OLI_CODE       !!    climate model.  J. Geophys. Res. 115, C08012, 
+!OLI_CODE       !!    doi: 10.1029/2009JC005568.
+!OLI_CODE       !!    
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj), &
+!OLI_CODE          INTENT(IN) :: &
+!OLI_CODE          aice, &    ! total ice area fraction
+!OLI_CODE          vice       ! total ice volume (m)
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj,jpl), &
+!OLI_CODE          INTENT(IN) :: &
+!OLI_CODE          aicen, &   ! ice area fraction, per category
+!OLI_CODE          vsnon, &   ! snow volume, per category (m)
+!OLI_CODE          rhos,  &   ! equivalent snow density, per category (kg/m^3)
+!OLI_CODE          vicen      ! ice volume, per category (m)
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj,nlay_i,jpl), &
+!OLI_CODE          INTENT(IN) :: &
+!OLI_CODE          ticen, &   ! ice enthalpy, per category
+!OLI_CODE          salin
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj,jpl), &
+!OLI_CODE          INTENT(INOUT) :: &
+!OLI_CODE          a_ip_frac , &   ! pond area fraction of ice, per ice category
+!OLI_CODE          h_ip , &   ! pond depth, per ice category (m)
+!OLI_CODE          h_il       ! Refrozen ice lid thickness, per ice category (m)
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj), &
+!OLI_CODE          INTENT(IN) :: &
+!OLI_CODE          potT,  &   ! air potential temperature
+!OLI_CODE          meltt, &   ! total surface meltwater flux
+!OLI_CODE          fsurf      ! thermodynamic heat flux at ice/snow surface (W/m^2)
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj), &
+!OLI_CODE          INTENT(INOUT) :: &
+!OLI_CODE          fwoc      ! fresh water flux to the ocean (from draining and other pond volume adjustments)
+!OLI_CODE                    ! (m)
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj,jpl), &
+!OLI_CODE          INTENT(IN) :: &
+!OLI_CODE          Tsfc       ! snow/sea ice surface temperature
+!OLI_CODE 
+!OLI_CODE       ! local variables
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj,jpl) :: &
+!OLI_CODE          zTsfcn, & ! ice/snow surface temperature (C)
+!OLI_CODE          zvolpn, & ! pond volume per unit area, per category (m)
+!OLI_CODE          zvuin     ! water-equivalent volume of ice lid on melt pond ('upper ice', m)
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj,jpl) :: &
+!OLI_CODE          zapondn,& ! pond area fraction, per category
+!OLI_CODE          zhpondn   ! pond depth, per category (m)
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION (jpi,jpj) :: &
+!OLI_CODE          zvolp       ! total volume of pond, per unit area of pond (m)
+!OLI_CODE 
+!OLI_CODE       REAL (wp) :: &
+!OLI_CODE          zhi,    & ! ice thickness (m)
+!OLI_CODE          zdHui,  & ! change in thickness of ice lid (m)
+!OLI_CODE          zomega, & ! conduction
+!OLI_CODE          zdTice, & ! temperature difference across ice lid (C)
+!OLI_CODE          zdvice, & ! change in ice volume (m)
+!OLI_CODE          zTavg,  & ! mean surface temperature across categories (C)
+!OLI_CODE          zTp,    & ! pond freezing temperature (C)
+!OLI_CODE          zdvn      ! change in melt pond volume for fresh water budget
+!OLI_CODE       INTEGER, DIMENSION (jpi*jpj) :: &
+!OLI_CODE          indxi, indxj    ! compressed indices for cells with ice melting
+!OLI_CODE 
+!OLI_CODE       INTEGER :: n,k,i,j,ij,icells,indxij ! loop indices
+!OLI_CODE 
+!OLI_CODE       INTEGER, DIMENSION (jpl) :: &
+!OLI_CODE          kcells          ! cells where ice lid combines with vice
+!OLI_CODE 
+!OLI_CODE       INTEGER, DIMENSION (jpi*jpj,jpl) :: &
+!OLI_CODE          indxii, indxjj  ! i,j indices for kcells loop
+!OLI_CODE 
+!OLI_CODE       REAL (wp), parameter :: &
+!OLI_CODE          zhicemin  = 0.1_wp , & ! minimum ice thickness with ponds (m) 
+!OLI_CODE          zTd       = 0.15_wp, & ! temperature difference for freeze-up (C)
+!OLI_CODE          zr1_rlfus = 1._wp / 0.334e+6 / 917._wp , & ! (J/m^3)
+!OLI_CODE          zmin_volp = 1.e-4_wp, & ! minimum pond volume (m)
+!OLI_CODE          z0       = 0._wp,    & 
+!OLI_CODE          zTimelt   = 0._wp,    &
+!OLI_CODE          z01      = 0.01_wp,  &
+!OLI_CODE          z25      = 0.25_wp,  &
+!OLI_CODE          z5       = 0.5_wp,   &
+!OLI_CODE          epsi10     = 1.0e-11_wp
+!OLI_CODE       !---------------------------------------------------------------
+!OLI_CODE       ! initialize
+!OLI_CODE       !---------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       DO j = 1, jpj
+!OLI_CODE          DO i = 1, jpi
+!OLI_CODE             zvolp(i,j) = z0
+!OLI_CODE          END DO
+!OLI_CODE       END DO
+!OLI_CODE       DO n = 1, jpl
+!OLI_CODE          DO j = 1, jpj
+!OLI_CODE             DO i = 1, jpi
+!OLI_CODE                ! load tracers
+!OLI_CODE                zvolp(i,j) = zvolp(i,j) + h_ip(i,j,n) &
+!OLI_CODE                                      * a_ip_frac(i,j,n) * aicen(i,j,n)
+!OLI_CODE                zTsfcn(i,j,n) = Tsfc(i,j,n) - rtt ! convert in Celsius - Oli
+!OLI_CODE                zvuin (i,j,n) = h_il(i,j,n) &
+!OLI_CODE                             * a_ip_frac(i,j,n) * aicen(i,j,n)
+!OLI_CODE 
+!OLI_CODE                zhpondn(i,j,n) = z0     ! pond depth, per category
+!OLI_CODE                zapondn(i,j,n) = z0     ! pond area,  per category
+!OLI_CODE             END DO
+!OLI_CODE          END DO
+!OLI_CODE          indxii(:,n) = 0
+!OLI_CODE          indxjj(:,n) = 0
+!OLI_CODE          kcells  (n) = 0
+!OLI_CODE       END DO
+!OLI_CODE 
+!OLI_CODE       ! The freezing temperature for meltponds is assumed slightly below 0C,
+!OLI_CODE       ! as if meltponds had a little salt in them.  The salt budget is not
+!OLI_CODE       ! altered for meltponds, but if it were then an actual pond freezing 
+!OLI_CODE       ! temperature could be computed.
+!OLI_CODE 
+!OLI_CODE       zTp = zTimelt - zTd
+!OLI_CODE 
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE       ! Identify grid cells with ponds
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       icells = 0
+!OLI_CODE       DO j = 1, jpj
+!OLI_CODE       DO i = 1, jpi
+!OLI_CODE          zhi = z0
+!OLI_CODE          IF (aice(i,j) > epsi10) zhi = vice(i,j)/aice(i,j)
+!OLI_CODE          IF ( aice(i,j) > z01 .and. zhi > zhicemin .and. &
+!OLI_CODE             zvolp(i,j) > zmin_volp*aice(i,j)) THEN
+!OLI_CODE             icells = icells + 1
+!OLI_CODE             indxi(icells) = i
+!OLI_CODE             indxj(icells) = j
+!OLI_CODE          ELSE  ! remove ponds on thin ice
+!OLI_CODE             !fpond(i,j) = fpond(i,j) - zvolp(i,j)
+!OLI_CODE             zvolpn(i,j,:) = z0
+!OLI_CODE             zvuin (i,j,:) = z0
+!OLI_CODE             zvolp (i,j) = z0
+!OLI_CODE          END IF
+!OLI_CODE       END DO                     ! i
+!OLI_CODE       END DO                     ! j
+!OLI_CODE 
+!OLI_CODE       DO ij = 1, icells
+!OLI_CODE          i = indxi(ij)
+!OLI_CODE          j = indxj(ij)
+!OLI_CODE 
+!OLI_CODE          !--------------------------------------------------------------
+!OLI_CODE          ! calculate pond area and depth
+!OLI_CODE          !--------------------------------------------------------------
+!OLI_CODE          CALL pond_area(aice(i,j),vice(i,j),rhos(i,j,:), &
+!OLI_CODE                    aicen(i,j,:), vicen(i,j,:), vsnon(i,j,:), &
+!OLI_CODE                    ticen(i,j,:,:), salin(i,j,:,:), &
+!OLI_CODE                    zvolpn(i,j,:), zvolp(i,j), &
+!OLI_CODE                    zapondn(i,j,:),zhpondn(i,j,:), zdvn)
+!OLI_CODE 
+!OLI_CODE          fwoc(i,j) = fwoc(i,j) + zdvn ! -> Goes to fresh water budget
+!OLI_CODE 
+!OLI_CODE          ! mean surface temperature
+!OLI_CODE          zTavg = z0
+!OLI_CODE          DO n = 1, jpl
+!OLI_CODE             zTavg = zTavg + zTsfcn(i,j,n)*aicen(i,j,n)
+!OLI_CODE          END DO
+!OLI_CODE          zTavg = zTavg / aice(i,j)
+!OLI_CODE 
+!OLI_CODE          DO n = 1, jpl-1
+!OLI_CODE                        
+!OLI_CODE             IF (zvuin(i,j,n) > epsi10) THEN
+!OLI_CODE 
+!OLI_CODE          !----------------------------------------------------------------
+!OLI_CODE          ! melting: floating upper ice layer melts in whole or part
+!OLI_CODE          !----------------------------------------------------------------
+!OLI_CODE !               IF (zTsfcn(i,j,n) > zTp) THEN
+!OLI_CODE                IF (zTavg > zTp) THEN
+!OLI_CODE 
+!OLI_CODE                   zdvice = min(meltt(i,j)*zapondn(i,j,n), zvuin(i,j,n))
+!OLI_CODE                   IF (zdvice > epsi10) THEN
+!OLI_CODE                      zvuin (i,j,n) = zvuin (i,j,n) - zdvice
+!OLI_CODE                      zvolpn(i,j,n) = zvolpn(i,j,n) + zdvice
+!OLI_CODE                      zvolp (i,j)   = zvolp (i,j)   + zdvice
+!OLI_CODE                      !fwoc(i,j)   = fwoc(i,j)   + zdvice
+!OLI_CODE                        
+!OLI_CODE                      IF (zvuin(i,j,n) < epsi10 .and. zvolpn(i,j,n) > puny) THEN
+!OLI_CODE                         ! ice lid melted and category is pond covered
+!OLI_CODE                         zvolpn(i,j,n) = zvolpn(i,j,n) + zvuin(i,j,n)
+!OLI_CODE                         !fwoc(i,j)   = fwoc(i,j)   + zvuin(i,j,n)
+!OLI_CODE                         zvuin(i,j,n)  = z0
+!OLI_CODE                      END IF
+!OLI_CODE                      zhpondn(i,j,n) = zvolpn(i,j,n) / zapondn(i,j,n)
+!OLI_CODE                   END IF
+!OLI_CODE 
+!OLI_CODE          !----------------------------------------------------------------
+!OLI_CODE          ! freezing: existing upper ice layer grows
+!OLI_CODE          !----------------------------------------------------------------
+!OLI_CODE                ELSE IF (zvolpn(i,j,n) > epsi10) THEN ! zTavg <= zTp
+!OLI_CODE 
+!OLI_CODE                 ! dIFferential growth of base of surface floating ice layer
+!OLI_CODE                   zdTice = max(-zTavg, z0) ! > 0
+!OLI_CODE                   zomega = rcdic*zdTice * zr1_rlfus 
+!OLI_CODE                   zdHui = sqrt(zomega*rdt_ice + z25*(zvuin(i,j,n)/  &
+!OLI_CODE                         aicen(i,j,n))**2)- z5 * zvuin(i,j,n)/aicen(i,j,n)
+!OLI_CODE 
+!OLI_CODE                   zdvice = min(zdHui*zapondn(i,j,n), zvolpn(i,j,n))   
+!OLI_CODE                   IF (zdvice > epsi10) THEN
+!OLI_CODE                      zvuin (i,j,n) = zvuin (i,j,n) + zdvice
+!OLI_CODE                      zvolpn(i,j,n) = zvolpn(i,j,n) - zdvice
+!OLI_CODE                      zvolp (i,j)   = zvolp (i,j)   - zdvice
+!OLI_CODE                      !fwoc(i,j)   = fwoc(i,j)   - zdvice
+!OLI_CODE                      zhpondn(i,j,n) = zvolpn(i,j,n) / zapondn(i,j,n)
+!OLI_CODE                   END IF
+!OLI_CODE 
+!OLI_CODE                END IF ! zTavg
+!OLI_CODE 
+!OLI_CODE          !----------------------------------------------------------------
+!OLI_CODE          ! freezing: upper ice layer begins to form
+!OLI_CODE          ! note: albedo does not change
+!OLI_CODE          !----------------------------------------------------------------
+!OLI_CODE             ELSE ! zvuin < epsi10
+!OLI_CODE                     
+!OLI_CODE                ! thickness of newly formed ice
+!OLI_CODE                ! the surface temperature of a meltpond is the same as that
+!OLI_CODE                ! of the ice underneath (0C), and the thermodynamic surface 
+!OLI_CODE                ! flux is the same
+!OLI_CODE                zdHui = max(-fsurf(i,j)*rdt_ice*zr1_rlfus, z0)
+!OLI_CODE                zdvice = min(zdHui*zapondn(i,j,n), zvolpn(i,j,n))  
+!OLI_CODE                IF (zdvice > epsi10) THEN
+!OLI_CODE                   zvuin (i,j,n) = zdvice
+!OLI_CODE                   zvolpn(i,j,n) = zvolpn(i,j,n) - zdvice
+!OLI_CODE                   zvolp (i,j)   = zvolp (i,j)   - zdvice
+!OLI_CODE                   !fwoc(i,j)   = fwoc(i,j)   - zdvice
+!OLI_CODE                   zhpondn(i,j,n)= zvolpn(i,j,n) / zapondn(i,j,n)
+!OLI_CODE                END IF
+!OLI_CODE                     
+!OLI_CODE             END IF  ! zvuin
+!OLI_CODE 
+!OLI_CODE          END DO ! jpl
+!OLI_CODE 
+!OLI_CODE       END DO ! ij
+!OLI_CODE 
+!OLI_CODE       !---------------------------------------------------------------
+!OLI_CODE       ! remove ice lid if there is no liquid pond
+!OLI_CODE       ! zvuin may be nonzero on category jpl due to dynamics
+!OLI_CODE       !---------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       DO j = 1, jpj
+!OLI_CODE       DO i = 1, jpi
+!OLI_CODE          DO n = 1, jpl
+!OLI_CODE             IF (aicen(i,j,n) > epsi10 .and. zvolpn(i,j,n) < puny &
+!OLI_CODE                                     .and. zvuin (i,j,n) > epsi10) THEN
+!OLI_CODE                kcells(n) = kcells(n) + 1
+!OLI_CODE                indxij    = kcells(n)
+!OLI_CODE                indxii(indxij,n) = i
+!OLI_CODE                indxjj(indxij,n) = j
+!OLI_CODE             END IF
+!OLI_CODE          END DO
+!OLI_CODE       END DO                     ! i
+!OLI_CODE       END DO                     ! j
+!OLI_CODE 
+!OLI_CODE       DO n = 1, jpl
+!OLI_CODE 
+!OLI_CODE          IF (kcells(n) > 0) THEN
+!OLI_CODE          DO ij = 1, kcells(n)
+!OLI_CODE             i = indxii(ij,n)
+!OLI_CODE             j = indxjj(ij,n)
+!OLI_CODE             fwoc(i,j) = fwoc(i,j) + rhoic/rauw * zvuin(i,j,n) ! Completely refrozen lid goes into ocean (to be changed)
+!OLI_CODE             zvuin(i,j,n) = z0 
+!OLI_CODE          END DO    ! ij
+!OLI_CODE          END IF
+!OLI_CODE 
+!OLI_CODE          ! reload tracers
+!OLI_CODE          DO j = 1, jpj
+!OLI_CODE             DO i = 1, jpi
+!OLI_CODE                IF (zapondn(i,j,n) > epsi10) THEN
+!OLI_CODE                   h_il(i,j,n) = zvuin(i,j,n) / zapondn(i,j,n)
+!OLI_CODE                ELSE
+!OLI_CODE                   zvuin(i,j,n) = z0
+!OLI_CODE                   h_il(i,j,n) = z0
+!OLI_CODE                END IF
+!OLI_CODE                IF (aicen(i,j,n) > epsi10) THEN
+!OLI_CODE                   a_ip_frac(i,j,n) = zapondn(i,j,n) / aicen(i,j,n) * &
+!OLI_CODE                         (1.0_wp - MAX(z0, SIGN(1.0_wp, -zvolpn(i,j,n))))
+!OLI_CODE                   h_ip(i,j,n) = zhpondn(i,j,n)
+!OLI_CODE                ELSE
+!OLI_CODE                   a_ip_frac(i,j,n) = z0
+!OLI_CODE                   h_ip(i,j,n) = z0
+!OLI_CODE                   h_il(i,j,n) = z0
+!OLI_CODE                END IF
+!OLI_CODE             END DO ! i
+!OLI_CODE          END DO    ! j
+!OLI_CODE 
+!OLI_CODE       END DO       ! n
+!OLI_CODE 
+!OLI_CODE    END SUBROUTINE compute_mp_topo
+!OLI_CODE 
+!OLI_CODE 
+!OLI_CODE    SUBROUTINE pond_area(aice,vice,rhos,             &
+!OLI_CODE                         aicen, vicen, vsnon, ticen, &
+!OLI_CODE                         salin, zvolpn, zvolp,         &
+!OLI_CODE                         zapondn,zhpondn,dvolp)
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       !!                ***  ROUTINE pond_area  ***
+!OLI_CODE       !!
+!OLI_CODE       !! ** Purpose :   Compute melt pond area, depth and melting rates
+!OLI_CODE       !!------------------------------------------------------------------
+!OLI_CODE       REAL (wp), INTENT(IN) :: &
+!OLI_CODE          aice,vice
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION(jpl), INTENT(IN) :: &
+!OLI_CODE          aicen, vicen, vsnon, rhos
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION(nlay_i,jpl), INTENT(IN) :: &
+!OLI_CODE          ticen, salin
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION(jpl), INTENT(INOUT) :: &
+!OLI_CODE          zvolpn
+!OLI_CODE 
+!OLI_CODE       REAL (wp), INTENT(INOUT) :: &
+!OLI_CODE          zvolp, dvolp
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION(jpl), INTENT(OUT) :: &
+!OLI_CODE          zapondn, zhpondn
+!OLI_CODE 
+!OLI_CODE       INTEGER :: &
+!OLI_CODE          n, ns,   &
+!OLI_CODE          m_index, &
+!OLI_CODE          permflag
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION(jpl) :: &
+!OLI_CODE          hicen, &
+!OLI_CODE          hsnon, &
+!OLI_CODE          asnon, &
+!OLI_CODE          alfan, &
+!OLI_CODE          betan, &
+!OLI_CODE          cum_max_vol, &
+!OLI_CODE          reduced_aicen        
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION(0:jpl) :: &
+!OLI_CODE          cum_max_vol_tmp
+!OLI_CODE 
+!OLI_CODE       REAL (wp) :: &
+!OLI_CODE          hpond, &
+!OLI_CODE          drain, &
+!OLI_CODE          floe_weight, &
+!OLI_CODE          pressure_head, &
+!OLI_CODE          hsl_rel, &
+!OLI_CODE          deltah, &
+!OLI_CODE          perm, &
+!OLI_CODE          apond, &
+!OLI_CODE          msno
+!OLI_CODE 
+!OLI_CODE       REAL (wp), parameter :: & 
+!OLI_CODE          viscosity = 1.79e-3_wp, &  ! kinematic water viscosity in kg/m/s
+!OLI_CODE          z0        = 0.0_wp    , &
+!OLI_CODE          c1        = 1.0_wp    , &
+!OLI_CODE          p4        = 0.4_wp    , &
+!OLI_CODE          p6        = 0.6_wp    , &
+!OLI_CODE          epsi10      = 1.0e-11_wp
+!OLI_CODE          
+!OLI_CODE      !-----------|
+!OLI_CODE      !           |
+!OLI_CODE      !           |-----------|
+!OLI_CODE      !___________|___________|______________________________________sea-level
+!OLI_CODE      !           |           |
+!OLI_CODE      !           |           |---^--------|
+!OLI_CODE      !           |           |   |        |
+!OLI_CODE      !           |           |   |        |-----------|              |-------
+!OLI_CODE      !           |           |   |alfan(n)|           |              |
+!OLI_CODE      !           |           |   |        |           |--------------|
+!OLI_CODE      !           |           |   |        |           |              |
+!OLI_CODE      !---------------------------v-------------------------------------------
+!OLI_CODE      !           |           |   ^        |           |              |
+!OLI_CODE      !           |           |   |        |           |--------------|
+!OLI_CODE      !           |           |   |betan(n)|           |              |
+!OLI_CODE      !           |           |   |        |-----------|              |-------
+!OLI_CODE      !           |           |   |        |
+!OLI_CODE      !           |           |---v------- |
+!OLI_CODE      !           |           |
+!OLI_CODE      !           |-----------|
+!OLI_CODE      !           |
+!OLI_CODE      !-----------|
+!OLI_CODE     
+!OLI_CODE       !-------------------------------------------------------------------
+!OLI_CODE       ! initialize
+!OLI_CODE       !-------------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       DO n = 1, jpl
+!OLI_CODE 
+!OLI_CODE          zapondn(n) = z0
+!OLI_CODE          zhpondn(n) = z0
+!OLI_CODE 
+!OLI_CODE          IF (aicen(n) < epsi10)  THEN
+!OLI_CODE             hicen(n) =  z0 
+!OLI_CODE             hsnon(n) = z0
+!OLI_CODE             reduced_aicen(n) = z0
+!OLI_CODE          ELSE
+!OLI_CODE             hicen(n) = vicen(n) / aicen(n)
+!OLI_CODE             hsnon(n) = vsnon(n) / aicen(n)
+!OLI_CODE             reduced_aicen(n) = c1 ! n=jpl
+!OLI_CODE             IF (n < jpl) reduced_aicen(n) = aicen(n) &
+!OLI_CODE                                  * (-0.024_wp*hicen(n) + 0.832_wp) 
+!OLI_CODE             asnon(n) = reduced_aicen(n) 
+!OLI_CODE          END IF
+!OLI_CODE 
+!OLI_CODE ! This choice for alfa and beta ignores hydrostatic equilibium of categories.
+!OLI_CODE ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming
+!OLI_CODE ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all
+!OLI_CODE ! categories.  alfa and beta partition the ITD - they are areas not thicknesses!
+!OLI_CODE ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area.
+!OLI_CODE ! Here, alfa = 60% of the ice area (and since hice is constant in a category, 
+!OLI_CODE ! alfan = 60% of the ice volume) in each category lies above the reference line, 
+!OLI_CODE ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required.
+!OLI_CODE 
+!OLI_CODE          alfan(n) = p6 * hicen(n)
+!OLI_CODE          betan(n) = p4 * hicen(n)
+!OLI_CODE        
+!OLI_CODE          cum_max_vol(n)     = z0
+!OLI_CODE          cum_max_vol_tmp(n) = z0
+!OLI_CODE     
+!OLI_CODE       END DO ! jpl
+!OLI_CODE 
+!OLI_CODE       cum_max_vol_tmp(0) = z0
+!OLI_CODE       drain = z0
+!OLI_CODE       dvolp = z0
+!OLI_CODE     
+!OLI_CODE       !--------------------------------------------------------------------------
+!OLI_CODE       ! the maximum amount of water that can be contained up to each ice category
+!OLI_CODE       !--------------------------------------------------------------------------
+!OLI_CODE     
+!OLI_CODE       DO n = 1, jpl-1 ! last category can not hold any volume
+!OLI_CODE 
+!OLI_CODE          IF (alfan(n+1) >= alfan(n) .and. alfan(n+1) > z0) THEN
+!OLI_CODE 
+!OLI_CODE             ! total volume in level including snow
+!OLI_CODE             cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1) + &
+!OLI_CODE                (alfan(n+1) - alfan(n)) * sum(reduced_aicen(1:n)) 
+!OLI_CODE 
+!OLI_CODE 
+!OLI_CODE             ! subtract snow solid volumes from lower categories in current level
+!OLI_CODE             DO ns = 1, n 
+!OLI_CODE                cum_max_vol_tmp(n) = cum_max_vol_tmp(n) &
+!OLI_CODE                   - rhos(ns)/rauw  * &    ! fraction of snow that is occupied by solid ??rauw
+!OLI_CODE                     asnon(ns)  * &    ! area of snow from that category
+!OLI_CODE                     max(min(hsnon(ns)+alfan(ns)-alfan(n), alfan(n+1)- &
+!OLI_CODE                                   alfan(n)), z0)  
+!OLI_CODE                                       ! thickness of snow from ns layer in n layer
+!OLI_CODE             END DO
+!OLI_CODE 
+!OLI_CODE          ELSE ! assume higher categories unoccupied
+!OLI_CODE             cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1)
+!OLI_CODE          END IF
+!OLI_CODE          !IF (cum_max_vol_tmp(n) < z0) THEN
+!OLI_CODE          !   call abort_ice('negative melt pond volume')
+!OLI_CODE          !END IF
+!OLI_CODE       END DO
+!OLI_CODE       cum_max_vol_tmp(jpl) = cum_max_vol_tmp(jpl-1)  ! last category holds no volume
+!OLI_CODE       cum_max_vol  (1:jpl) = cum_max_vol_tmp(1:jpl)
+!OLI_CODE     
+!OLI_CODE       !----------------------------------------------------------------
+!OLI_CODE       ! is there more meltwater than can be held in the floe?
+!OLI_CODE       !----------------------------------------------------------------
+!OLI_CODE       IF (zvolp >= cum_max_vol(jpl)) THEN
+!OLI_CODE          drain = zvolp - cum_max_vol(jpl) + epsi10
+!OLI_CODE          zvolp = zvolp - drain
+!OLI_CODE          dvolp = drain
+!OLI_CODE          IF (zvolp < epsi10) THEN
+!OLI_CODE             dvolp = dvolp + zvolp
+!OLI_CODE             zvolp = z0
+!OLI_CODE          END IF
+!OLI_CODE       END IF
+!OLI_CODE     
+!OLI_CODE       ! height and area corresponding to the remaining volume
+!OLI_CODE 
+!OLI_CODE       call calc_hpond(reduced_aicen, asnon, hsnon, rhos, alfan, &
+!OLI_CODE            zvolp, cum_max_vol, hpond, m_index)
+!OLI_CODE     
+!OLI_CODE       DO n=1, m_index
+!OLI_CODE          zhpondn(n) = hpond - alfan(n) + alfan(1)
+!OLI_CODE          zapondn(n) = reduced_aicen(n) 
+!OLI_CODE       END DO
+!OLI_CODE       apond = sum(zapondn(1:m_index))
+!OLI_CODE     
+!OLI_CODE       !------------------------------------------------------------------------
+!OLI_CODE       ! drainage due to ice permeability - Darcy's law
+!OLI_CODE       !------------------------------------------------------------------------
+!OLI_CODE     
+!OLI_CODE       ! sea water level 
+!OLI_CODE       msno = z0
+!OLI_CODE       DO n=1,jpl
+!OLI_CODE         msno = msno + vsnon(n) * rhos(n)
+!OLI_CODE       END DO
+!OLI_CODE       floe_weight = (msno + rhoic*vice + rau0*zvolp) / aice
+!OLI_CODE       hsl_rel = floe_weight / rau0 &
+!OLI_CODE               - ((sum(betan(:)*aicen(:))/aice) + alfan(1))
+!OLI_CODE     
+!OLI_CODE       deltah = hpond - hsl_rel
+!OLI_CODE       pressure_head = grav * rau0 * max(deltah, z0)
+!OLI_CODE 
+!OLI_CODE       ! drain IF ice is permeable    
+!OLI_CODE       permflag = 0
+!OLI_CODE       IF (pressure_head > z0) THEN
+!OLI_CODE       DO n = 1, jpl-1
+!OLI_CODE          IF (hicen(n) /= z0) THEN
+!OLI_CODE             CALL permeability_phi(ticen(:,n), salin(:,n), vicen(n), perm)
+!OLI_CODE             IF (perm > z0) permflag = 1
+!OLI_CODE             drain = perm*zapondn(n)*pressure_head*rdt_ice / &
+!OLI_CODE                                      (viscosity*hicen(n))
+!OLI_CODE             dvolp = dvolp + min(drain, zvolp)
+!OLI_CODE             zvolp = max(zvolp - drain, z0)
+!OLI_CODE             IF (zvolp < epsi10) THEN
+!OLI_CODE                dvolp = dvolp + zvolp
+!OLI_CODE                zvolp = z0
+!OLI_CODE             END IF
+!OLI_CODE          END IF
+!OLI_CODE       END DO
+!OLI_CODE  
+!OLI_CODE       ! adjust melt pond DIMENSIONs
+!OLI_CODE       IF (permflag > 0) THEN
+!OLI_CODE          ! recompute pond depth    
+!OLI_CODE          CALL calc_hpond(reduced_aicen, asnon, hsnon, rhos, alfan, &
+!OLI_CODE                          zvolp, cum_max_vol, hpond, m_index)
+!OLI_CODE          DO n=1, m_index
+!OLI_CODE             zhpondn(n) = hpond - alfan(n) + alfan(1)
+!OLI_CODE             zapondn(n) = reduced_aicen(n) 
+!OLI_CODE          END DO
+!OLI_CODE          apond = sum(zapondn(1:m_index))
+!OLI_CODE       END IF
+!OLI_CODE       END IF ! pressure_head
+!OLI_CODE 
+!OLI_CODE       !------------------------------------------------------------------------
+!OLI_CODE       ! total melt pond volume in category DOes not include snow volume
+!OLI_CODE       ! snow in melt ponds is not melted
+!OLI_CODE       !------------------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       ! Calculate pond volume for lower categories
+!OLI_CODE       DO n=1,m_index-1
+!OLI_CODE          zvolpn(n) = zapondn(n) * zhpondn(n) &
+!OLI_CODE                   - (rhos(n)/rauw) * asnon(n) * min(hsnon(n), zhpondn(n))! 
+!OLI_CODE       END DO
+!OLI_CODE 
+!OLI_CODE       ! Calculate pond volume for highest category = remaining pond volume
+!OLI_CODE       IF (m_index == 1) zvolpn(m_index) = zvolp
+!OLI_CODE       IF (m_index > 1) THEN
+!OLI_CODE         IF (zvolp > sum(zvolpn(1:m_index-1))) THEN
+!OLI_CODE           zvolpn(m_index) = zvolp - sum(zvolpn(1:m_index-1))
+!OLI_CODE         ELSE
+!OLI_CODE           zvolpn(m_index) = z0
+!OLI_CODE           zhpondn(m_index) = z0
+!OLI_CODE           zapondn(m_index) = z0
+!OLI_CODE           ! If remaining pond volume is negative reduce pond volume of 
+!OLI_CODE           ! lower category
+!OLI_CODE           IF (zvolp+epsi10 < sum(zvolpn(1:m_index-1))) & 
+!OLI_CODE             zvolpn(m_index-1) = zvolpn(m_index-1)-sum(zvolpn(1:m_index-1))&
+!OLI_CODE                                + zvolp
+!OLI_CODE         END IF
+!OLI_CODE       END IF
+!OLI_CODE 
+!OLI_CODE       DO n=1,m_index
+!OLI_CODE          IF (zapondn(n) > epsi10) THEN
+!OLI_CODE              zhpondn(n) = zvolpn(n) / zapondn(n)
+!OLI_CODE          ELSE
+!OLI_CODE             dvolp = dvolp + zvolpn(n)
+!OLI_CODE             zhpondn(n) = z0
+!OLI_CODE             zvolpn(n) = z0
+!OLI_CODE             zapondn(n) = z0
+!OLI_CODE          end IF
+!OLI_CODE       END DO
+!OLI_CODE       DO n = m_index+1, jpl
+!OLI_CODE          zhpondn(n) = z0
+!OLI_CODE          zapondn(n) = z0
+!OLI_CODE          zvolpn (n) = z0
+!OLI_CODE       END DO
+!OLI_CODE 
+!OLI_CODE    END SUBROUTINE pond_area
+!OLI_CODE   
+!OLI_CODE 
+!OLI_CODE    SUBROUTINE calc_hpond(aicen, asnon, hsnon, rhos, alfan, &
+!OLI_CODE                          zvolp, cum_max_vol,                &
+!OLI_CODE                          hpond, m_index)
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       !!                ***  ROUTINE calc_hpond  ***
+!OLI_CODE       !!
+!OLI_CODE       !! ** Purpose :   Compute melt pond depth
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE     
+!OLI_CODE       REAL (wp), DIMENSION(jpl), INTENT(IN) :: &
+!OLI_CODE          aicen, &
+!OLI_CODE          asnon, &
+!OLI_CODE          hsnon, &
+!OLI_CODE          rhos,  &
+!OLI_CODE          alfan, &
+!OLI_CODE          cum_max_vol
+!OLI_CODE     
+!OLI_CODE       REAL (wp), INTENT(IN) :: &
+!OLI_CODE          zvolp
+!OLI_CODE     
+!OLI_CODE       REAL (wp), INTENT(OUT) :: &
+!OLI_CODE          hpond
+!OLI_CODE     
+!OLI_CODE       INTEGER, INTENT(OUT) :: &
+!OLI_CODE          m_index
+!OLI_CODE     
+!OLI_CODE       INTEGER :: n, ns
+!OLI_CODE     
+!OLI_CODE       REAL (wp), DIMENSION(0:jpl+1) :: &
+!OLI_CODE          hitl, &
+!OLI_CODE          aicetl
+!OLI_CODE     
+!OLI_CODE       REAL (wp) :: &
+!OLI_CODE          rem_vol, &
+!OLI_CODE          area, &
+!OLI_CODE          vol, &
+!OLI_CODE          tmp, &
+!OLI_CODE          z0   = 0.0_wp,    &   
+!OLI_CODE          epsi10 = 1.0e-11_wp
+!OLI_CODE     
+!OLI_CODE       !----------------------------------------------------------------
+!OLI_CODE       ! hpond is zero if zvolp is zero - have we fully drained? 
+!OLI_CODE       !----------------------------------------------------------------
+!OLI_CODE     
+!OLI_CODE       IF (zvolp < epsi10) THEN
+!OLI_CODE        hpond = z0
+!OLI_CODE        m_index = 0
+!OLI_CODE       ELSE
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! Calculate the category where water fills up to 
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        !----------|
+!OLI_CODE        !          |
+!OLI_CODE        !          |
+!OLI_CODE        !          |----------|                                     -- --
+!OLI_CODE        !__________|__________|_________________________________________ ^
+!OLI_CODE        !          |          |             rem_vol     ^                | Semi-filled
+!OLI_CODE        !          |          |----------|-- -- -- - ---|-- ---- -- -- --v layer
+!OLI_CODE        !          |          |          |              |
+!OLI_CODE        !          |          |          |              |hpond
+!OLI_CODE        !          |          |          |----------|   |     |-------
+!OLI_CODE        !          |          |          |          |   |     |
+!OLI_CODE        !          |          |          |          |---v-----|
+!OLI_CODE        !          |          | m_index  |          |         |
+!OLI_CODE        !-------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        m_index = 0  ! 1:m_index categories have water in them
+!OLI_CODE        DO n = 1, jpl
+!OLI_CODE           IF (zvolp <= cum_max_vol(n)) THEN
+!OLI_CODE              m_index = n
+!OLI_CODE              IF (n == 1) THEN
+!OLI_CODE                 rem_vol = zvolp
+!OLI_CODE              ELSE
+!OLI_CODE                 rem_vol = zvolp - cum_max_vol(n-1)
+!OLI_CODE              END IF
+!OLI_CODE              exit ! to break out of the loop
+!OLI_CODE           END IF
+!OLI_CODE        END DO
+!OLI_CODE        m_index = min(jpl-1, m_index)
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! semi-filled layer may have m_index different snow in it
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        !-----------------------------------------------------------  ^
+!OLI_CODE        !                                                             |  alfan(m_index+1)
+!OLI_CODE        !                                                             |
+!OLI_CODE        !hitl(3)-->                             |----------|          |
+!OLI_CODE        !hitl(2)-->                |------------| * * * * *|          |
+!OLI_CODE        !hitl(1)-->     |----------|* * * * * * |* * * * * |          |
+!OLI_CODE        !hitl(0)-->-------------------------------------------------  |  ^
+!OLI_CODE        !                various snow from lower categories          |  |alfa(m_index)
+!OLI_CODE        
+!OLI_CODE        ! hitl - heights of the snow layers from thinner and current categories
+!OLI_CODE        ! aicetl - area of each snow depth in this layer
+!OLI_CODE        
+!OLI_CODE        hitl(:) = z0
+!OLI_CODE        aicetl(:) = z0
+!OLI_CODE        DO n = 1, m_index
+!OLI_CODE           hitl(n)   = max(min(hsnon(n) + alfan(n) - alfan(m_index), &
+!OLI_CODE                                  alfan(m_index+1) - alfan(m_index)), z0)
+!OLI_CODE           aicetl(n) = asnon(n)
+!OLI_CODE           
+!OLI_CODE           aicetl(0) = aicetl(0) + (aicen(n) - asnon(n))
+!OLI_CODE        END DO
+!OLI_CODE        hitl(m_index+1) = alfan(m_index+1) - alfan(m_index)
+!OLI_CODE        aicetl(m_index+1) = z0
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! reorder array according to hitl 
+!OLI_CODE        ! snow heights not necessarily in height order
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        DO ns = 1, m_index+1
+!OLI_CODE           DO n = 0, m_index - ns + 1
+!OLI_CODE              IF (hitl(n) > hitl(n+1)) THEN ! swap order
+!OLI_CODE                 tmp = hitl(n)
+!OLI_CODE                 hitl(n) = hitl(n+1)
+!OLI_CODE                 hitl(n+1) = tmp
+!OLI_CODE                 tmp = aicetl(n)
+!OLI_CODE                 aicetl(n) = aicetl(n+1)
+!OLI_CODE                 aicetl(n+1) = tmp
+!OLI_CODE              END IF
+!OLI_CODE           END DO
+!OLI_CODE        END DO
+!OLI_CODE        
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        ! divide semi-filled layer into set of sublayers each vertically homogenous
+!OLI_CODE        !----------------------------------------------------------------
+!OLI_CODE        
+!OLI_CODE        !hitl(3)----------------------------------------------------------------
+!OLI_CODE        !                                                       | * * * * * * * *  
+!OLI_CODE        !                                                       |* * * * * * * * * 
+!OLI_CODE        !hitl(2)----------------------------------------------------------------
+!OLI_CODE        !                                    | * * * * * * * *  | * * * * * * * *  
+!OLI_CODE        !                                    |* * * * * * * * * |* * * * * * * * * 
+!OLI_CODE        !hitl(1)----------------------------------------------------------------
+!OLI_CODE        !                 | * * * * * * * *  | * * * * * * * *  | * * * * * * * *  
+!OLI_CODE        !                 |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * 
+!OLI_CODE        !hitl(0)----------------------------------------------------------------
+!OLI_CODE        !    aicetl(0)         aicetl(1)           aicetl(2)          aicetl(3)            
+!OLI_CODE        
+!OLI_CODE        ! move up over layers incrementing volume
+!OLI_CODE        DO n = 1, m_index+1
+!OLI_CODE           
+!OLI_CODE           area = sum(aicetl(:)) - &                 ! total area of sub-layer
+!OLI_CODE                (rhos(n)/rau0) * sum(aicetl(n:jpl+1)) ! area of sub-layer occupied by snow
+!OLI_CODE           
+!OLI_CODE           vol = (hitl(n) - hitl(n-1)) * area      ! thickness of sub-layer times area
+!OLI_CODE           
+!OLI_CODE           IF (vol >= rem_vol) THEN  ! have reached the sub-layer with the depth within
+!OLI_CODE              hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - &
+!OLI_CODE                           alfan(1)
+!OLI_CODE              exit
+!OLI_CODE           ELSE  ! still in sub-layer below the sub-layer with the depth
+!OLI_CODE              rem_vol = rem_vol - vol
+!OLI_CODE           END IF
+!OLI_CODE           
+!OLI_CODE        END DO
+!OLI_CODE        
+!OLI_CODE       END IF
+!OLI_CODE     
+!OLI_CODE    END SUBROUTINE calc_hpond
+!OLI_CODE   
+!OLI_CODE 
+!OLI_CODE    SUBROUTINE permeability_phi(ticen, salin, vicen, perm)
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       !!                ***  ROUTINE permeability_phi  ***
+!OLI_CODE       !!
+!OLI_CODE       !! ** Purpose :   Determine the liquid fraction of brine in the ice
+!OLI_CODE       !!                and its permeability
+!OLI_CODE       !!-------------------------------------------------------------------
+!OLI_CODE       REAL (wp), DIMENSION(nlay_i), INTENT(IN) :: &
+!OLI_CODE          ticen,  & ! energy of melting for each ice layer (J/m2)
+!OLI_CODE          salin
+!OLI_CODE 
+!OLI_CODE       REAL (wp), INTENT(IN) :: &
+!OLI_CODE          vicen     ! ice volume
+!OLI_CODE     
+!OLI_CODE       REAL (wp), INTENT(OUT) :: &
+!OLI_CODE          perm      ! permeability
+!OLI_CODE 
+!OLI_CODE       REAL (wp) ::   &
+!OLI_CODE          Sbr        ! brine salinity
+!OLI_CODE 
+!OLI_CODE       REAL (wp), DIMENSION(nlay_i) ::   &
+!OLI_CODE          Tin, &    ! ice temperature
+!OLI_CODE          phi       ! liquid fraction
+!OLI_CODE 
+!OLI_CODE       INTEGER :: k
+!OLI_CODE     
+!OLI_CODE       REAL (wp) :: &
+!OLI_CODE          c2    = 2.0_wp
+!OLI_CODE  
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE       ! Compute ice temperatures from enthalpies using quadratic formula
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       DO k = 1,nlay_i
+!OLI_CODE          Tin(k) = ticen(k) 
+!OLI_CODE       END DO
+!OLI_CODE 
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE       ! brine salinity and liquid fraction
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       IF (maxval(Tin-rtt) <= -c2) THEN
+!OLI_CODE 
+!OLI_CODE          DO k = 1,nlay_i
+!OLI_CODE             Sbr = - 1.2_wp                 &
+!OLI_CODE                   -21.8_wp     * (Tin(k)-rtt)    &
+!OLI_CODE                   - 0.919_wp   * (Tin(k)-rtt)**2 &
+!OLI_CODE                   - 0.01878_wp * (Tin(k)-rtt)**3
+!OLI_CODE             phi(k) = salin(k)/Sbr ! liquid fraction
+!OLI_CODE          END DO ! k
+!OLI_CODE        
+!OLI_CODE       ELSE
+!OLI_CODE 
+!OLI_CODE          DO k = 1,nlay_i
+!OLI_CODE             Sbr = -17.6_wp    * (Tin(k)-rtt)    &
+!OLI_CODE                   - 0.389_wp  * (Tin(k)-rtt)**2 &
+!OLI_CODE                   - 0.00362_wp* (Tin(k)-rtt)**3
+!OLI_CODE             phi(k) = salin(k)/Sbr ! liquid fraction
+!OLI_CODE          END DO
+!OLI_CODE 
+!OLI_CODE       END IF
+!OLI_CODE     
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE       ! permeability
+!OLI_CODE       !-----------------------------------------------------------------
+!OLI_CODE 
+!OLI_CODE       perm = 3.0e-08_wp * (minval(phi))**3
+!OLI_CODE     
+!OLI_CODE    END SUBROUTINE permeability_phi
+!OLI_CODE   
+!OLI_CODE #else
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE    !!   Default option         Dummy Module          No LIM-3 sea-ice model
+!OLI_CODE    !!----------------------------------------------------------------------
+!OLI_CODE CONTAINS
+!OLI_CODE    SUBROUTINE lim_mp_init          ! Empty routine
+!OLI_CODE    END SUBROUTINE lim_mp_init   
+!OLI_CODE    SUBROUTINE lim_mp               ! Empty routine
+!OLI_CODE    END SUBROUTINE lim_mp
+!OLI_CODE    SUBROUTINE compute_mp_topo      ! Empty routine
+!OLI_CODE    END SUBROUTINE compute_mp_topo        
+!OLI_CODE    SUBROUTINE pond_area            ! Empty routine
+!OLI_CODE    END SUBROUTINE pond_area   
+!OLI_CODE    SUBROUTINE calc_hpond           ! Empty routine
+!OLI_CODE    END SUBROUTINE calc_hpond   
+!OLI_CODE    SUBROUTINE permeability_phy     ! Empty routine
+!OLI_CODE    END SUBROUTINE permeability_phy   
+!OLI_CODE #endif
+!OLI_CODE    !!======================================================================
+!OLI_CODE END MODULE limmp_topo
+!OLI_CODE 
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Empty module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_mp_init     ! Empty routine
+   END SUBROUTINE lim_mp_init
+   SUBROUTINE lim_mp          ! Empty routine
+   END SUBROUTINE lim_mp     
+   SUBROUTINE lim_mp_topo     ! Empty routine
+   END SUBROUTINE lim_mp_topo
+   SUBROUTINE lim_mp_cesm     ! Empty routine
+   END SUBROUTINE lim_mp_cesm
+   SUBROUTINE lim_mp_area     ! Empty routine
+   END SUBROUTINE lim_mp_area
+   SUBROUTINE lim_mp_perm     ! Empty routine
+   END SUBROUTINE lim_mp_perm
+#endif 
+
+   !!======================================================================
+END MODULE limmp 
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 8568)
+++ 	(revision )
@@ -1,719 +1,0 @@
-MODULE limrhg
-   !!======================================================================
-   !!                     ***  MODULE  limrhg  ***
-   !!   Ice rheology : sea ice rheology
-   !!======================================================================
-   !! History :   -   !  2007-03  (M.A. Morales Maqueda, S. Bouillon) Original code
-   !!            3.0  !  2008-03  (M. Vancoppenolle) LIM3
-   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy 
-   !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas
-   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation 
-   !!            3.5  !  2012-08  (R. Benshila)  AGRIF
-   !!            3.6  !  2016-06  (C. Rousset) Rewriting + landfast ice + possibility to use mEVP (Bouillon 2013)
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_rhg       : computes ice velocities
-   !!----------------------------------------------------------------------
-   USE phycst         ! Physical constant
-   USE oce     , ONLY :  snwice_mass, snwice_mass_b
-   USE par_oce        ! Ocean parameters
-   USE dom_oce        ! Ocean domain
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbc_ice        ! Surface boundary condition: ice fields
-   USE ice            ! ice variables
-   USE limitd_me      ! ice strength
-   USE lbclnk         ! Lateral Boundary Condition / MPP link
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-#if defined key_agrif
-   USE agrif_lim3_interp
-#endif
-   USE bdy_oce   , ONLY: ln_bdy 
-   USE bdyice_lim 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_rhg        ! routine called by lim_dyn
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_rhg
-      !!-------------------------------------------------------------------
-      !!                 ***  SUBROUTINE lim_rhg  ***
-      !!                          EVP-C-grid
-      !!
-      !! ** purpose : determines sea ice drift from wind stress, ice-ocean
-      !!  stress and sea-surface slope. Ice-ice interaction is described by 
-      !!  a non-linear elasto-viscous-plastic (EVP) law including shear 
-      !!  strength and a bulk rheology (Hunke and Dukowicz, 2002).	
-      !!
-      !!  The points in the C-grid look like this, dear reader
-      !!
-      !!                              (ji,jj)
-      !!                                 |
-      !!                                 |
-      !!                      (ji-1,jj)  |  (ji,jj)
-      !!                             ---------   
-      !!                            |         |
-      !!                            | (ji,jj) |------(ji,jj)
-      !!                            |         |
-      !!                             ---------   
-      !!                     (ji-1,jj-1)     (ji,jj-1)
-      !!
-      !! ** Inputs  : - wind forcing (stress), oceanic currents
-      !!                ice total volume (vt_i) per unit area
-      !!                snow total volume (vt_s) per unit area
-      !!
-      !! ** Action  : - compute u_ice, v_ice : the components of the 
-      !!                sea-ice velocity vector
-      !!              - compute delta_i, shear_i, divu_i, which are inputs
-      !!                of the ice thickness distribution
-      !!
-      !! ** Steps   : 1) Compute ice snow mass, ice strength 
-      !!              2) Compute wind, oceanic stresses, mass terms and
-      !!                 coriolis terms of the momentum equation
-      !!              3) Solve the momentum equation (iterative procedure)
-      !!              4) Prevent high velocities if the ice is thin
-      !!              5) Recompute invariants of the strain rate tensor
-      !!                 which are inputs of the ITD, store stress
-      !!                 for the next time step
-      !!              6) Control prints of residual (convergence)
-      !!                 and charge ellipse.
-      !!                 The user should make sure that the parameters
-      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state
-      !!                 on the charge ellipse for plastic flow
-      !!                 e.g. in the Canadian Archipelago
-      !!
-      !! ** Notes   : There is the possibility to use mEVP from Bouillon 2013
-      !!              (by uncommenting some lines in part 3 and changing alpha and beta parameters)
-      !!              but this solution appears very unstable (see Kimmritz et al 2016)
-      !!
-      !! References : Hunke and Dukowicz, JPO97
-      !!              Bouillon et al., Ocean Modelling 2009
-      !!              Bouillon et al., Ocean Modelling 2013
-      !!-------------------------------------------------------------------
-      INTEGER ::   ji, jj       ! dummy loop indices
-      INTEGER ::   jter         ! local integers
-      CHARACTER (len=50) ::   charout
-
-      REAL(wp) ::   zrhoco                                                   ! rau0 * rn_cio
-      REAL(wp) ::   zdtevp, z1_dtevp                                         ! time step for subcycling
-      REAL(wp) ::   ecc2, z1_ecc2                                            ! square of yield ellipse eccenticity
-      REAL(wp) ::   zbeta, zalph1, z1_alph1, zalph2, z1_alph2                ! alpha and beta from Bouillon 2009 and 2013
-      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV                            ! ice/snow mass
-      REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2            ! temporary scalars
-      REAL(wp) ::   zTauO, zTauB, zTauE, zCor, zvel                          ! temporary scalars
-
-      REAL(wp) ::   zsig1, zsig2                                             ! internal ice stress
-      REAL(wp) ::   zresm                                                    ! Maximal error on ice velocity
-      REAL(wp) ::   zintb, zintn                                             ! dummy argument
-      
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_e1t0, z1_e2t0                ! scale factors
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zp_delt                         ! P/delta at T points
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zaU   , zaV                     ! ice fraction on U/V points
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmU_t, zmV_t                    ! ice/snow mass/dt on U/V points
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmf                             ! coriolis parameter at T points
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points
-      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                           
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zfU   , zfV                     ! internal stresses
-      
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zds                             ! shear
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zs1, zs2, zs12                  ! stress tensor components
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr           ! check convergence
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zpice                           ! array used for the calculation of ice surface slope:
-                                                                             !   ocean surface (ssh_m) if ice is not embedded
-                                                                             !   ice top surface if ice is embedded   
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zswitchU, zswitchV              ! dummy arrays
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmaskU, zmaskV                  ! mask for ice presence
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zfmask, zwf                     ! mask at F points for the ice
-
-      REAL(wp), PARAMETER               ::   zepsi  = 1.0e-20_wp             ! tolerance parameter
-      REAL(wp), PARAMETER               ::   zmmin  = 1._wp                  ! ice mass (kg/m2) below which ice velocity equals ocean velocity
-      REAL(wp), PARAMETER               ::   zshlat = 2._wp                  ! boundary condition for sea-ice velocity (2=no slip ; 0=free slip)
-      !!-------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )
-      CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )
-      CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )
-      CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )
-      CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )
-
-#if defined key_agrif 
-      CALL agrif_interp_lim3( 'U', 0, nn_nevp )   ! First interpolation of coarse values
-      CALL agrif_interp_lim3( 'V', 0, nn_nevp )
-#endif
-      !
-      !------------------------------------------------------------------------------!
-      ! 0) mask at F points for the ice
-      !------------------------------------------------------------------------------!
-      ! ocean/land mask
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1      ! NO vector opt.
-            zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
-         END DO
-      END DO
-      CALL lbc_lnk( zfmask, 'F', 1._wp )
-
-      ! Lateral boundary conditions on velocity (modify zfmask)
-      zwf(:,:) = zfmask(:,:)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            IF( zfmask(ji,jj) == 0._wp ) THEN
-               zfmask(ji,jj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) )
-            ENDIF
-         END DO
-      END DO
-      DO jj = 2, jpjm1
-         IF( zfmask(1,jj) == 0._wp ) THEN
-            zfmask(1  ,jj) = zshlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
-         ENDIF
-         IF( zfmask(jpi,jj) == 0._wp ) THEN
-            zfmask(jpi,jj) = zshlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
-         ENDIF
-      END DO
-      DO ji = 2, jpim1
-         IF( zfmask(ji,1) == 0._wp ) THEN
-            zfmask(ji,1  ) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
-         ENDIF
-         IF( zfmask(ji,jpj) == 0._wp ) THEN
-            zfmask(ji,jpj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
-         ENDIF
-      END DO
-      CALL lbc_lnk( zfmask, 'F', 1._wp )
-
-      !------------------------------------------------------------------------------!
-      ! 1) define some variables and initialize arrays
-      !------------------------------------------------------------------------------!
-      zrhoco = rau0 * rn_cio 
-
-      ! ecc2: square of yield ellipse eccenticrity
-      ecc2    = rn_ecc * rn_ecc
-      z1_ecc2 = 1._wp / ecc2
-
-      ! Time step for subcycling
-      zdtevp   = rdt_ice / REAL( nn_nevp )
-      z1_dtevp = 1._wp / zdtevp
-
-      ! alpha parameters (Bouillon 2009)
-      zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp
-      zalph2 = zalph1 * z1_ecc2
-
-      ! alpha and beta parameters (Bouillon 2013)
-      !!zalph1 = 40.
-      !!zalph2 = 40.
-      !!zbeta  = 3000.
-      !!zbeta = REAL( nn_nevp )   ! close to classical EVP of Hunke (2001)
-
-      z1_alph1 = 1._wp / ( zalph1 + 1._wp )
-      z1_alph2 = 1._wp / ( zalph2 + 1._wp )
-
-      ! Initialise stress tensor 
-      zs1 (:,:) = stress1_i (:,:) 
-      zs2 (:,:) = stress2_i (:,:)
-      zs12(:,:) = stress12_i(:,:)
-
-      ! Ice strength
-      CALL lim_itd_me_icestrength( nn_icestr )
-
-      ! scale factors
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj  ) + e1t(ji,jj  ) )
-            z1_e2t0(ji,jj) = 1._wp / ( e2t(ji  ,jj+1) + e2t(ji,jj  ) )
-         END DO
-      END DO
-            
-      !
-      !------------------------------------------------------------------------------!
-      ! 2) Wind / ocean stress, mass terms, coriolis terms
-      !------------------------------------------------------------------------------!
-
-      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
-         !                                            
-         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
-         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
-         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp     
-         !
-         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
-         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
-         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
-         !
-         zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0
-         !
-      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
-         zpice(:,:) = ssh_m(:,:)
-      ENDIF
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-
-            ! ice fraction at U-V points
-            zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-            zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-
-            ! Ice/snow mass at U-V points
-            zm1 = ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
-            zm2 = ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
-            zm3 = ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
-            zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
-            zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
-
-            ! Ocean currents at U-V points
-            v_oceU(ji,jj)   = 0.5_wp * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji+1,jj)    &
-               &                       + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)
-            
-            u_oceV(ji,jj)   = 0.5_wp * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj+1)    &
-               &                       + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)
-
-            ! Coriolis at T points (m*f)
-            zmf(ji,jj)      = zm1 * ff_t(ji,jj)
-
-            ! m/dt
-            zmU_t(ji,jj)    = zmassU * z1_dtevp
-            zmV_t(ji,jj)    = zmassV * z1_dtevp
-
-            ! Drag ice-atm.
-            zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
-            zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
-
-            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
-            zspgU(ji,jj)    = - zmassU * grav * ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
-            zspgV(ji,jj)    = - zmassV * grav * ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
-
-            ! masks
-            zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
-            zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
-
-            ! switches
-            zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin
-            zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin
-
-         END DO
-      END DO
-      CALL lbc_lnk( zmf, 'T', 1. )
-      !
-      !------------------------------------------------------------------------------!
-      ! 3) Solution of the momentum equation, iterative procedure
-      !------------------------------------------------------------------------------!
-      !
-      !                                               !----------------------!
-      DO jter = 1 , nn_nevp                           !    loop over jter    !
-         !                                            !----------------------!        
-         IF(ln_ctl) THEN   ! Convergence test
-            DO jj = 1, jpjm1
-               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step
-               zv_ice(:,jj) = v_ice(:,jj)
-            END DO
-         ENDIF
-
-         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
-         DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points
-            DO ji = 1, jpim1
-
-               ! shear at F points
-               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
-                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
-                  &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
-
-            END DO
-         END DO
-         CALL lbc_lnk( zds, 'F', 1. )
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1 ! no vector loop
-
-               ! shear**2 at T points (doc eq. A16)
-               zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
-                  &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
-                  &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-              
-               ! divergence at T points
-               zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-                  &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
-                  &    ) * r1_e1e2t(ji,jj)
-               zdiv2 = zdiv * zdiv
-               
-               ! tension at T points
-               zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
-                  &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
-                  &   ) * r1_e1e2t(ji,jj)
-               zdt2 = zdt * zdt
-               
-               ! delta at T points
-               zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
-
-               ! P/delta at T points
-               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl )
-               
-               ! stress at T points
-               zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv - zdelta ) ) * z1_alph1
-               zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 ) ) * z1_alph2
-             
-            END DO
-         END DO
-         CALL lbc_lnk( zp_delt, 'T', 1. )
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-
-               ! P/delta at F points
-               zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
-               
-               ! stress at F points
-               zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 ) * 0.5_wp ) * z1_alph2
-
-            END DO
-         END DO
-         CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
- 
-
-         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1               
-
-               ! U points
-               zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
-                  &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
-                  &                    ) * r1_e2u(ji,jj)                                                                      &
-                  &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
-                  &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
-                  &                  ) * r1_e1e2u(ji,jj)
-
-               ! V points
-               zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
-                  &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
-                  &                    ) * r1_e1v(ji,jj)                                                                      &
-                  &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
-                  &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
-                  &                  ) * r1_e1e2v(ji,jj)
-
-               ! u_ice at V point
-               u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
-                  &                     + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)
-               
-               ! v_ice at U point
-               v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     &
-                  &                     + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)
-
-            END DO
-         END DO
-         !
-         ! --- Computation of ice velocity --- !
-         !  Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta are chosen wisely and large nn_nevp
-         !  Bouillon et al. 2009 (eq 34-35) => stable
-         IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations
-            
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-
-                  ! tau_io/(v_oce - v_ice)
-                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
-                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
-
-                  ! tau_bottom/v_ice
-                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) )
-                  zTauB = - tau_icebfr(ji,jj) / zvel
-
-                  ! Coriolis at V-points (energy conserving formulation)
-                  zCor  = - 0.25_wp * r1_e2v(ji,jj) *  &
-                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
-                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
-
-                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
-
-                  ! landfast switch => 0 = static friction ; 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
-                  
-                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
-                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                   &  ! previous velocity
-                     &                                     + zTauE + zTauO * v_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
-                     &             + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
-                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin
-                     &           ) * zmaskV(ji,jj)
-                  ! Bouillon 2013
-                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  &
-                  !!   &           + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  &
-                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj)
-
-               END DO
-            END DO
-            CALL lbc_lnk( v_ice, 'V', -1. )
-            
-#if defined key_agrif
-!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp )
-            CALL agrif_interp_lim3( 'V' )
-#endif
-            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' )
-
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                               
-                  ! tau_io/(u_oce - u_ice)
-                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
-                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
-
-                  ! tau_bottom/u_ice
-                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) )
-                  zTauB = - tau_icebfr(ji,jj) / zvel
-
-                  ! Coriolis at U-points (energy conserving formulation)
-                  zCor  =   0.25_wp * r1_e1u(ji,jj) *  &
-                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
-                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
-                  
-                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
-
-                  ! landfast switch => 0 = static friction ; 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
-
-                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
-                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                   &  ! previous velocity
-                     &                                     + zTauE + zTauO * u_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
-                     &             + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
-                     &             ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin 
-                     &           ) * zmaskU(ji,jj)
-                  ! Bouillon 2013
-                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  &
-                  !!   &           + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  &
-                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj)
-               END DO
-            END DO
-            CALL lbc_lnk( u_ice, 'U', -1. )
-            
-#if defined key_agrif
-!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp )
-            CALL agrif_interp_lim3( 'U' )
-#endif
-            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' )
-
-         ELSE ! odd iterations
-
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-
-                  ! tau_io/(u_oce - u_ice)
-                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
-                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
-
-                  ! tau_bottom/u_ice
-                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) )
-                  zTauB = - tau_icebfr(ji,jj) / zvel
-
-                  ! Coriolis at U-points (energy conserving formulation)
-                  zCor  =   0.25_wp * r1_e1u(ji,jj) *  &
-                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
-                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
-
-                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
-
-                  ! landfast switch => 0 = static friction ; 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
-
-                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
-                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                   &  ! previous velocity
-                     &                                     + zTauE + zTauO * u_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
-                     &             + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
-                     &             ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin
-                     &           ) * zmaskU(ji,jj)
-                  ! Bouillon 2013
-                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  &
-                  !!   &           + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  &
-                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj)
-               END DO
-            END DO
-            CALL lbc_lnk( u_ice, 'U', -1. )
-            
-#if defined key_agrif
-!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp )
-            CALL agrif_interp_lim3( 'U' )
-#endif
-            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' )
-
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-         
-                  ! tau_io/(v_oce - v_ice)
-                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
-                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
-
-                  ! tau_bottom/v_ice
-                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) )
-                  ztauB = - tau_icebfr(ji,jj) / zvel
-                  
-                  ! Coriolis at V-points (energy conserving formulation)
-                  zCor  = - 0.25_wp * r1_e2v(ji,jj) *  &
-                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
-                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
-
-                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
-
-                  ! landfast switch => 0 = static friction (tau_icebfr > zTauE); 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
-                  
-                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
-                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                   &  ! previous velocity
-                     &                                     + zTauE + zTauO * v_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
-                     &             + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
-                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin
-                     &           ) * zmaskV(ji,jj)
-                  ! Bouillon 2013
-                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  &
-                  !!   &           + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  &
-                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj)
-               END DO
-            END DO
-            CALL lbc_lnk( v_ice, 'V', -1. )
-            
-#if defined key_agrif
-!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp )
-            CALL agrif_interp_lim3( 'V' )
-#endif
-            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' )
-
-         ENDIF
-         
-         IF(ln_ctl) THEN   ! Convergence test
-            DO jj = 2 , jpjm1
-               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
-            END DO
-            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) )
-            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
-         ENDIF
-         !
-         !                                                ! ==================== !
-      END DO                                              !  end loop over jter  !
-      !                                                   ! ==================== !
-      !
-      !------------------------------------------------------------------------------!
-      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
-      !------------------------------------------------------------------------------!
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-
-            ! shear at F points
-            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
-               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
-               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
-
-         END DO
-      END DO           
-      CALL lbc_lnk( zds, 'F', 1. )
-      
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1 ! no vector loop
-            
-            ! tension**2 at T points
-            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
-               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
-               &   ) * r1_e1e2t(ji,jj)
-            zdt2 = zdt * zdt
-            
-            ! shear**2 at T points (doc eq. A16)
-            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
-               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
-               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-            
-            ! shear at T points
-            shear_i(ji,jj) = SQRT( zdt2 + zds2 )
-
-            ! divergence at T points
-            divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
-               &            + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
-               &            ) * r1_e1e2t(ji,jj)
-            
-            ! delta at T points
-            zdelta         = SQRT( divu_i(ji,jj) * divu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )  
-            rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0
-            delta_i(ji,jj) = zdelta + rn_creepl * rswitch
-
-         END DO
-      END DO
-      CALL lbc_lnk_multi( shear_i, 'T', 1., divu_i, 'T', 1., delta_i, 'T', 1. )
-      
-      ! --- Store the stress tensor for the next time step --- !
-      stress1_i (:,:) = zs1 (:,:)
-      stress2_i (:,:) = zs2 (:,:)
-      stress12_i(:,:) = zs12(:,:)
-      !
-
-      !------------------------------------------------------------------------------!
-      ! 5) Control prints of residual and charge ellipse
-      !------------------------------------------------------------------------------!
-      !
-      ! print the residual for convergence
-      IF(ln_ctl) THEN
-         WRITE(charout,FMT="('lim_rhg  : res =',D23.16, ' iter =',I4)") zresm, jter
-         CALL prt_ctl_info(charout)
-         CALL prt_ctl(tab2d_1=u_ice, clinfo1=' lim_rhg  : u_ice :', tab2d_2=v_ice, clinfo2=' v_ice :')
-      ENDIF
-
-      ! print charge ellipse
-      ! This can be desactivated once the user is sure that the stress state
-      ! lie on the charge ellipse. See Bouillon et al. (2008) for more details
-      IF(ln_ctl) THEN
-         CALL prt_ctl_info('lim_rhg  : numit  :',ivar1=numit)
-         CALL prt_ctl_info('lim_rhg  : nwrite :',ivar1=nwrite)
-         CALL prt_ctl_info('lim_rhg  : MOD    :',ivar1=MOD(numit,nwrite))
-         IF( MOD(numit,nwrite) .EQ. 0 ) THEN
-            WRITE(charout,FMT="('lim_rhg  :', I4, I6, I1, I1, A10)") 1000, numit, 0, 0, ' ch. ell. '
-            CALL prt_ctl_info(charout)
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  IF (strength(ji,jj) > 1.0) THEN
-                     zsig1 = ( zs1(ji,jj) + SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) ) 
-                     zsig2 = ( zs1(ji,jj) - SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) )
-                     WRITE(charout,FMT="('lim_rhg  :', I4, I4, D23.16, D23.16, D23.16, D23.16, A10)")
-                     CALL prt_ctl_info(charout)
-                  ENDIF
-               END DO
-            END DO
-            WRITE(charout,FMT="('lim_rhg  :', I4, I6, I1, I1, A10)") 2000, numit, 0, 0, ' ch. ell. '
-            CALL prt_ctl_info(charout)
-         ENDIF
-      ENDIF
-      !     
-      
-      CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )
-      CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )
-      CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )
-      CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )
-      CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )
-
-   END SUBROUTINE lim_rhg
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option          Dummy module           NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_rhg         ! Dummy routine
-      WRITE(*,*) 'lim_rhg: You should not have seen this print! error?'
-   END SUBROUTINE lim_rhg
-#endif
-
-   !!==============================================================================
-END MODULE limrhg
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 8568)
+++ 	(revision )
@@ -1,546 +1,0 @@
-MODULE limrst
-   !!======================================================================
-   !!                     ***  MODULE  limrst  ***
-   !! Ice restart :  write the ice restart file
-   !!======================================================================
-   !! History:   -   ! 2005-04 (M. Vancoppenolle) Original code
-   !!           3.0  ! 2008-03 (C. Ethe) restart files in using IOM interface
-   !!           4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3' :                                   LIM sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_rst_opn   : open ice restart file
-   !!   lim_rst_write : write of the restart file 
-   !!   lim_rst_read  : read  the restart file 
-   !!----------------------------------------------------------------------
-   USE ice            ! sea-ice variables
-   USE oce     , ONLY :  snwice_mass, snwice_mass_b
-   USE dom_oce        ! ocean domain
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbc_ice        ! Surface boundary condition: ice fields
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O library
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE limctl
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_rst_opn    ! routine called by icestep.F90
-   PUBLIC   lim_rst_write  ! routine called by icestep.F90
-   PUBLIC   lim_rst_read   ! routine called by sbc_lim_init
-
-   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write 
-   INTEGER, PUBLIC ::   numrir, numriw   !: logical unit for ice restart (read and write)
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_rst_opn( kt )
-      !!----------------------------------------------------------------------
-      !!                    ***  lim_rst_opn  ***
-      !!
-      !! ** purpose  :   output of sea-ice variable in a netcdf file
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt       ! number of iteration
-      !
-      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
-      CHARACTER(len=50)   ::   clname   ! ice output restart file name
-      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file 
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
-
-      ! in order to get better performances with NetCDF format, we open and define the ice restart file 
-      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice 
-      ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
-      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    &
-         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
-         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
-            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
-            ENDIF
-            ! create the file
-            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
-            clpath = TRIM(cn_icerst_outdir) 
-            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
-            IF(lwp) THEN
-               WRITE(numout,*)
-               SELECT CASE ( jprstlib )
-               CASE DEFAULT
-                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
-               END SELECT
-               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
-                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
-               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
-               ENDIF
-            ENDIF
-            !
-            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
-            lrst_ice = .TRUE.
-         ENDIF
-      ENDIF
-      !
-      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
-   END SUBROUTINE lim_rst_opn
-
-
-   SUBROUTINE lim_rst_write( kt )
-      !!----------------------------------------------------------------------
-      !!                    ***  lim_rst_write  ***
-      !!
-      !! ** purpose  :   output of sea-ice variable in a netcdf file
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! number of iteration
-      !!
-      INTEGER ::   ji, jj, jk ,jl   ! dummy loop indices
-      INTEGER ::   iter
-      CHARACTER(len=25) ::   znam
-      CHARACTER(len=2)  ::   zchar, zchar1
-      REAL(wp), POINTER, DIMENSION(:,:) :: z2d
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, z2d )
-
-      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
-
-      IF( iter == nitrst ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'lim_rst_write : write ice restart file  kt =', kt
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
-      ENDIF
-
-      ! Write in numriw (if iter == nitrst)
-      ! ------------------ 
-      !                                                                        ! calendar control
-      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step 
-      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date
-
-      ! Prognostic variables 
-      DO jl = 1, jpl 
-         WRITE(zchar,'(I2.2)') jl
-         znam = 'v_i'//'_htc'//zchar
-         z2d(:,:) = v_i(:,:,jl)
-         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         znam = 'v_s'//'_htc'//zchar
-         z2d(:,:) = v_s(:,:,jl)
-         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         znam = 'smv_i'//'_htc'//zchar
-         z2d(:,:) = smv_i(:,:,jl)
-         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         znam = 'oa_i'//'_htc'//zchar
-         z2d(:,:) = oa_i(:,:,jl)
-         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         znam = 'a_i'//'_htc'//zchar
-         z2d(:,:) = a_i(:,:,jl)
-         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         znam = 't_su'//'_htc'//zchar
-         z2d(:,:) = t_su(:,:,jl)
-         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         znam = 'tempt_sl1'//'_htc'//zchar
-         z2d(:,:) = e_s(:,:,1,jl)
-         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         DO jk = 1, nlay_i 
-            WRITE(zchar1,'(I2.2)') jk
-            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
-            z2d(:,:) = e_i(:,:,jk,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         END DO
-      END DO
-
-      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'        , u_ice      )
-      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'        , v_ice      )
-      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'    , stress1_i  )
-      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  )
-      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i )
-      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )
-      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
-
-      ! In case Prather scheme is used for advection, write second order moments
-      ! ------------------------------------------------------------------------
-      IF( nn_limadv == -1 ) THEN
-         
-         DO jl = 1, jpl 
-            WRITE(zchar,'(I2.2)') jl
-            znam = 'sxice'//'_htc'//zchar
-            z2d(:,:) = sxice(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syice'//'_htc'//zchar
-            z2d(:,:) = syice(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxxice'//'_htc'//zchar
-            z2d(:,:) = sxxice(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syyice'//'_htc'//zchar
-            z2d(:,:) = syyice(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxyice'//'_htc'//zchar
-            z2d(:,:) = sxyice(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxsn'//'_htc'//zchar
-            z2d(:,:) = sxsn(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sysn'//'_htc'//zchar
-            z2d(:,:) = sysn(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxxsn'//'_htc'//zchar
-            z2d(:,:) = sxxsn(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syysn'//'_htc'//zchar
-            z2d(:,:) = syysn(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxysn'//'_htc'//zchar
-            z2d(:,:) = sxysn(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxa'//'_htc'//zchar
-            z2d(:,:) = sxa(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sya'//'_htc'//zchar
-            z2d(:,:) = sya(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxxa'//'_htc'//zchar
-            z2d(:,:) = sxxa(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syya'//'_htc'//zchar
-            z2d(:,:) = syya(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxya'//'_htc'//zchar
-            z2d(:,:) = sxya(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxc0'//'_htc'//zchar
-            z2d(:,:) = sxc0(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syc0'//'_htc'//zchar
-            z2d(:,:) = syc0(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxxc0'//'_htc'//zchar
-            z2d(:,:) = sxxc0(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syyc0'//'_htc'//zchar
-            z2d(:,:) = syyc0(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxyc0'//'_htc'//zchar
-            z2d(:,:) = sxyc0(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxsal'//'_htc'//zchar
-            z2d(:,:) = sxsal(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sysal'//'_htc'//zchar
-            z2d(:,:) = sysal(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxxsal'//'_htc'//zchar
-            z2d(:,:) = sxxsal(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syysal'//'_htc'//zchar
-            z2d(:,:) = syysal(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxysal'//'_htc'//zchar
-            z2d(:,:) = sxysal(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxage'//'_htc'//zchar
-            z2d(:,:) = sxage(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syage'//'_htc'//zchar
-            z2d(:,:) = syage(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxxage'//'_htc'//zchar
-            z2d(:,:) = sxxage(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'syyage'//'_htc'//zchar
-            z2d(:,:) = syyage(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            znam = 'sxyage'//'_htc'//zchar
-            z2d(:,:) = sxyage(:,:,jl)
-            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-         END DO
-
-         CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  )
-         CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  )
-         CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw )
-         CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw )
-         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw )
-         
-         DO jl = 1, jpl 
-            WRITE(zchar,'(I2.2)') jl
-            DO jk = 1, nlay_i 
-               WRITE(zchar1,'(I2.2)') jk
-               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
-               z2d(:,:) = sxe(:,:,jk,jl)
-               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-               znam = 'sye'//'_il'//zchar1//'_htc'//zchar
-               z2d(:,:) = sye(:,:,jk,jl)
-               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
-               z2d(:,:) = sxxe(:,:,jk,jl)
-               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-               znam = 'syye'//'_il'//zchar1//'_htc'//zchar
-               z2d(:,:) = syye(:,:,jk,jl)
-               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
-               z2d(:,:) = sxye(:,:,jk,jl)
-               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
-            END DO
-         END DO
-
-      ENDIF
-      
-      ! close restart file
-      ! ------------------
-      IF( iter == nitrst ) THEN
-         CALL iom_close( numriw )
-         lrst_ice = .FALSE.
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, z2d )
-      !
-   END SUBROUTINE lim_rst_write
-
-
-   SUBROUTINE lim_rst_read
-      !!----------------------------------------------------------------------
-      !!                    ***  lim_rst_read  ***
-      !!
-      !! ** purpose  :   read of sea-ice variable restart in a netcdf file
-      !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk, jl
-      REAL(wp) ::   zfice, ziter
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d
-      CHARACTER(len=25) ::   znam
-      CHARACTER(len=2)  ::   zchar, zchar1
-      INTEGER           ::   jlibalt = jprstlib
-      LOGICAL           ::   llok
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, z2d )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_rst_read : read ice NetCDF restart file'
-         WRITE(numout,*) '~~~~~~~~~~~~~'
-      ENDIF
-
-      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
-
-      CALL iom_get( numrir, 'nn_fsbc', zfice )
-      CALL iom_get( numrir, 'kt_ice' , ziter )    
-      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
-      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
-
-      !Control of date
-
-      IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
-         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  &
-         &                   '   verify the file or rerun with the value 0 for the',        &
-         &                   '   control of time parameter  nrstdt' )
-      IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
-         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
-         &                   '   verify the file or rerun with the value 0 for the',         &
-         &                   '   control of time parameter  nrstdt' )
-
-      ! Prognostic variables 
-      DO jl = 1, jpl 
-         WRITE(zchar,'(I2.2)') jl
-         znam = 'v_i'//'_htc'//zchar
-         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-         v_i(:,:,jl) = z2d(:,:)
-         znam = 'v_s'//'_htc'//zchar
-         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-         v_s(:,:,jl) = z2d(:,:) 
-         znam = 'smv_i'//'_htc'//zchar
-         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-         smv_i(:,:,jl) = z2d(:,:)
-         znam = 'oa_i'//'_htc'//zchar
-         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-         oa_i(:,:,jl) = z2d(:,:)
-         znam = 'a_i'//'_htc'//zchar
-         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-         a_i(:,:,jl) = z2d(:,:)
-         znam = 't_su'//'_htc'//zchar
-         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-         t_su(:,:,jl) = z2d(:,:)
-         znam = 'tempt_sl1'//'_htc'//zchar
-         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-         e_s(:,:,1,jl) = z2d(:,:)
-         DO jk = 1, nlay_i 
-            WRITE(zchar1,'(I2.2)') jk
-            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            e_i(:,:,jk,jl) = z2d(:,:)
-         END DO
-      END DO
-
-      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      )
-      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      )
-      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  )
-      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
-      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
-      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )
-      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
-
-      ! In case Prather scheme is used for advection, read second order moments
-      ! ------------------------------------------------------------------------
-      IF( nn_limadv == -1 ) THEN
-
-         DO jl = 1, jpl 
-            WRITE(zchar,'(I2.2)') jl
-            znam = 'sxice'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxice(:,:,jl) = z2d(:,:)
-            znam = 'syice'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syice(:,:,jl) = z2d(:,:)
-            znam = 'sxxice'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxxice(:,:,jl) = z2d(:,:)
-            znam = 'syyice'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syyice(:,:,jl) = z2d(:,:)
-            znam = 'sxyice'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxyice(:,:,jl) = z2d(:,:)
-            znam = 'sxsn'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxsn(:,:,jl) = z2d(:,:)
-            znam = 'sysn'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sysn(:,:,jl) = z2d(:,:)
-            znam = 'sxxsn'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxxsn(:,:,jl) = z2d(:,:)
-            znam = 'syysn'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syysn(:,:,jl) = z2d(:,:)
-            znam = 'sxysn'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxysn(:,:,jl) = z2d(:,:)
-            znam = 'sxa'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxa(:,:,jl) = z2d(:,:)
-            znam = 'sya'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sya(:,:,jl) = z2d(:,:)
-            znam = 'sxxa'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxxa(:,:,jl) = z2d(:,:)
-            znam = 'syya'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syya(:,:,jl) = z2d(:,:)
-            znam = 'sxya'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxya(:,:,jl) = z2d(:,:)
-            znam = 'sxc0'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxc0(:,:,jl) = z2d(:,:)
-            znam = 'syc0'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syc0(:,:,jl) = z2d(:,:)
-            znam = 'sxxc0'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxxc0(:,:,jl) = z2d(:,:)
-            znam = 'syyc0'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syyc0(:,:,jl) = z2d(:,:)
-            znam = 'sxyc0'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxyc0(:,:,jl) = z2d(:,:)
-            znam = 'sxsal'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxsal(:,:,jl) = z2d(:,:)
-            znam = 'sysal'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sysal(:,:,jl) = z2d(:,:)
-            znam = 'sxxsal'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxxsal(:,:,jl) = z2d(:,:)
-            znam = 'syysal'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syysal(:,:,jl) = z2d(:,:)
-            znam = 'sxysal'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxysal(:,:,jl) = z2d(:,:)
-            znam = 'sxage'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxage(:,:,jl) = z2d(:,:)
-            znam = 'syage'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syage(:,:,jl) = z2d(:,:)
-            znam = 'sxxage'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxxage(:,:,jl) = z2d(:,:)
-            znam = 'syyage'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            syyage(:,:,jl) = z2d(:,:)
-            znam = 'sxyage'//'_htc'//zchar
-            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-            sxyage(:,:,jl)= z2d(:,:)
-         END DO
-
-         CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  )
-         CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  )
-         CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw )
-         CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw )
-         CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw )
-
-         DO jl = 1, jpl 
-            WRITE(zchar,'(I2.2)') jl
-            DO jk = 1, nlay_i 
-               WRITE(zchar1,'(I2.2)') jk
-               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
-               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-               sxe(:,:,jk,jl) = z2d(:,:)
-               znam = 'sye'//'_il'//zchar1//'_htc'//zchar
-               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-               sye(:,:,jk,jl) = z2d(:,:)
-               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
-               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-               sxxe(:,:,jk,jl) = z2d(:,:)
-               znam = 'syye'//'_il'//zchar1//'_htc'//zchar
-               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-               syye(:,:,jk,jl) = z2d(:,:)
-               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
-               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
-               sxye(:,:,jk,jl) = z2d(:,:)
-            END DO
-         END DO
-         !
-      END IF
-      
-      ! clem: I do not understand why the following IF is needed
-      !       I suspect something inconsistent in the main code with option nn_icesal=1
-      IF( nn_icesal == 1 ) THEN
-         DO jl = 1, jpl 
-            sm_i(:,:,jl) = rn_icesal
-            DO jk = 1, nlay_i 
-               s_i(:,:,jk,jl) = rn_icesal
-            END DO
-         END DO
-      ENDIF
-      !
-      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90
-      !
-      CALL wrk_dealloc( jpi, jpj, z2d )
-      !
-   END SUBROUTINE lim_rst_read
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :       Empty module            NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_rst_read             ! Empty routine
-   END SUBROUTINE lim_rst_read
-   SUBROUTINE lim_rst_write            ! Empty routine
-   END SUBROUTINE lim_rst_write
-#endif
-
-   !!======================================================================
-END MODULE limrst
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 8568)
+++ 	(revision )
@@ -1,394 +1,0 @@
-MODULE limsbc
-   !!======================================================================
-   !!                       ***  MODULE limsbc   ***
-   !!           computation of the flux at the sea ice/ocean interface
-   !!======================================================================
-   !! History :   -   ! 2006-07 (M. Vancoppelle)  LIM3 original code
-   !!            3.0  ! 2008-03 (C. Tallandier)  surface module
-   !!             -   ! 2008-04 (C. Tallandier)  split in 2 + new ice-ocean coupling
-   !!            3.3  ! 2010-05 (G. Madec) decrease ocean & ice reference salinities in the Baltic sea
-   !!                 !                  + simplification of the ice-ocean stress calculation
-   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
-   !!             -   ! 2012    (D. Iovino) salt flux change
-   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
-   !!            3.5  ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                    LIM 3.0 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_sbc_alloc : allocate the limsbc arrays
-   !!   lim_sbc_init  : initialisation
-   !!   lim_sbc_flx   : updates mass, heat and salt fluxes at the ocean surface
-   !!   lim_sbc_tau   : update i- and j-stresses, and its modulus at the ocean surface
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE oce     , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
-   USE phycst         ! physical constants
-   USE dom_oce        ! ocean domain
-   USE ice            ! LIM sea-ice variables
-   USE sbc_ice        ! Surface boundary condition: sea-ice fields
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbccpl         ! Surface boundary condition: coupled interface
-   USE albedo         ! albedo parameters
-   USE traqsr         ! add penetration of solar flux in the calculation of heat budget
-   USE domvvl         ! Variable volume
-   USE limctl         !
-   USE limcons        !
-   USE bdy_oce  , ONLY: ln_bdy
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! xIO server
-   USE lbclnk         ! ocean lateral boundary condition - MPP exchanges
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_sbc_init   ! called by sbc_lim_init
-   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim
-   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2]
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean velocity   [m/s]
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0  , sice_0     ! cst SSS and ice salinity (levitating sea-ice) 
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION lim_sbc_alloc()
-      !!-------------------------------------------------------------------
-      !!             ***  ROUTINE lim_sbc_alloc ***
-      !!-------------------------------------------------------------------
-      ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) ,                       &
-         &      sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc)
-         !
-      IF( lk_mpp             )   CALL mpp_sum( lim_sbc_alloc )
-      IF( lim_sbc_alloc /= 0 )   CALL ctl_warn('lim_sbc_alloc: failed to allocate arrays')
-   END FUNCTION lim_sbc_alloc
-
-
-   SUBROUTINE lim_sbc_flx( kt )
-      !!-------------------------------------------------------------------
-      !!                ***  ROUTINE lim_sbc_flx ***
-      !!  
-      !! ** Purpose :   Update the surface ocean boundary condition for heat 
-      !!              salt and mass over areas where sea-ice is non-zero
-      !!         
-      !! ** Action  : - computes the heat and freshwater/salt fluxes
-      !!              at the ice-ocean interface.
-      !!              - Update the ocean sbc
-      !!     
-      !! ** Outputs : - qsr     : sea heat flux:     solar 
-      !!              - qns     : sea heat flux: non solar
-      !!              - emp     : freshwater budget: volume flux 
-      !!              - sfx     : salt flux 
-      !!              - fr_i    : ice fraction
-      !!              - tn_ice  : sea-ice surface temperature
-      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode)
-      !!
-      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
-      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
-      !!              These refs are now obsolete since everything has been revised
-      !!              The ref should be Rousset et al., 2015
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! number of iteration
-      !
-      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
-      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2)
-      REAL(wp) ::   zqsr             ! New solar flux received by the ocean
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 3D workspace
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace
-      !!---------------------------------------------------------------------
-
-      ! --- case we bypass ice thermodynamics --- !
-      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere
-         hfx_in   (:,:)   = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
-         hfx_out  (:,:)   = pfrld(:,:) *   qns_oce(:,:)                  + qemp_oce(:,:)
-         ftr_ice  (:,:,:) = 0._wp
-         emp_ice  (:,:)   = 0._wp
-         qemp_ice (:,:)   = 0._wp
-         qevap_ice(:,:,:) = 0._wp
-      ENDIF
-      
-      ! albedo output
-      CALL wrk_alloc( jpi,jpj, zalb )    
-
-      zalb(:,:) = 0._wp
-      WHERE     ( at_i_b <= epsi06 )  ;  zalb(:,:) = 0.066_wp
-      ELSEWHERE                       ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b
-      END WHERE
-      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output
-
-      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b )      
-      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output
-
-      CALL wrk_dealloc( jpi,jpj, zalb )    
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-
-            !------------------------------------------!
-            !      heat flux at the ocean surface      !
-            !------------------------------------------!
-            ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
-            !---------------------------------------------------
-            zqsr = qsr_tot(ji,jj)
-            DO jl = 1, jpl
-               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 
-            END DO
-
-            ! Total heat flux reaching the ocean = hfx_out (W.m-2) 
-            !---------------------------------------------------
-            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
-            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr
-
-            ! Add the residual from heat diffusion equation and sublimation (W.m-2)
-            !----------------------------------------------------------------------
-            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) +   &
-               &           ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
-
-            ! New qsr and qns used to compute the oceanic heat flux at the next time step
-            !----------------------------------------------------------------------------
-            qsr(ji,jj) = zqsr                                      
-            qns(ji,jj) = hfx_out(ji,jj) - zqsr              
-
-            !------------------------------------------!
-            !      mass flux at the ocean surface      !
-            !------------------------------------------!
-            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
-            !  ------------------------------------------------------------------------------------- 
-            !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
-            !  Thus  FW  flux  =  External ( E-P+snow melt)
-            !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
-            !                     Associated to Ice formation AND Ice melting
-            !                     Even if i see Ice melting as a FW and SALT flux
-            !        
-            ! mass flux from ice/ocean
-            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
-                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 
-
-            ! mass flux at the ocean/ice interface
-            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
-            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
-         END DO
-      END DO
-
-      !------------------------------------------!
-      !      salt flux at the ocean surface      !
-      !------------------------------------------!
-      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   &
-         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:)
-
-      !-------------------------------------------------------------!
-      !   mass of snow and ice per unit area for embedded sea-ice   !
-      !-------------------------------------------------------------!
-      IF( nn_ice_embd /= 0 ) THEN
-         ! save mass from the previous ice time step
-         snwice_mass_b(:,:) = snwice_mass(:,:)                  
-         ! new mass per unit area
-         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
-         ! time evolution of snow+ice mass
-         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice
-      ENDIF
-
-      !-----------------------------------------------!
-      !   Storing the transmitted variables           !
-      !-----------------------------------------------!
-      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction            
-      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                      
-
-      !------------------------------------------------------------------------!
-      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   !
-      !------------------------------------------------------------------------!
-      CALL wrk_alloc( jpi,jpj,jpl,   zalb_cs, zalb_os )    
-      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
-      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-      CALL wrk_dealloc( jpi,jpj,jpl,   zalb_cs, zalb_os )
-
-      ! conservation test
-      IF( ln_limdiachk .AND. .NOT. ln_bdy)  CALL lim_cons_final( 'limsbc' )
-
-      ! control prints
-      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' )
-      IF( ln_ctl )      CALL lim_prt3D( 'limsbc' )
-
-   END SUBROUTINE lim_sbc_flx
-
-
-   SUBROUTINE lim_sbc_tau( kt , pu_oce, pv_oce )
-      !!-------------------------------------------------------------------
-      !!                ***  ROUTINE lim_sbc_tau ***
-      !!  
-      !! ** Purpose : Update the ocean surface stresses due to the ice
-      !!         
-      !! ** Action  : * at each ice time step (every nn_fsbc time step):
-      !!                - compute the modulus of ice-ocean relative velocity 
-      !!                  (*rho*Cd) at T-point (C-grid) or I-point (B-grid)
-      !!                      tmod_io = rhoco * | U_ice-U_oce |
-      !!                - update the modulus of stress at ocean surface
-      !!                      taum = frld * taum + (1-frld) * tmod_io * | U_ice-U_oce |
-      !!              * at each ocean time step (every kt): 
-      !!                  compute linearized ice-ocean stresses as
-      !!                      Utau = tmod_io * | U_ice - pU_oce |
-      !!                using instantaneous current ocean velocity (usually before)
-      !!
-      !!    NB: - ice-ocean rotation angle no more allowed
-      !!        - here we make an approximation: taum is only computed every ice time step
-      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 
-      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
-      !!
-      !! ** Outputs : - utau, vtau   : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes
-      !!              - taum         : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
-      !!---------------------------------------------------------------------
-      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
-      !
-      INTEGER  ::   ji, jj   ! dummy loop indices
-      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar
-      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      -
-      !!---------------------------------------------------------------------
-      zrhoco = rau0 * rn_cio
-      !
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
-         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
-            DO ji = fs_2, fs_jpim1
-               !                                               ! 2*(U_ice-U_oce) at T-point
-               zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
-               zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
-               !                                              ! |U_ice-U_oce|^2
-               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
-               !                                               ! update the ocean stress modulus
-               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
-               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
-            END DO
-         END DO
-         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. )
-         !
-         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step
-         vtau_oce(:,:) = vtau(:,:)
-         !
-      ENDIF
-      !
-      !                                      !==  every ocean time-step  ==!
-      !
-      DO jj = 2, jpjm1                                !* update the stress WITHOUT a ice-ocean rotation angle
-         DO ji = fs_2, fs_jpim1   ! Vect. Opt.
-            zat_u  = ( at_i(ji,jj) + at_i(ji+1,jj) ) * 0.5_wp   ! ice area at u and V-points
-            zat_v  = ( at_i(ji,jj) + at_i(ji,jj+1) ) * 0.5_wp
-            !                                                   ! linearized quadratic drag formulation
-            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
-            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
-            !                                                   ! stresses at the ocean surface
-            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
-            vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
-         END DO
-      END DO
-      CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition
-      !
-      !  
-   END SUBROUTINE lim_sbc_tau
-
-
-   SUBROUTINE lim_sbc_init
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_sbc_init  ***
-      !!             
-      !! ** Purpose : Preparation of the file ice_evolu for the output of
-      !!      the temporal evolution of key variables
-      !!
-      !! ** input   : Namelist namicedia
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk               ! dummy loop indices
-      REAL(wp) ::   zcoefu, zcoefv, zcoeff   ! local scalar
-      !!-------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   '
-
-      !                                      ! allocate lim_sbc array
-      IF( lim_sbc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' )
-      !
-      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case
-      sice_0(:,:) = sice
-      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area
-      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   &
-         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         ) 
-         soce_0(:,:) = 4._wp
-         sice_0(:,:) = 2._wp
-      END WHERE
-      !
-      IF( .NOT. ln_rstart ) THEN
-         !                                      ! embedded sea ice
-         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )
-            snwice_mass_b(:,:) = snwice_mass(:,:)
-         ELSE
-            snwice_mass  (:,:) = 0._wp          ! no mass exchanges
-            snwice_mass_b(:,:) = 0._wp          ! no mass exchanges
-         ENDIF
-         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area
-            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
-            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
-
-!!gm I really don't like this stuff here...  Find a way to put that elsewhere or differently
-!!gm
-            IF( .NOT.ln_linssh ) THEN
-               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
-                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-               END DO
-               e3t_a(:,:,:) = e3t_b(:,:,:)
-               ! Reconstruction of all vertical scale factors at now and before time-steps
-               ! =========================================================================
-               ! Horizontal scale factor interpolations
-               ! --------------------------------------
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-               CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
-               ! Vertical scale factor interpolations
-                 ! ------------------------------------
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
-               CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-               CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-               CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-               CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
-               ! t- and w- points depth
-               ! ----------------------
-!!gm not sure of that....
-               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-               gdepw_n(:,:,1) = 0.0_wp
-               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
-               DO jk = 2, jpk
-                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
-                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
-                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
-               END DO
-            ENDIF
-         ENDIF
-      ENDIF ! .NOT. ln_rstart
-      !
-   END SUBROUTINE lim_sbc_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :        Dummy module       NO LIM 3.0 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_sbc           ! Dummy routine
-   END SUBROUTINE lim_sbc
-#endif 
-
-   !!======================================================================
-END MODULE limsbc
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 8568)
+++ 	(revision )
@@ -1,71 +1,0 @@
-MODULE limtab
-   !!======================================================================
-   !!                       ***  MODULE limtab   ***
-   !!   LIM ice model : transform 1D (2D) array to a 2D (1D) table
-   !!======================================================================
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   tab_2d_1d  : 2-D <==> 1-D
-   !!   tab_1d_2d  : 1-D <==> 2-D
-   !!----------------------------------------------------------------------
-   USE par_kind
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tab_2d_1d   ! called by limthd
-   PUBLIC   tab_1d_2d   ! called by limthd
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tab_2d_1d( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tab_2d_1d  ***
-      !!----------------------------------------------------------------------
-      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes
-      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in   ) ::   tab2d                        ! input 2D field
-      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index
-      REAL(wp), DIMENSION(ndim1d)           , INTENT(  out) ::   tab1d                        ! output 1D field
-      !
-      INTEGER ::   jn , jid, jjd
-      !!----------------------------------------------------------------------
-      DO jn = 1, ndim1d
-         jid        = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1
-         jjd        =    ( tab_ind(jn) - 1 ) / ndim2d_x + 1
-         tab1d( jn) = tab2d( jid, jjd)
-      END DO
-   END SUBROUTINE tab_2d_1d
-
-
-   SUBROUTINE tab_1d_2d( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tab_2d_1d  ***
-      !!----------------------------------------------------------------------
-      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes
-      REAL(wp), DIMENSION(ndim1d)           , INTENT(in   ) ::   tab1d                        ! input 1D field
-      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index
-      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(  out) ::   tab2d                        ! output 2D field
-      !
-      INTEGER ::   jn , jid, jjd
-      !!----------------------------------------------------------------------
-      DO jn = 1, ndim1d
-         jid             = MOD( tab_ind(jn) - 1 ,  ndim2d_x ) + 1
-         jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1
-         tab2d(jid, jjd) = tab1d( jn)
-      END DO
-   END SUBROUTINE tab_1d_2d
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option        Dummy module             NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-#endif
-   !!======================================================================
-END MODULE limtab
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 8568)
+++ 	(revision )
@@ -1,633 +1,0 @@
-MODULE limthd
-   !!======================================================================
-   !!                  ***  MODULE limthd   ***
-   !!  LIM-3 :   ice thermodynamic
-   !!======================================================================
-   !! History :  LIM  ! 2000-01 (M.A. Morales Maqueda, H. Goosse, T. Fichefet) LIM-1
-   !!            2.0  ! 2002-07 (C. Ethe, G. Madec)  LIM-2 (F90 rewriting)
-   !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations
-   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif
-   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw
-   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas)
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_thd       : thermodynamic of sea ice
-   !!   lim_thd_init  : initialisation of sea-ice thermodynamic
-   !!----------------------------------------------------------------------
-   USE phycst         ! physical constants
-   USE dom_oce        ! ocean space and time domain variables
-   USE ice            ! sea-ice variables
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbc_ice        ! Surface boundary condition: ice fields
-   USE thd_ice        ! thermodynamic sea-ice variables
-   USE limthd_dif     ! vertical diffusion
-   USE limthd_dh      ! ice-snow growth and melt
-   USE limthd_da      ! lateral melting
-   USE limthd_sal     ! ice salinity
-   USE limthd_ent     ! ice enthalpy redistribution
-   USE limthd_lac     ! lateral accretion
-   USE limitd_th      ! remapping thickness distribution
-   USE limtab         ! 1D <==> 2D transformation
-   USE limvar         !
-   USE limcons        ! conservation tests
-   USE limctl         ! control print
-   !
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! lateral boundary condition - MPP links
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_thd         ! called by limstp module
-   PUBLIC   lim_thd_init    ! called by sbc_lim_init
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_thd( kt )
-      !!-------------------------------------------------------------------
-      !!                ***  ROUTINE lim_thd  ***       
-      !!  
-      !! ** Purpose : This routine manages ice thermodynamics
-      !!         
-      !! ** Action : - Initialisation of some variables
-      !!             - Some preliminary computation (oceanic heat flux
-      !!               at the ice base, snow acc.,heat budget of the leads)
-      !!             - selection of the icy points and put them in an array
-      !!             - call lim_thd_dif  for vertical heat diffusion
-      !!             - call lim_thd_dh   for vertical ice growth and melt
-      !!             - call lim_thd_ent  for enthalpy remapping
-      !!             - call lim_thd_sal  for ice desalination
-      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy
-      !!             - back to the geographic grid
-      !!     
-      !! ** References : 
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt    ! number of iteration
-      !
-      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations
-      REAL(wp) :: zfric_u, zqld, zqfr
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04)
-      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io, zfric   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)
-      !
-      !!-------------------------------------------------------------------
-
-      IF( nn_timing == 1 )   CALL timing_start('limthd')
-
-      CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric )
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)'' 
-         WRITE(numout,*)' lim_thd '
-         WRITE(numout,*)' ~~~~~~~~'
-      ENDIF
-      
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      CALL lim_var_glo2eqv
-
-      !---------------------------------------------!
-      ! computation of friction velocity at T points
-      !---------------------------------------------!
-      IF( ln_limdyn ) THEN
-         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
-         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1
-               zfric(ji,jj) = rn_cio * ( 0.5_wp *  &
-                  &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
-                  &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1)
-            END DO
-         END DO
-      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  &
-                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
-                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-      CALL lbc_lnk( zfric, 'T',  1. )
-      !
-      !----------------------------------!
-      ! Initialization and units change
-      !----------------------------------!
-      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice
-
-      ! Change the units of heat content; from J/m2 to J/m3
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )
-                  !Energy of melting q(S,T) [J.m-3]
-                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i )
-               END DO
-            END DO
-         END DO
-         DO jk = 1, nlay_s
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  )
-                  !Energy of melting q(S,T) [J.m-3]
-                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s )
-               END DO
-            END DO
-         END DO
-      END DO
-
-      !--------------------------------------------------------------------!
-      ! Partial computation of forcing for the thermodynamic sea ice model
-      !--------------------------------------------------------------------!
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
-            !
-            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
-            !           !  practically no "direct lateral ablation"
-            !           
-            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
-            !           !  temperature and turbulent mixing (McPhee, 1992)
-            !
-            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
-            zqld =  tmask(ji,jj,1) * rdt_ice *  &
-               &    ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
-
-            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
-            zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
-
-            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- !
-            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
-            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2
-            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
-            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
-            !                        the freezing point, so that we do not have SST < T_freeze
-            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
-
-            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice
-            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
-
-            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 
-            IF( zqld > 0._wp ) THEN
-               fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
-               qlead(ji,jj) = 0._wp
-            ELSE
-               fhld (ji,jj) = 0._wp
-            ENDIF
-            !
-            ! Net heat flux on top of the ice-ocean [W.m-2]
-            ! ---------------------------------------------
-            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
-         END DO
-      END DO
-      
-      ! In case we bypass open-water ice formation
-      IF( .NOT. ln_limdO )  qlead(:,:) = 0._wp
-      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere
-      IF( .NOT. ln_limdH )  hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
-      IF( .NOT. ln_limdH )  fhtur (:,:) = 0._wp  ;  fhld  (:,:) = 0._wp
-
-      ! ---------------------------------------------------------------------
-      ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2]
-      ! ---------------------------------------------------------------------
-      !     First  step here              :  non solar + precip - qlead - qturb
-      !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema) 
-      !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean               
-               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation
-               &             - at_i(ji,jj) * fhtur(ji,jj)                       &  ! heat flux taken by turbulence
-               &             - at_i(ji,jj) *  fhld(ji,jj)                          ! heat flux taken during bottom growth/melt 
-                                                                                   !    (fhld should be 0 while bott growth)
-         END DO
-      END DO
-
-      !------------------------------------------------------------------------------!
-      ! Thermodynamic computation (only on grid points covered by ice)
-      !------------------------------------------------------------------------------!
-
-      DO jl = 1, jpl      !loop over ice categories
-
-         ! select ice covered grid points
-         nbpb = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
-                  nbpb      = nbpb  + 1
-                  npb(nbpb) = (jj - 1) * jpi + ji
-               ENDIF
-            END DO
-         END DO
-
-         ! debug point to follow
-         jiindex_1d = 0
-         IF( ln_limctl ) THEN
-            DO ji = mi0(iiceprt), mi1(iiceprt)
-               DO jj = mj0(jiceprt), mj1(jiceprt)
-                  jiindex_1d = (jj - 1) * jpi + ji
-                  WRITE(numout,*) ' lim_thd : Category no : ', jl 
-               END DO
-            END DO
-         ENDIF
-
-         IF( lk_mpp )         CALL mpp_ini_ice( nbpb , numout )
-
-         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing.
-            !                                                                
-            s_i_new   (:) = 0._wp ; dh_s_tot (:) = 0._wp                     ! --- some init --- !
-            dh_i_surf (:) = 0._wp ; dh_i_bott(:) = 0._wp
-            dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp
-
-                              CALL lim_thd_1d2d( nbpb, jl, 1 )               ! --- Move to 1D arrays --- !
-            !
-            IF( ln_limdH )    CALL lim_thd_dif( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- !
-            !
-            IF( ln_limdH )    CALL lim_thd_dh( 1, nbpb )                     ! --- Ice/Snow thickness --- !    
-            !
-            IF( ln_limdH )    CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- !
-            !
-                              CALL lim_thd_sal( 1, nbpb )                    ! --- Ice salinity --- !    
-            !
-                              CALL lim_thd_temp( 1, nbpb )                   ! --- temperature update --- !
-            !
-            IF( ln_limdH ) THEN
-               IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
-                              CALL lim_thd_lam( 1, nbpb )                    ! --- extra lateral melting if monocat --- !
-               END IF
-            END IF
-            !
-                              CALL lim_thd_1d2d( nbpb, jl, 2 )               ! --- Move to 2D arrays --- !
-            !
-            IF( lk_mpp )      CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
-         ENDIF
-         !
-      END DO !jl
-
-      IF( ln_limdA)           CALL lim_thd_da                                ! --- lateral melting --- !
-
-      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i
-         END DO
-         DO jk = 1, nlay_s
-            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s
-         END DO
-      END DO
- 
-      ! Change thickness to volume
-      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
-      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
-      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
-
-      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat)
-      DO jl  = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) )
-               oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 )
-            END DO
-         END DO
-      END DO
-
-      CALL lim_var_zapsmall
-
-      ! control checks
-      IF( ln_limctl )    CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print
-      !
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      !------------------------------------------------!
-      !  Transport ice between thickness categories
-      !------------------------------------------------!
-      ! Given thermodynamic growth rates, transport ice between thickness categories.
-      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      IF( jpl > 1 )      CALL lim_itd_th_rem( 1, jpl, kt )
-
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      !------------------------------------------------!
-      !  Add frazil ice growing in leads
-      !------------------------------------------------!
-      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      IF( ln_limdO )     CALL lim_thd_lac
-      
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      ! Control print
-      IF( ln_ctl )       CALL lim_prt3D( 'limthd' )
-      !
-      CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('limthd')
-
-   END SUBROUTINE lim_thd 
-
- 
-   SUBROUTINE lim_thd_temp( kideb, kiut )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_thd_temp *** 
-      !!                 
-      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy
-      !!
-      !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
-      !
-      INTEGER  ::   ji, jk   ! dummy loop indices
-      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar 
-      !!-------------------------------------------------------------------
-      ! Recover ice temperature
-      DO jk = 1, nlay_i
-         DO ji = kideb, kiut
-            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0
-            ! Conversion q(S,T) -> T (second order equation)
-            zaaa          =  cpic
-            zbbb          =  ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus
-            zccc          =  lfus * ( ztmelts - rt0 )
-            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) )
-            t_i_1d(ji,jk) =  rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
-            
-            ! mask temperature
-            rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
-            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
-         END DO 
-      END DO 
-      !
-   END SUBROUTINE lim_thd_temp
-
-
-   SUBROUTINE lim_thd_lam( kideb, kiut )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_thd_lam *** 
-      !!                 
-      !! ** Purpose :   Lateral melting in case monocategory
-      !!                          ( dA = A/2h dh )
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop
-      !
-      INTEGER  ::   ji                 ! dummy loop indices
-      REAL(wp) ::   zhi_bef            ! ice thickness before thermo
-      REAL(wp) ::   zdh_mel, zda_mel   ! net melting
-      REAL(wp) ::   zvi, zvs           ! ice/snow volumes 
-      !!-----------------------------------------------------------------------
-      !
-      DO ji = kideb, kiut
-         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) )
-         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN
-            zvi          = a_i_1d(ji) * ht_i_1d(ji)
-            zvs          = a_i_1d(ji) * ht_s_1d(ji)
-            ! lateral melting = concentration change
-            zhi_bef     = ht_i_1d(ji) - zdh_mel
-            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
-            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
-            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
-            ! adjust thickness
-            ht_i_1d(ji) = zvi / a_i_1d(ji)            
-            ht_s_1d(ji) = zvs / a_i_1d(ji)            
-            ! retrieve total concentration
-            at_i_1d(ji) = a_i_1d(ji)
-         END IF
-      END DO
-      !
-   END SUBROUTINE lim_thd_lam
-
-
-   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_thd_1d2d *** 
-      !!                 
-      !! ** Purpose :   move arrays from 1d to 2d and the reverse
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D   ;   2= from 1D to 2D
-      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays
-      INTEGER, INTENT(in) ::   jl       ! ice cat
-      !
-      INTEGER             ::   jk       ! dummy loop indices
-      !!-----------------------------------------------------------------------
-      !
-      SELECT CASE( kn )
-      !
-      CASE( 1 )            ! from 2D to 1D
-         !
-         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-         !
-         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-         DO jk = 1, nlay_s
-            CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-         END DO
-         DO jk = 1, nlay_i
-            CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-         END DO
-         !
-         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) ) 
-         CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) )
-         !
-         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) )
-         !
-         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) )
-         !
-         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub         , jpi, jpj,npb(1:nbpb) )
-         !
-         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) )
-         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
-         !
-      CASE( 2 )            ! from 1D to 2D
-         !
-         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj )
-         DO jk = 1, nlay_s
-            CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj)
-            CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj)
-         END DO
-         DO jk = 1, nlay_i
-            CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj)
-            CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj)
-            CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj)
-         END DO
-         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
-         !
-         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj )
-         !
-         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj )
-         !
-         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, sfx_sub       , npb, sfx_sub_1d(1:nbpb)   , jpi, jpj )        
-         !
-         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj )
-         CALL tab_1d_2d( nbpb, hfx_err_dif   , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj )
-         !
-         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
-         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
-         !         
-      END SELECT
-      !
-   END SUBROUTINE lim_thd_1d2d
-
-
-   SUBROUTINE lim_thd_init
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_thd_init *** 
-      !!                 
-      !! ** Purpose :   Physical constants and parameters linked to the ice 
-      !!              thermodynamics
-      !!
-      !! ** Method  :   Read the namicethd namelist and check the ice-thermo
-      !!              parameter values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namicether
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, ln_it_qnsice, nn_monocat, rn_cdsn,  &
-         &                ln_limdH, rn_betas,                                                                     &
-         &                ln_limdA, rn_beta, rn_dmin,                                                             &
-         &                ln_limdO, rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, rn_himin
-      !!-------------------------------------------------------------------
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namicethd in reference namelist : Ice thermodynamics
-      READ  ( numnam_ice_ref, namicethd, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicethd in configuration namelist : Ice thermodynamics
-      READ  ( numnam_ice_cfg, namicethd, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicethd )
-      !
-      IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN 
-         nn_monocat = 0
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '   nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen'
-      ENDIF
-      !
-      IF(lwp) THEN                          ! control print
-         WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics'
-         WRITE(numout,*) '~~~~~~~~~~~~~'
-         WRITE(numout,*)'   -- limthd_dif --'
-         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i
-         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif
-         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif
-         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon
-         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice
-         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat
-         WRITE(numout,*)'      thermal conductivity of the snow                        rn_cdsn      = ', rn_cdsn
-         WRITE(numout,*)'   -- limthd_dh --'
-         WRITE(numout,*)'      activate ice thick change from top/bot (T) or not (F)   ln_limdH     = ', ln_limdH
-         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas
-         WRITE(numout,*)'   -- limthd_da --'
-         WRITE(numout,*)'      activate lateral melting (T) or not (F)                 ln_limdA     = ', ln_limdA
-         WRITE(numout,*)'      Coef. beta for lateral melting param.                   rn_beta      = ', rn_beta
-         WRITE(numout,*)'      Minimum floe diameter for lateral melting param.        rn_dmin      = ', rn_dmin
-         WRITE(numout,*)'   -- limthd_lac --'
-         WRITE(numout,*)'      activate ice growth in open-water (T) or not (F)        ln_limdO     = ', ln_limdO
-         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice
-         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       ln_frazil    = ', ln_frazil
-         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   rn_maxfrazb  = ', rn_maxfrazb
-         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  rn_vfrazb    = ', rn_vfrazb
-         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          rn_Cfrazb    = ', rn_Cfrazb
-         WRITE(numout,*)'   -- limitd_th --'
-         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin 
-         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i
-      ENDIF
-      !
-   END SUBROUTINE lim_thd_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Dummy module          NO  LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-#endif
-
-   !!======================================================================
-END MODULE limthd
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90	(revision 8568)
+++ 	(revision )
@@ -1,183 +1,0 @@
-MODULE limthd_da
-   !!======================================================================
-   !!                       ***  MODULE limthd_da ***
-   !! LIM-3 sea-ice :  computation of lateral melting in the ice
-   !!======================================================================
-   !! History :   4.0   ! 2016-03 (C. Rousset) original code
-   !!---------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_thd_da   : sea ice lateral melting
-   !!----------------------------------------------------------------------
-   USE par_oce                ! ocean parameters
-   USE phycst                 ! physical constants (ocean directory)
-   USE sbc_oce, ONLY: sst_m   ! Surface boundary condition: ocean fields
-   USE ice                    ! LIM variables
-   USE lib_mpp                ! MPP library
-   USE wrk_nemo               ! work arrays
-   USE lib_fortran            ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_thd_da        ! called by limthd module
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id: limthd_da.F90 5123 2015-03-04 16:06:03Z clem $
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_thd_da
-      !!-------------------------------------------------------------------
-      !!                ***  ROUTINE lim_thd_da  ***    
-      !!   
-      !! ** Purpose :   computes sea ice lateral melting
-      !!
-      !! ** Method  :   dA/dt = - P * W   [s-1]
-      !!                   W = melting velocity [m.s-1]
-      !!                   P = perimeter of ice-ocean lateral interface normalized by grid cell area [m.m-2]
-      !!
-      !!                   W = m1 * (Tw -Tf)**m2                    --- originally from Josberger 1979 ---
-      !!                      (Tw - Tf) = elevation of water temp above freezing
-      !!                      m1 and m2 = (1.6e-6 , 1.36) best fit from field experiment near the coast of Prince Patrick Island (Perovich 1983) => static ice
-      !!                      m1 and m2 = (3.0e-6 , 1.36) best fit from MIZEX 84 experiment (Maykut and Perovich 1987) => moving ice
-      !!
-      !!                   P = N * pi * D                           --- from Rothrock and Thorndike 1984 ---
-      !!                      D = mean floe caliper diameter
-      !!                      N = number of floes = ice area / floe area(average) = A / (Cs * D**2)
-      !!                         A = ice concentration
-      !!                         Cs = deviation from a square (square:Cs=1 ; circle:Cs=pi/4 ; floe:Cs=0.66)
-      !!
-      !!                   D = Dmin * ( Astar / (Astar-A) )**beta   --- from Lupkes et al., 2012 (eq. 26-27) ---
-      !!                                                             
-      !!                      Astar = 1 / ( 1 - (Dmin/Dmax)**(1/beta) )
-      !!                      Dmin = minimum floe diameter (recommended to be 8m +- 20%)
-      !!                      Dmax = maximum floe diameter (recommended to be 300m, but it does not impact melting much except for Dmax<100m)
-      !!                      beta = 1.0 +-20% (recommended value)
-      !!                           = 0.3 best fit for western Fram Strait and Antarctica
-      !!                           = 1.4 best fit for eastern Fram Strait
-      !!
-      !! ** Tunable parameters  :   We propose to tune the lateral melting via 2 parameters
-      !!                               Dmin [6-10m]   => 6  vs 8m = +40% melting at the peak (A~0.5)
-      !!                                                 10 vs 8m = -20% melting
-      !!                               beta [0.8-1.2] => decrease = more melt and melt peaks toward higher concentration
-      !!                                                                  (A~0.5 for beta=1 ; A~0.8 for beta=0.2)
-      !!                                                 0.3 = best fit for western Fram Strait and Antarctica
-      !!                                                 1.4 = best fit for eastern Fram Strait
-      !!
-      !! ** Note   :   Former and more simple formulations for floe diameters can be found in Mai (1995), 
-      !!               Birnbaum and Lupkes (2002), Lupkes and Birnbaum (2005). They are reviewed in Lupkes et al 2012
-      !!               A simpler implementation for CICE can be found in Bitz et al (2001) and Tsamados et al (2015)
-      !!
-      !! ** References
-      !!    Bitz, C. M., Holland, M. M., Weaver, A. J., & Eby, M. (2001).
-      !!              Simulating the ice‐thickness distribution in a coupled climate model.
-      !!              Journal of Geophysical Research: Oceans, 106(C2), 2441-2463.
-      !!    Josberger, E. G. (1979).
-      !!              Laminar and turbulent boundary layers adjacent to melting vertical ice walls in salt water
-      !!              (No. SCIENTIFIC-16). WASHINGTON UNIV SEATTLE DEPT OF ATMOSPHERIC SCIENCES.
-      !!    Lüpkes, C., Gryanik, V. M., Hartmann, J., & Andreas, E. L. (2012).
-      !!              A parametrization, based on sea ice morphology, of the neutral atmospheric drag coefficients
-      !!              for weather prediction and climate models.
-      !!              Journal of Geophysical Research: Atmospheres, 117(D13).
-      !!    Maykut, G. A., & Perovich, D. K. (1987).
-      !!              The role of shortwave radiation in the summer decay of a sea ice cover.
-      !!              Journal of Geophysical Research: Oceans, 92(C7), 7032-7044.
-      !!    Perovich, D. K. (1983).
-      !!              On the summer decay of a sea ice cover. (Doctoral dissertation, University of Washington).
-      !!    Rothrock, D. A., & Thorndike, A. S. (1984).
-      !!              Measuring the sea ice floe size distribution.
-      !!              Journal of Geophysical Research: Oceans, 89(C4), 6477-6486.
-      !!    Tsamados, M., Feltham, D., Petty, A., Schroeder, D., & Flocco, D. (2015).
-      !!              Processes controlling surface, bottom and lateral melt of Arctic sea ice in a state of the art sea ice model.
-      !!              Phil. Trans. R. Soc. A, 373(2052), 20140167.
-      !!---------------------------------------------------------------------
-      INTEGER             ::   ji, jj, jl      ! dummy loop indices
-      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda
-      REAL(wp), PARAMETER ::   zdmax = 300._wp
-      REAL(wp), PARAMETER ::   zcs   = 0.66_wp
-      REAL(wp), PARAMETER ::   zm1   = 3.e-6_wp
-      REAL(wp), PARAMETER ::   zm2   = 1.36_wp
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zda_tot
-      !!---------------------------------------------------------------------
-      CALL wrk_alloc( jpi,jpj, zda_tot )
-
-      !------------------------------------------------------------!
-      ! --- Calculate reduction of total sea ice concentration --- !
-      !------------------------------------------------------------!
-      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) )
-      
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            
-            ! Mean floe caliper diameter [m]
-            zdfloe = rn_dmin * ( zastar / ( zastar - at_i(ji,jj) ) )**rn_beta
-            
-            ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2]
-            zperi = at_i(ji,jj) * rpi / ( zcs * zdfloe )
-            
-            ! Melt speed rate [m/s]
-            zwlat = zm1 * ( MAX( 0._wp, sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) )**zm2
-            
-            ! sea ice concentration decrease
-            zda_tot(ji,jj) = - MIN( zwlat * zperi * rdt_ice, at_i(ji,jj) )
-            
-         END DO
-      END DO
-      
-      !---------------------------------------------------------------------------------------------!
-      ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- !
-      !---------------------------------------------------------------------------------------------!
-      DO jl = jpl, 1, -1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               
-               ! decrease of concentration for the category jl
-               !    1st option: each category contributes to melting in proportion to its concentration
-               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj) - epsi10 ) )
-               zda     = rswitch * zda_tot(ji,jj) * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi10 )
-               !    2d option: melting of the upper cat first
-               !!zda = MAX( zda_tot(ji,jj), - a_i(ji,jj,jl) )
-               !!zda_tot(ji,jj) = zda_tot(ji,jj) + zda
-               
-               ! Contribution to salt flux
-               sfx_lam(ji,jj) = sfx_lam(ji,jj) - rhoic *  ht_i(ji,jj,jl) * zda * sm_i(ji,jj,jl) * r1_rdtice
-               
-               ! Contribution to heat flux into the ocean [W.m-2], <0  
-               hfx_thd(ji,jj) = hfx_thd(ji,jj) + zda * r1_rdtice * ( ht_i(ji,jj,jl) * SUM( e_i(ji,jj,:,jl) ) * r1_nlay_i  &
-                  &                                                + ht_s(ji,jj,jl) *      e_s(ji,jj,1,jl)   * r1_nlay_s )
-               
-               ! Contribution to mass flux
-               wfx_lam(ji,jj) =  wfx_lam(ji,jj) - zda * r1_rdtice * ( rhoic * ht_i(ji,jj,jl) + rhosn * ht_s(ji,jj,jl) )
-               
-               ! new concentration
-               a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda
-            END DO
-         END DO
-      END DO
-      
-      ! total concentration
-      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-      
-      ! --- ensure that ht_i = 0 where a_i = 0 ---
-      WHERE( a_i == 0._wp ) ht_i = 0._wp
-      !
-      CALL wrk_dealloc( jpi,jpj, zda_tot )
-      !
-   END SUBROUTINE lim_thd_da
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Dummy Module          No LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_thd_da          ! Empty routine
-   END SUBROUTINE lim_thd_da
-#endif
-   !!======================================================================
-END MODULE limthd_da
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 8568)
+++ 	(revision )
@@ -1,719 +1,0 @@
-MODULE limthd_dh
-   !!======================================================================
-   !!                       ***  MODULE limthd_dh ***
-   !!  LIM-3 :   thermodynamic growth and decay of the ice 
-   !!======================================================================
-   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D
-   !!                 ! 2005-06 (M. Vancoppenolle) 3D version 
-   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice
-   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
-   !!            3.5  ! 2012-10 (G. Madec & co) salt flux + bug fixes 
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_thd_dh    : vertical accr./abl. and lateral ablation of sea ice
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE phycst         ! physical constants (OCE directory) 
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE ice            ! LIM variables
-   USE thd_ice        ! LIM thermodynamics
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_thd_dh      ! called by lim_thd
-   PUBLIC   lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here
-
-   INTERFACE lim_thd_snwblow
-      MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d
-   END INTERFACE
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_thd_dh( kideb, kiut )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_thd_dh  ***
-      !!
-      !! ** Purpose :   determines variations of ice and snow thicknesses.
-      !!
-      !! ** Method  :   Ice/Snow surface melting arises from imbalance in surface fluxes
-      !!              Bottom accretion/ablation arises from flux budget
-      !!              Snow thickness can increase by precipitation and decrease by sublimation
-      !!              If snow load excesses Archmiede limit, snow-ice is formed by
-      !!              the flooding of sea-water in the snow
-      !!
-      !!                 1) Compute available flux of heat for surface ablation
-      !!                 2) Compute snow and sea ice enthalpies
-      !!                 3) Surface ablation and sublimation
-      !!                 4) Bottom accretion/ablation
-      !!                 5) Case of Total ablation
-      !!                 6) Snow ice formation
-      !!
-      !! References : Bitz and Lipscomb, 1999, J. Geophys. Res.
-      !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646   
-      !!              Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let. 
-      !!              Vancoppenolle et al.,2009, Ocean Modelling
-      !!------------------------------------------------------------------
-      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied
-      !! 
-      INTEGER  ::   ji , jk        ! dummy loop indices
-      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji
-      INTEGER  ::   iter
-
-      REAL(wp) ::   ztmelts             ! local scalar
-      REAL(wp) ::   zdum       
-      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
-      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity
-      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity
-      REAL(wp) ::   zswi2        ! switch for computation of bottom salinity
-      REAL(wp) ::   zgrr         ! bottom growth rate
-      REAL(wp) ::   zt_i_new     ! bottom formation temperature
-
-      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean
-      REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg)
-      REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg)
-      REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg)
-      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean
-      REAL(wp) ::   zsstK        ! SST in Kelvin
-
-      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
-
-      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt 
-      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre   ! snow precipitation 
-      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_sub   ! snow sublimation
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness
-      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting 
-
-      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing
-
-      REAL(wp) :: zswitch_sal
-
-      ! Heat conservation 
-      INTEGER  ::   num_iter_max
-
-      !!------------------------------------------------------------------
-
-      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values)
-      SELECT CASE( nn_icesal )                  ! varying salinity or not
-         CASE( 1, 3 ) ;   zswitch_sal = 0       ! prescribed salinity profile
-         CASE( 2 )    ;   zswitch_sal = 1       ! varying salinity profile
-      END SELECT
-
-      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
-      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )
-      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )
-      CALL wrk_alloc( jpij, nlay_i, icount )
-       
-      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp
-      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp ; zevap_rema(:) = 0._wp ;
-      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp
-
-      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp       
-      icount (:,:) = 0
-
-      ! Initialize enthalpy at nlay_i+1
-      DO ji = kideb, kiut
-         q_i_1d(ji,nlay_i+1) = 0._wp
-      END DO
-
-      ! initialize layer thicknesses and enthalpies
-      h_i_old (:,0:nlay_i+1) = 0._wp
-      qh_i_old(:,0:nlay_i+1) = 0._wp
-      DO jk = 1, nlay_i
-         DO ji = kideb, kiut
-            h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i
-            qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk)
-         ENDDO
-      ENDDO
-      !
-      !------------------------------------------------------------------------------!
-      !  1) Calculate available heat for surface and bottom ablation                 !
-      !------------------------------------------------------------------------------!
-      !
-      DO ji = kideb, kiut
-         zdum       = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
-         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
-
-         zq_su (ji) = MAX( 0._wp, zdum      * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
-         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
-      END DO
-
-      !
-      !------------------------------------------------------------------------------!
-      ! If snow temperature is above freezing point, then snow melts 
-      ! (should not happen but sometimes it does)
-      !------------------------------------------------------------------------------!
-      DO ji = kideb, kiut
-         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting
-            ! Contribution to heat flux to the ocean [W.m-2], < 0  
-            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
-            ! Contribution to mass flux
-            wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
-            ! updates
-            ht_s_1d(ji)   = 0._wp
-            q_s_1d (ji,1) = 0._wp
-            t_s_1d (ji,1) = rt0
-         END IF
-      END DO
-
-      !------------------------------------------------------------!
-      !  2) Computing layer thicknesses and enthalpies.            !
-      !------------------------------------------------------------!
-      !
-      DO jk = 1, nlay_i
-         DO ji = kideb, kiut
-            zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i
-            zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk)
-         END DO
-      END DO
-      !
-      !------------------------------------------------------------------------------|
-      !  3) Surface ablation and sublimation                                         |
-      !------------------------------------------------------------------------------|
-      !
-      !-------------------------
-      ! 3.1 Snow precips / melt
-      !-------------------------
-      ! Snow accumulation in one thermodynamic time step
-      ! snowfall is partitionned between leads and ice
-      ! if snow fall was uniform, a fraction (1-at_i) would fall into leads
-      ! but because of the winds, more snow falls on leads than on sea ice
-      ! and a greater fraction (1-at_i)^beta of the total mass of snow 
-      ! (beta < 1) falls in leads.
-      ! In reality, beta depends on wind speed, 
-      ! and should decrease with increasing wind speed but here, it is 
-      ! considered as a constant. an average value is 0.66
-      ! Martin Vancoppenolle, December 2006
-
-      CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing
-
-      zdeltah(:,:) = 0._wp
-      DO ji = kideb, kiut
-         !-----------
-         ! Snow fall
-         !-----------
-         ! thickness change
-         zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji)
-         ! enthalpy of the precip (>0, J.m-3)
-         zqprec   (ji) = - qprec_ice_1d(ji)   
-         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp
-         ! heat flux from snow precip (>0, W.m-2)
-         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
-         ! mass flux, <0
-         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice
-
-         !---------------------
-         ! Melt of falling snow
-         !---------------------
-         ! thickness change
-         rswitch        = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) )
-         zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
-         zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting 
-         ! heat used to melt snow (W.m-2, >0)
-         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
-         ! snow melting only = water into the ocean (then without snow precip), >0
-         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice    
-         ! updates available heat + precipitations after melting
-         zq_su     (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )      
-         zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1)
-
-         ! update thickness
-         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
-      END DO
-
-      ! If heat still available (zq_su > 0), then melt more snow
-      zdeltah(:,:) = 0._wp
-      DO jk = 1, nlay_s
-         DO ji = kideb, kiut
-            ! thickness change
-            rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) 
-            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) ) 
-            zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 )
-            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting
-            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)    
-            ! heat used to melt snow(W.m-2, >0)
-            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * q_s_1d(ji,jk) * r1_rdtice 
-            ! snow melting only = water into the ocean (then without snow precip)
-            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-            ! updates available heat + thickness
-            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
-            ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) )
-         END DO
-      END DO
-
-      !------------------------------
-      ! 3.2 Sublimation (part1: snow) 
-      !------------------------------
-      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
-      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean)
-      zdeltah(:,:) = 0._wp
-      DO ji = kideb, kiut
-         zdh_s_sub(ji)  = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
-         ! remaining evap in kg.m-2 (used for ice melting later on)
-         zevap_rema(ji)  = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhosn
-         ! Heat flux by sublimation [W.m-2], < 0 (sublimate first snow that had fallen, then pre-existing snow)
-         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
-         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  &
-            &                              ) * a_i_1d(ji) * r1_rdtice
-         ! Mass flux by sublimation
-         wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
-         ! new snow thickness
-         ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
-         ! update precipitations after sublimation and correct sublimation
-         zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1)
-         zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1)
-      END DO
-      
-      ! --- Update snow diags --- !
-      DO ji = kideb, kiut
-         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
-      END DO
-
-      !-------------------------------------------
-      ! 3.3 Update temperature, energy
-      !-------------------------------------------
-      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow)
-      DO jk = 1, nlay_s
-         DO ji = kideb,kiut
-            rswitch       = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) )
-            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *           &
-              &            ( ( zdh_s_pre(ji)               ) * zqprec(ji) +  &
-              &              ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
-         END DO
-      END DO
-
-      !--------------------------
-      ! 3.4 Surface ice ablation 
-      !--------------------------
-      zdeltah(:,:) = 0._wp ! important
-      DO jk = 1, nlay_i
-         DO ji = kideb, kiut
-            ztmelts           = - tmut * s_i_1d(ji,jk) + rt0          ! Melting point of layer k [K]
-            
-            IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
-
-               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]       
-               zdE            = 0._wp                                 ! Specific enthalpy difference   (J/kg, <0)
-                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted)
-               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing     
-                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this
-               zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0
-                         
-               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
-               
-               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
-
-               ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
-               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
-               
-               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
-               
-               ! Contribution to mass flux
-               wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-
-            ELSE                                !!! Surface melting
-               
-               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]
-               zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0]
-               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
-               
-               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0]
-               
-               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0]
-               
-               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
-               
-               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
-               
-               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
-               
-               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
-               
-               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
-               
-               ! Contribution to salt flux >0 (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
-               
-               ! Contribution to heat flux [W.m-2], < 0
-               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
-               
-               ! Total heat flux used in this process [W.m-2], > 0  
-               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
-               
-               ! Contribution to mass flux
-               wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-               
-            END IF
-            ! ----------------------
-            ! Sublimation part2: ice
-            ! ----------------------
-            zdum      = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoic )
-            zdeltah(ji,jk) = zdeltah(ji,jk) + zdum
-            dh_i_sub(ji)  = dh_i_sub(ji) + zdum
-            ! Salt flux > 0 (clem2016: flux is sent to the ocean for simplicity but salt should remain in the ice except if all ice is melted.
-            !                          It must be corrected at some point)
-            sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * sm_i_1d(ji) * r1_rdtice
-            ! Heat flux [W.m-2], < 0
-            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zdum * q_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice
-            ! Mass flux > 0
-            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * r1_rdtice
-            ! update remaining mass flux
-            zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoic
-            
-            ! record which layers have disappeared (for bottom melting) 
-            !    => icount=0 : no layer has vanished
-            !    => icount=5 : 5 layers have vanished
-            rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
-            icount(ji,jk) = NINT( rswitch )
-            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
-                        
-            ! update heat content (J.m-2) and layer thickness
-            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
-            h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
-         END DO
-      END DO
-      ! update ice thickness
-      DO ji = kideb, kiut
-         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) + dh_i_sub(ji) )
-      END DO
-
-      ! remaining "potential" evap is sent to ocean
-      DO ji = kideb, kiut
-         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         wfx_err_sub(ii,ij) = wfx_err_sub(ii,ij) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
-      END DO
-
-      !
-      !------------------------------------------------------------------------------!
-      ! 4) Basal growth / melt                                                       !
-      !------------------------------------------------------------------------------!
-      !
-      !------------------
-      ! 4.1 Basal growth 
-      !------------------
-      ! Basal growth is driven by heat imbalance at the ice-ocean interface,
-      ! between the inner conductive flux  (fc_bo_i), from the open water heat flux 
-      ! (fhld) and the turbulent ocean flux (fhtur). 
-      ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice 
-
-      ! If salinity varies in time, an iterative procedure is required, because
-      ! the involved quantities are inter-dependent.
-      ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi),
-      ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott)
-      ! -> need for an iterative procedure, which converges quickly
-
-      num_iter_max = 1
-      IF( nn_icesal == 2 ) num_iter_max = 5
-
-      ! Iterative procedure
-      DO iter = 1, num_iter_max
-         DO ji = kideb, kiut
-            IF(  zf_tt(ji) < 0._wp  ) THEN
-
-               ! New bottom ice salinity (Cox & Weeks, JGR88 )
-               !--- zswi1  if dh/dt < 2.0e-8
-               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 
-               !--- zswi2  if dh/dt > 3.6e-7
-               zgrr               = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) )
-               zswi2              = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) )
-               zswi12             = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 )
-               zswi1              = 1. - zswi2 * zswi12
-               zfracs             = MIN ( zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   &
-                  &               + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 )
-
-               ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-
-               s_i_new(ji)        = zswitch_sal * zfracs * sss_m(ii,ij)  &  ! New ice salinity
-                                  + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
-               ! New ice growth
-               ztmelts            = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
-
-               zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
-               
-               zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
-                  &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
-                  &               + rcp  * ( ztmelts-rt0 )          
-
-               zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
-
-               zdE                = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
-
-               dh_i_bott(ji)      = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) )
-
-               q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0)
-               
-            ENDIF
-         END DO
-      END DO
-
-      ! Contribution to Energy and Salt Fluxes
-      DO ji = kideb, kiut
-         IF(  zf_tt(ji) < 0._wp  ) THEN
-            ! New ice growth
-                                    
-            zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0)
-
-            ztmelts        = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
-            
-            zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
-            
-            zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
-               &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
-               &               + rcp  * ( ztmelts-rt0 )          
-            
-            zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
-            
-            zdE            = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
-            
-            ! Contribution to heat flux to the ocean [W.m-2], >0  
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
-
-            ! Total heat flux used in this process [W.m-2], <0  
-            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
-            
-            ! Contribution to salt flux, <0
-            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice
-
-            ! Contribution to mass flux, <0
-            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * r1_rdtice
-
-            ! update heat content (J.m-2) and layer thickness
-            qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_1d(ji,nlay_i+1)
-            h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji)
-         ENDIF
-      END DO
-
-      !----------------
-      ! 4.2 Basal melt
-      !----------------
-      zdeltah(:,:) = 0._wp ! important
-      DO jk = nlay_i, 1, -1
-         DO ji = kideb, kiut
-            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting 
-
-               ztmelts = - tmut * s_i_1d(ji,jk) + rt0  ! Melting point of layer jk (K)
-
-               IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
-
-                  zEi               = - q_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0)
-                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0)
-                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted)
-                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing     
-                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this
-
-                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk)
-
-                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0
-
-                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
-                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
-
-                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
-                                    
-                  ! Contribution to mass flux
-                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-
-                  ! update heat content (J.m-2) and layer thickness
-                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
-                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
-
-               ELSE                               !!! Basal melting
-
-                  zEi             = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0)
-                  zEw             = rcp * ( ztmelts - rt0 )    ! Specific enthalpy of meltwater (J/kg, <0)
-                  zdE             = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0)
-
-                  zfmdt           = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0)
-
-                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic         ! Gross thickness change
-
-                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
-                  
-                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
-
-                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt
-
-                  zfmdt           = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
-
-                  zQm             = zfmdt * zEw         ! Heat exchanged with ocean
-
-                  ! Contribution to heat flux to the ocean [W.m-2], <0  
-                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
-
-                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
-                  
-                  ! Total heat flux used in this process [W.m-2], >0  
-                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
-                  
-                  ! Contribution to mass flux
-                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-
-                  ! update heat content (J.m-2) and layer thickness
-                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
-                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
-               ENDIF
-           
-            ENDIF
-         END DO
-      END DO
-
-      !-------------------------------------------
-      ! Update temperature, energy
-      !-------------------------------------------
-      DO ji = kideb, kiut
-         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_bott(ji) )
-      END DO  
-
-      !-------------------------------------------
-      ! 5. What to do with remaining energy
-      !-------------------------------------------
-      ! If heat still available for melting and snow remains, then melt more snow
-      !-------------------------------------------
-      zdeltah(:,:) = 0._wp ! important
-      DO ji = kideb, kiut
-         zq_rema(ji)     = zq_su(ji) + zq_bo(ji) 
-         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow
-         rswitch         = rswitch * MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,1) - epsi20 ) )
-         zdeltah  (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 )
-         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
-         dh_s_tot (ji)   = dh_s_tot(ji)  + zdeltah(ji,1)
-         ht_s_1d   (ji)  = ht_s_1d(ji)   + zdeltah(ji,1)
-        
-         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * q_s_1d(ji,1)                ! update available heat (J.m-2)
-         ! heat used to melt snow
-         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * q_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0)
-         ! Contribution to mass flux
-         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
-         !    
-         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget
-         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
-
-         IF( ln_limctl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
-      END DO
-      
-      !
-      !------------------------------------------------------------------------------|
-      !  6) Snow-Ice formation                                                       |
-      !------------------------------------------------------------------------------|
-      ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level, 
-      ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice
-      DO ji = kideb, kiut
-         !
-         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  )
-
-         ht_i_1d(ji)    = ht_i_1d(ji) + dh_snowice(ji)
-         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji)
-
-         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0)
-         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         zfmdt          = ( rhosn - rhoic ) * dh_snowice(ji)    ! <0
-         zsstK          = sst_m(ii,ij) + rt0                                
-         zEw            = rcp * ( zsstK - rt0 )
-         zQm            = zfmdt * zEw 
-         
-         ! Contribution to heat flux
-         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
-
-         ! Contribution to salt flux
-         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 
-
-         ! virtual salt flux to keep salinity constant
-         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
-            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m     into the ocean
-               &                            - sm_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice    ! and get  rn_icesal from the ocean 
-         ENDIF
-
-         ! Contribution to mass flux
-         ! All snow is thrown in the ocean, and seawater is taken to replace the volume
-         wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice
-         wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice
-
-         ! update heat content (J.m-2) and layer thickness
-         qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_1d(ji,1) + zfmdt * zEw
-         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji)
-         
-      END DO
-
-      !
-      !-------------------------------------------
-      ! Update temperature, energy
-      !-------------------------------------------
-      DO ji = kideb, kiut
-         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
-         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0
-      END DO
-
-      DO jk = 1, nlay_s
-         DO ji = kideb,kiut
-            ! mask enthalpy
-            rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  )
-            q_s_1d(ji,jk) = rswitch * q_s_1d(ji,jk)
-            ! recalculate t_s_1d from q_s_1d
-            t_s_1d(ji,jk) = rt0 + rswitch * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
-         END DO
-      END DO
-
-      ! --- ensure that a_i = 0 where ht_i = 0 ---
-      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp
-      
-      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
-      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )
-      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )
-      CALL wrk_dealloc( jpij, nlay_i, icount )
-      !
-      !
-   END SUBROUTINE lim_thd_dh
-
-
-   !!--------------------------------------------------------------------------
-   !! INTERFACE lim_thd_snwblow
-   !! ** Purpose :   Compute distribution of precip over the ice
-   !!--------------------------------------------------------------------------
-   SUBROUTINE lim_thd_snwblow_2d( pin, pout )
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) )
-      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout
-      pout = ( 1._wp - ( pin )**rn_betas )
-   END SUBROUTINE lim_thd_snwblow_2d
-
-   SUBROUTINE lim_thd_snwblow_1d( pin, pout )
-      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin
-      REAL(wp), DIMENSION(:), INTENT(inout) :: pout
-      pout = ( 1._wp - ( pin )**rn_betas )
-   END SUBROUTINE lim_thd_snwblow_1d
-
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                               NO  LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_thd_dh          ! Empty routine
-   END SUBROUTINE lim_thd_dh
-#endif
-
-   !!======================================================================
-END MODULE limthd_dh
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 8568)
+++ 	(revision )
@@ -1,846 +1,0 @@
-MODULE limthd_dif
-   !!======================================================================
-   !!                       ***  MODULE limthd_dif ***
-   !!                       heat diffusion in sea ice 
-   !!                   computation of surface and inner T  
-   !!======================================================================
-   !! History :  LIM  ! 02-2003 (M. Vancoppenolle) original 1D code
-   !!                 ! 06-2005 (M. Vancoppenolle) 3d version
-   !!                 ! 11-2006 (X Fettweis) Vectorization by Xavier
-   !!                 ! 04-2007 (M. Vancoppenolle) Energy conservation
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE phycst         ! physical constants (ocean directory) 
-   USE ice            ! LIM-3 variables
-   USE thd_ice        ! LIM-3: thermodynamics
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_thd_dif   ! called by lim_thd
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_thd_dif( kideb , kiut )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_thd_dif  ***
-      !! ** Purpose :
-      !!           This routine determines the time evolution of snow and sea-ice 
-      !!           temperature profiles.
-      !! ** Method  :
-      !!           This is done by solving the heat equation diffusion with
-      !!           a Neumann boundary condition at the surface and a Dirichlet one
-      !!           at the bottom. Solar radiation is partially absorbed into the ice.
-      !!           The specific heat and thermal conductivities depend on ice salinity
-      !!           and temperature to take into account brine pocket melting. The 
-      !!           numerical
-      !!           scheme is an iterative Crank-Nicolson on a non-uniform multilayer grid 
-      !!           in the ice and snow system.
-      !!
-      !!           The successive steps of this routine are
-      !!           1.  Thermal conductivity at the interfaces of the ice layers
-      !!           2.  Internal absorbed radiation
-      !!           3.  Scale factors due to non-uniform grid
-      !!           4.  Kappa factors
-      !!           Then iterative procedure begins
-      !!           5.  specific heat in the ice
-      !!           6.  eta factors
-      !!           7.  surface flux computation
-      !!           8.  tridiagonal system terms
-      !!           9.  solving the tridiagonal system with Gauss elimination
-      !!           Iterative procedure ends according to a criterion on evolution
-      !!           of temperature
-      !!
-      !! ** Arguments :
-      !!           kideb , kiut : Starting and ending points on which the 
-      !!                         the computation is applied
-      !!
-      !! ** Inputs / Ouputs : (global commons)
-      !!           surface temperature : t_su_1d
-      !!           ice/snow temperatures   : t_i_1d, t_s_1d
-      !!           ice salinities          : s_i_1d
-      !!           number of layers in the ice/snow: nlay_i, nlay_s
-      !!           profile of the ice/snow layers : z_i, z_s
-      !!           total ice/snow thickness : ht_i_1d, ht_s_1d
-      !!
-      !! ** External : 
-      !!
-      !! ** References :
-      !!
-      !! ** History :
-      !!           (02-2003) Martin Vancoppenolle, Louvain-la-Neuve, Belgium
-      !!           (06-2005) Martin Vancoppenolle, 3d version
-      !!           (11-2006) Vectorized by Xavier Fettweis (UCL-ASTR)
-      !!           (04-2007) Energy conservation tested by M. Vancoppenolle
-      !!------------------------------------------------------------------
-      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied
-
-      !! * Local variables
-      INTEGER ::   ji          ! spatial loop index
-      INTEGER ::   ii, ij      ! temporary dummy loop index
-      INTEGER ::   numeq       ! current reference number of equation
-      INTEGER ::   jk       ! vertical dummy loop index 
-      INTEGER ::   nconv       ! number of iterations in iterative procedure
-      INTEGER ::   minnumeqmin, maxnumeqmax
-      
-      INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation
-      INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation
-      
-      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system
-      REAL(wp) ::   zg1       =  2._wp        !
-      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat
-      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13)
-      REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow
-      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity
-      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C 
-      REAL(wp) ::   ztmelt_i    ! ice melting temperature
-      REAL(wp) ::   zerritmax   ! current maximal error on temperature 
-      REAL(wp) ::   zhsu
-      
-      REAL(wp), POINTER, DIMENSION(:)     ::   isnow       ! switch for presence (1) or absence (0) of snow
-      REAL(wp), POINTER, DIMENSION(:)     ::   ztsub       ! old surface temperature (before the iterative procedure )
-      REAL(wp), POINTER, DIMENSION(:)     ::   ztsubit     ! surface temperature at previous iteration
-      REAL(wp), POINTER, DIMENSION(:)     ::   zh_i        ! ice layer thickness
-      REAL(wp), POINTER, DIMENSION(:)     ::   zh_s        ! snow layer thickness
-      REAL(wp), POINTER, DIMENSION(:)     ::   zfsw        ! solar radiation absorbed at the surface
-      REAL(wp), POINTER, DIMENSION(:)     ::   zqns_ice_b  ! solar radiation absorbed at the surface
-      REAL(wp), POINTER, DIMENSION(:)     ::   zf          ! surface flux function
-      REAL(wp), POINTER, DIMENSION(:)     ::   dzf         ! derivative of the surface flux function
-      REAL(wp), POINTER, DIMENSION(:)     ::   zerrit      ! current error on temperature
-      REAL(wp), POINTER, DIMENSION(:)     ::   zdifcase    ! case of the equation resolution (1->4)
-      REAL(wp), POINTER, DIMENSION(:)     ::   zftrice     ! solar radiation transmitted through the ice
-      REAL(wp), POINTER, DIMENSION(:)     ::   zihic
-      
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztcond_i    ! Ice thermal conductivity
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_i    ! Radiation transmitted through the ice
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_i    ! Radiation absorbed in the ice
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_i    ! Kappa factor in the ice
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztib        ! Old temperature in the ice
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_i      ! Eta factor in the ice
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztitemp     ! Temporary temperature in the ice to check the convergence
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zspeche_i   ! Ice specific heat
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_i         ! Vertical cotes of the layers in the ice
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_s    ! Radiation transmited through the snow
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_s    ! Radiation absorbed in the snow
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_s    ! Kappa factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_s      ! Eta factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztstemp     ! Temporary temperature in the snow to check the convergence
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztsb        ! Temporary temperature in the snow
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_s         ! Vertical cotes of the layers in the snow
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindterm    ! 'Ind'ependent term
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindtbis    ! Temporary 'ind'ependent term
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdiagbis    ! Temporary 'dia'gonal term
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid       ! Tridiagonal system terms
-      
-      ! diag errors on heat
-      REAL(wp), POINTER, DIMENSION(:)     :: zdq, zq_ini, zhfx_err
-      
-      ! Mono-category
-      REAL(wp)                            :: zepsilon      ! determines thres. above which computation of G(h) is done
-      REAL(wp)                            :: zratio_s      ! dummy factor
-      REAL(wp)                            :: zratio_i      ! dummy factor
-      REAL(wp)                            :: zh_thres      ! thickness thres. for G(h) computation
-      REAL(wp)                            :: zhe           ! dummy factor
-      REAL(wp)                            :: zkimean       ! mean sea ice thermal conductivity
-      REAL(wp)                            :: zfac          ! dummy factor
-      REAL(wp)                            :: zihe          ! dummy factor
-      REAL(wp)                            :: zheshth       ! dummy factor
-      
-      REAL(wp), POINTER, DIMENSION(:)     :: zghe          ! G(he), th. conduct enhancement factor, mono-cat
-      
-      !!------------------------------------------------------------------     
-      ! 
-      CALL wrk_alloc( jpij, numeqmin, numeqmax )
-      CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
-      CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
-      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
-      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
-      CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis  )
-      CALL wrk_alloc( jpij,nlay_i+3,3, ztrid )
-
-      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err )
-
-      ! --- diag error on heat diffusion - PART 1 --- !
-      zdq(:) = 0._wp ; zq_ini(:) = 0._wp      
-      DO ji = kideb, kiut
-         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
-            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 
-      END DO
-
-      !------------------------------------------------------------------------------!
-      ! 1) Initialization                                                            !
-      !------------------------------------------------------------------------------!
-      DO ji = kideb , kiut
-         isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ! is there snow or not
-         ! layer thickness
-         zh_i(ji) = ht_i_1d(ji) * r1_nlay_i
-         zh_s(ji) = ht_s_1d(ji) * r1_nlay_s
-      END DO
-
-      !--------------------
-      ! Ice / snow layers
-      !--------------------
-
-      z_s(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st snow layer
-      z_i(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st ice layer
-
-      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer
-         DO ji = kideb , kiut
-            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s
-         END DO
-      END DO
-
-      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer
-         DO ji = kideb , kiut
-            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i
-         END DO
-      END DO
-      !
-      !------------------------------------------------------------------------------|
-      ! 2) Radiation								                                 |
-      !------------------------------------------------------------------------------|
-      !
-      !-------------------
-      ! Computation of i0
-      !-------------------
-      ! i0 describes the fraction of solar radiation which does not contribute
-      ! to the surface energy budget but rather penetrates inside the ice.
-      ! We assume that no radiation is transmitted through the snow
-      ! If there is no no snow
-      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface 
-      ! zftrice = io.qsr_ice       is below the surface 
-      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 
-      ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover
-      zhsu = 0.1_wp ! threshold for the computation of i0
-      DO ji = kideb , kiut
-         ! switches
-         isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 
-         ! hs > 0, isnow = 1
-         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu ) )     
-
-         i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
-      END DO
-
-      !-------------------------------------------------------
-      ! Solar radiation absorbed / transmitted at the surface
-      ! Derivative of the non solar flux
-      !-------------------------------------------------------
-      DO ji = kideb , kiut
-         zfsw   (ji)    =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface
-         zftrice(ji)    =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer
-         dzf    (ji)    = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux 
-         zqns_ice_b(ji) = qns_ice_1d(ji)                     ! store previous qns_ice_1d value
-      END DO
-
-      !---------------------------------------------------------
-      ! Transmission - absorption of solar radiation in the ice
-      !---------------------------------------------------------
-
-      DO ji = kideb, kiut           ! snow initialization
-         zradtr_s(ji,0) = zftrice(ji)     ! radiation penetrating through snow
-      END DO
-
-      DO jk = 1, nlay_s          ! Radiation through snow
-         DO ji = kideb, kiut
-            !                             ! radiation transmitted below the layer-th snow layer
-            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) )
-            !                             ! radiation absorbed by the layer-th snow layer
-            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk)
-         END DO
-      END DO
-
-      DO ji = kideb, kiut           ! ice initialization
-         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) )
-      END DO
-
-      DO jk = 1, nlay_i          ! Radiation through ice
-         DO ji = kideb, kiut
-            !                             ! radiation transmitted below the layer-th ice layer
-            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
-            !                             ! radiation absorbed by the layer-th ice layer
-            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
-         END DO
-      END DO
-
-      DO ji = kideb, kiut           ! Radiation transmitted below the ice
-         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 
-      END DO
-
-      !------------------------------------------------------------------------------|
-      !  3) Iterative procedure begins                                               |
-      !------------------------------------------------------------------------------|
-      !
-      DO ji = kideb, kiut        ! Old surface temperature
-         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr.
-         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter
-         t_su_1d(ji) =  MIN( t_su_1d(ji), rt0 - ztsu_err )       ! necessary
-         zerrit (ji) =  1000._wp                                 ! initial value of error
-      END DO
-
-      DO jk = 1, nlay_s       ! Old snow temperature
-         DO ji = kideb , kiut
-            ztsb(ji,jk) =  t_s_1d(ji,jk)
-         END DO
-      END DO
-
-      DO jk = 1, nlay_i       ! Old ice temperature
-         DO ji = kideb , kiut
-            ztib(ji,jk) =  t_i_1d(ji,jk)
-         END DO
-      END DO
-
-      nconv     =  0           ! number of iterations
-      zerritmax =  1000._wp    ! maximal value of error on all points
-
-      DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif )
-         !
-         nconv = nconv + 1
-         !
-         !------------------------------------------------------------------------------|
-         ! 4) Sea ice thermal conductivity                                              |
-         !------------------------------------------------------------------------------|
-         !
-         IF( nn_ice_thcon == 0 ) THEN      ! Untersteiner (1964) formula
-            DO ji = kideb , kiut
-               ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )
-               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
-            END DO
-            DO jk = 1, nlay_i-1
-               DO ji = kideb , kiut
-                  ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  &
-                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0)
-                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
-               END DO
-            END DO
-         ENDIF
-
-         IF( nn_ice_thcon == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
-            DO ji = kideb , kiut
-               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )   &
-                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rt0 )  
-               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
-            END DO
-            DO jk = 1, nlay_i-1
-               DO ji = kideb , kiut
-                  ztcond_i(ji,jk) = rcdic +                                                                       & 
-                     &                 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                              &
-                     &                 / MIN( -2._wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0 )   &
-                     &               - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0 * rt0 )  
-                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
-               END DO
-            END DO
-            DO ji = kideb , kiut
-               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 )   &
-                  &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 )  
-               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin )
-            END DO
-         ENDIF
-         
-         !
-         !------------------------------------------------------------------------------|
-         !  5) G(he) - enhancement of thermal conductivity in mono-category case        |
-         !------------------------------------------------------------------------------|
-         !
-         ! Computation of effective thermal conductivity G(h)
-         ! Used in mono-category case only to simulate an ITD implicitly
-         ! Fichefet and Morales Maqueda, JGR 1997
-
-         zghe(:) = 1._wp
-
-         SELECT CASE ( nn_monocat )
-
-         CASE (1,3) ! LIM3
-
-            zepsilon = 0.1_wp
-            zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp
-
-            DO ji = kideb, kiut
-   
-               ! Mean sea ice thermal conductivity
-               zkimean  = SUM( ztcond_i(ji,0:nlay_i) ) / REAL( nlay_i+1, wp )
-
-               ! Effective thickness he (zhe)
-               zfac     = 1._wp / ( rn_cdsn + zkimean )
-               zratio_s = rn_cdsn   * zfac
-               zratio_i = zkimean * zfac
-               zhe      = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji)
-
-               ! G(he)
-               rswitch  = MAX( 0._wp , SIGN( 1._wp , zhe - zh_thres ) )  ! =0 if zhe < zh_thres, if >
-               zghe(ji) = ( 1._wp - rswitch ) + rswitch * 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) )
-   
-               ! Impose G(he) < 2.
-               zghe(ji) = MIN( zghe(ji), 2._wp )
-
-            END DO
-
-         END SELECT
-
-         !
-         !------------------------------------------------------------------------------|
-         !  6) kappa factors                                                            |
-         !------------------------------------------------------------------------------|
-         !
-         !--- Snow
-         DO ji = kideb, kiut
-            zfac                  =  1. / MAX( epsi10 , zh_s(ji) )
-            zkappa_s(ji,0)        = zghe(ji) * rn_cdsn * zfac
-            zkappa_s(ji,nlay_s)   = zghe(ji) * rn_cdsn * zfac
-         END DO
-
-         DO jk = 1, nlay_s-1
-            DO ji = kideb , kiut
-               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rn_cdsn / MAX( epsi10, 2.0 * zh_s(ji) )
-            END DO
-         END DO
-
-         !--- Ice
-         DO jk = 1, nlay_i-1
-            DO ji = kideb , kiut
-               zkappa_i(ji,jk)    = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) )
-            END DO
-         END DO
-
-         !--- Snow-ice interface
-         DO ji = kideb , kiut
-            zfac                  = 1./ MAX( epsi10 , zh_i(ji) )
-            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac
-            zkappa_i(ji,nlay_i)   = zghe(ji) * ztcond_i(ji,nlay_i) * zfac
-            zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rn_cdsn * ztcond_i(ji,0) / & 
-           &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rn_cdsn * zh_i(ji) ) )
-            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) )
-         END DO
-
-         !
-         !------------------------------------------------------------------------------|
-         ! 7) Sea ice specific heat, eta factors                                        |
-         !------------------------------------------------------------------------------|
-         !
-         DO jk = 1, nlay_i
-            DO ji = kideb , kiut
-               ztitemp(ji,jk)   = t_i_1d(ji,jk)
-               zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 )
-               zeta_i(ji,jk)    = rdt_ice / MAX( rhoic * zspeche_i(ji,jk) * zh_i(ji), epsi10 )
-            END DO
-         END DO
-
-         DO jk = 1, nlay_s
-            DO ji = kideb , kiut
-               ztstemp(ji,jk) = t_s_1d(ji,jk)
-               zeta_s(ji,jk)  = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 )
-            END DO
-         END DO
-
-         !
-         !------------------------------------------------------------------------------|
-         ! 8) surface flux computation                                                  |
-         !------------------------------------------------------------------------------|
-         !
-         IF ( ln_it_qnsice ) THEN 
-            DO ji = kideb , kiut
-               ! update of the non solar flux according to the update in T_su
-               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) )
-            END DO
-         ENDIF
-
-         ! Update incoming flux
-         DO ji = kideb , kiut
-            ! update incoming flux
-            zf(ji)    =          zfsw(ji)              & ! net absorbed solar radiation
-               &         + qns_ice_1d(ji)                ! non solar total flux (LWup, LWdw, SH, LH)
-         END DO
-
-         !
-         !------------------------------------------------------------------------------|
-         ! 9) tridiagonal system terms                                                  |
-         !------------------------------------------------------------------------------|
-         !
-         !!layer denotes the number of the layer in the snow or in the ice
-         !!numeq denotes the reference number of the equation in the tridiagonal
-         !!system, terms of tridiagonal system are indexed as following :
-         !!1 is subdiagonal term, 2 is diagonal and 3 is superdiagonal one
-
-         !!ice interior terms (top equation has the same form as the others)
-
-         DO numeq=1,nlay_i+3
-            DO ji = kideb , kiut
-               ztrid(ji,numeq,1) = 0.
-               ztrid(ji,numeq,2) = 0.
-               ztrid(ji,numeq,3) = 0.
-               zindterm(ji,numeq)= 0.
-               zindtbis(ji,numeq)= 0.
-               zdiagbis(ji,numeq)= 0.
-            ENDDO
-         ENDDO
-
-         DO numeq = nlay_s + 2, nlay_s + nlay_i 
-            DO ji = kideb , kiut
-               jk                 = numeq - nlay_s - 1
-               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk-1)
-               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) )
-               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk)
-               zindterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk)
-            END DO
-         ENDDO
-
-         numeq =  nlay_s + nlay_i + 1
-         DO ji = kideb , kiut
-            !!ice bottom term
-            ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)   
-            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) )
-            ztrid(ji,numeq,3)  =  0.0
-            zindterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i) *  &
-               &                  ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 *  t_bo_1d(ji) ) 
-         ENDDO
-
-
-         DO ji = kideb , kiut
-            IF ( ht_s_1d(ji) > 0.0 ) THEN
-               !
-               !------------------------------------------------------------------------------|
-               !  snow-covered cells                                                          |
-               !------------------------------------------------------------------------------|
-               !
-               !!snow interior terms (bottom equation has the same form as the others)
-               DO numeq = 3, nlay_s + 1
-                  jk                  =  numeq - 1
-                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk) * zkappa_s(ji,jk-1)
-                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) )
-                  ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk)
-                  zindterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
-               END DO
-
-               !!case of only one layer in the ice (ice equation is altered)
-               IF ( nlay_i.eq.1 ) THEN
-                  ztrid(ji,nlay_s+2,3)    =  0.0
-                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji) 
-               ENDIF
-
-               IF ( t_su_1d(ji) < rt0 ) THEN
-
-                  !------------------------------------------------------------------------------|
-                  !  case 1 : no surface melting - snow present                                  |
-                  !------------------------------------------------------------------------------|
-                  zdifcase(ji)    =  1.0
-                  numeqmin(ji)    =  1
-                  numeqmax(ji)    =  nlay_i + nlay_s + 1
-
-                  !!surface equation
-                  ztrid(ji,1,1)  = 0.0
-                  ztrid(ji,1,2)  = dzf(ji) - zg1s * zkappa_s(ji,0)
-                  ztrid(ji,1,3)  = zg1s * zkappa_s(ji,0)
-                  zindterm(ji,1) = dzf(ji) * t_su_1d(ji) - zf(ji)
-
-                  !!first layer of snow equation
-                  ztrid(ji,2,1)  =  - zkappa_s(ji,0) * zg1s * zeta_s(ji,1)
-                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
-                  ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1)
-                  zindterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1) * zradab_s(ji,1)
-
-               ELSE 
-                  !
-                  !------------------------------------------------------------------------------|
-                  !  case 2 : surface is melting - snow present                                  |
-                  !------------------------------------------------------------------------------|
-                  !
-                  zdifcase(ji)    =  2.0
-                  numeqmin(ji)    =  2
-                  numeqmax(ji)    =  nlay_i + nlay_s + 1
-
-                  !!first layer of snow equation
-                  ztrid(ji,2,1)  =  0.0
-                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
-                  ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1) 
-                  zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *  &
-                     &             ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
-               ENDIF
-            ELSE
-               !
-               !------------------------------------------------------------------------------|
-               !  cells without snow                                                          |
-               !------------------------------------------------------------------------------|
-               !
-               IF ( t_su_1d(ji) < rt0 ) THEN
-                  !
-                  !------------------------------------------------------------------------------|
-                  !  case 3 : no surface melting - no snow                                       |
-                  !------------------------------------------------------------------------------|
-                  !
-                  zdifcase(ji)      =  3.0
-                  numeqmin(ji)      =  nlay_s + 1
-                  numeqmax(ji)      =  nlay_i + nlay_s + 1
-
-                  !!surface equation	
-                  ztrid(ji,numeqmin(ji),1)   =  0.0
-                  ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1    
-                  ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1
-                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji)
-
-                  !!first layer of ice equation
-                  ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1)
-                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
-                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1) * zkappa_i(ji,1)  
-                  zindterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)  
-
-                  !!case of only one layer in the ice (surface & ice equations are altered)
-
-                  IF ( nlay_i == 1 ) THEN
-                     ztrid(ji,numeqmin(ji),1)    =  0.0
-                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0) * 2.0
-                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0) * 2.0
-                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1)
-                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
-                     ztrid(ji,numeqmin(ji)+1,3)  =  0.0
-
-                     zindterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1) *  &
-                        &                          ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )
-                  ENDIF
-
-               ELSE
-
-                  !
-                  !------------------------------------------------------------------------------|
-                  ! case 4 : surface is melting - no snow                                        |
-                  !------------------------------------------------------------------------------|
-                  !
-                  zdifcase(ji)    =  4.0
-                  numeqmin(ji)    =  nlay_s + 2
-                  numeqmax(ji)    =  nlay_i + nlay_s + 1
-
-                  !!first layer of ice equation
-                  ztrid(ji,numeqmin(ji),1)      =  0.0
-                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )  
-                  ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1)
-                  zindterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1) *  &
-                     &                             ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
-
-                  !!case of only one layer in the ice (surface & ice equations are altered)
-                  IF ( nlay_i == 1 ) THEN
-                     ztrid(ji,numeqmin(ji),1)  =  0.0
-                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
-                     ztrid(ji,numeqmin(ji),3)  =  0.0
-                     zindterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )  &
-                        &                       + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0
-                  ENDIF
-
-               ENDIF
-            ENDIF
-
-         END DO
-
-         !
-         !------------------------------------------------------------------------------|
-         ! 10) tridiagonal system solving                                               |
-         !------------------------------------------------------------------------------|
-         !
-
-         ! Solve the tridiagonal system with Gauss elimination method.
-         ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, 
-         ! McGraw-Hill 1984.	
-
-         maxnumeqmax = 0
-         minnumeqmin = nlay_i+5
-
-         DO ji = kideb , kiut
-            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji))
-            zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2)
-            minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin)
-            maxnumeqmax               =  MAX(numeqmax(ji),maxnumeqmax)
-         END DO
-
-         DO jk = minnumeqmin+1, maxnumeqmax
-            DO ji = kideb , kiut
-               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji))
-               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2)  - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3)  / zdiagbis(ji,numeq-1)
-               zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1) * zindtbis(ji,numeq-1) / zdiagbis(ji,numeq-1)
-            END DO
-         END DO
-
-         DO ji = kideb , kiut
-            ! ice temperatures
-            t_i_1d(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji))
-         END DO
-
-         DO numeq = nlay_i + nlay_s, nlay_s + 2, -1
-            DO ji = kideb , kiut
-               jk    =  numeq - nlay_s - 1
-               t_i_1d(ji,jk)  =  ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq)
-            END DO
-         END DO
-
-         DO ji = kideb , kiut
-            ! snow temperatures      
-            IF (ht_s_1d(ji) > 0._wp) &
-               t_s_1d(ji,nlay_s)     =  ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) )  &
-               &                        / zdiagbis(ji,nlay_s+1) * MAX( 0.0, SIGN( 1.0, ht_s_1d(ji) ) ) 
-
-            ! surface temperature
-            isnow(ji)   = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) )
-            ztsubit(ji) = t_su_1d(ji)
-            IF( t_su_1d(ji) < rt0 ) &
-               t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3) *  &
-               &             ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
-         END DO
-         !
-         !--------------------------------------------------------------------------
-         !  11) Has the scheme converged ?, end of the iterative procedure         |
-         !--------------------------------------------------------------------------
-         !
-         ! check that nowhere it has started to melt
-         ! zerrit(ji) is a measure of error, it has to be under terr_dif
-         DO ji = kideb , kiut
-            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , rt0 ) , 190._wp  )
-            zerrit(ji)  =  ABS( t_su_1d(ji) - ztsubit(ji) )     
-         END DO
-
-         DO jk  =  1, nlay_s
-            DO ji = kideb , kiut
-               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rt0 ), 190._wp  )
-               zerrit(ji)    = MAX( zerrit(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) )
-            END DO
-         END DO
-
-         DO jk  =  1, nlay_i
-            DO ji = kideb , kiut
-               ztmelt_i      = -tmut * s_i_1d(ji,jk) + rt0 
-               t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp )
-               zerrit(ji)    =  MAX( zerrit(ji), ABS( t_i_1d(ji,jk) - ztitemp(ji,jk) ) )
-            END DO
-         END DO
-
-         ! Compute spatial maximum over all errors
-         ! note that this could be optimized substantially by iterating only the non-converging points
-         zerritmax = 0._wp
-         DO ji = kideb, kiut
-            zerritmax = MAX( zerritmax, zerrit(ji) )   
-         END DO
-         IF( lk_mpp ) CALL mpp_max( zerritmax, kcom=ncomm_ice )
-
-      END DO  ! End of the do while iterative procedure
-
-      IF( ln_limctl .AND. lwp ) THEN
-         WRITE(numout,*) ' zerritmax : ', zerritmax
-         WRITE(numout,*) ' nconv     : ', nconv
-      ENDIF
-
-      !
-      !-------------------------------------------------------------------------!
-      !   12) Fluxes at the interfaces                                          !
-      !-------------------------------------------------------------------------!
-      DO ji = kideb, kiut
-         !                                ! surface ice conduction flux
-         isnow(ji)       = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )
-         fc_su(ji)       =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
-            &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji))
-         !                                ! bottom ice conduction flux
-         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) )
-      END DO
-
-      ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
-      CALL lim_thd_enmelt( kideb, kiut )
-
-      ! --- diagnose the change in non-solar flux due to surface temperature change --- !
-      IF ( ln_it_qnsice ) THEN
-         DO ji = kideb, kiut
-            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji) 
-         END DO
-      END IF
-
-      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
-      DO ji = kideb, kiut
-         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
-            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )
-         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
-            zhfx_err(ji) = qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
-         ELSE                          ! case T_su = 0degC
-            zhfx_err(ji) = fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
-         ENDIF
-         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
-
-         ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation)
-         hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
-      END DO 
-
-      !-----------------------------------------
-      ! Heat flux used to warm/cool ice in W.m-2
-      !-----------------------------------------
-      DO ji = kideb, kiut
-         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
-            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   &
-               &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
-         ELSE                          ! case T_su = 0degC
-            hfx_dif_1d(ji) = hfx_dif_1d(ji) +    &
-               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
-         ENDIF
-         ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation
-         hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji)
-      END DO   
-      !
-      CALL wrk_dealloc( jpij, numeqmin, numeqmax )
-      CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
-      CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
-      CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
-      CALL wrk_dealloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
-      CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )
-      CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )
-      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )
-
-   END SUBROUTINE lim_thd_dif
-
-   SUBROUTINE lim_thd_enmelt( kideb, kiut )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_thd_enmelt *** 
-      !!                 
-      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature
-      !!
-      !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
-      !
-      INTEGER  ::   ji, jk   ! dummy loop indices
-      REAL(wp) ::   ztmelts  ! local scalar 
-      !!-------------------------------------------------------------------
-      !
-      DO jk = 1, nlay_i             ! Sea ice energy of melting
-         DO ji = kideb, kiut
-            ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0
-            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point
-                                                          !   (sometimes dif scheme produces abnormally high temperatures)   
-            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                           &
-               &                    + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) )   &
-               &                    - rcp  *         ( ztmelts-rt0 )  ) 
-         END DO
-      END DO
-      DO jk = 1, nlay_s             ! Snow energy of melting
-         DO ji = kideb, kiut
-            q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus )
-         END DO
-      END DO
-      !
-   END SUBROUTINE lim_thd_enmelt
-
-#else
-   !!----------------------------------------------------------------------
-   !!                   Dummy Module                 No LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_thd_dif          ! Empty routine
-   END SUBROUTINE lim_thd_dif
-#endif
-   !!======================================================================
-END MODULE limthd_dif
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 8568)
+++ 	(revision )
@@ -1,164 +1,0 @@
-MODULE limthd_ent
-   !!======================================================================
-   !!                       ***  MODULE limthd_ent   ***
-   !!                  Redistribution of Enthalpy in the ice
-   !!                        on the new vertical grid
-   !!                       after vertical growth/decay
-   !!======================================================================
-   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D
-   !!                 ! 2005-07 (M. Vancoppenolle) 3D version 
-   !!                 ! 2006-11 (X. Fettweis) Vectorized 
-   !!            3.0  ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code
-   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
-   !!             -   ! 2014-05 (C. Rousset) complete rewriting
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_thd_ent   : ice redistribution of enthalpy
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE dom_oce        ! domain variables
-   USE domain         !
-   USE phycst         ! physical constants
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE ice            ! LIM variables
-   USE thd_ice        ! LIM thermodynamics
-   USE limvar         ! LIM variables
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_thd_ent         ! called by limthd and limthd_lac
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
- 
-   SUBROUTINE lim_thd_ent( kideb, kiut, qnew )
-      !!-------------------------------------------------------------------
-      !!               ***   ROUTINE lim_thd_ent  ***
-      !!
-      !! ** Purpose :
-      !!           This routine computes new vertical grids in the ice, 
-      !!           and consistently redistributes temperatures. 
-      !!           Redistribution is made so as to ensure to energy conservation
-      !!
-      !!
-      !! ** Method  : linear conservative remapping
-      !!           
-      !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses
-      !!            2) linear remapping on the new layers
-      !!
-      !! ------------ cum0(0)                        ------------- cum1(0)
-      !!                                    NEW      -------------
-      !! ------------ cum0(1)               ==>      -------------
-      !!     ...                                     -------------
-      !! ------------                                -------------
-      !! ------------ cum0(nlay_i+2)                 ------------- cum1(nlay_i)
-      !!
-      !!
-      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005
-      !!-------------------------------------------------------------------
-      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied
-
-      REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew          ! new enthlapies (J.m-3, remapped)
-
-      INTEGER  :: ji         !  dummy loop indices
-      INTEGER  :: jk0, jk1   !  old/new layer indices
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces
-      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces
-      REAL(wp), POINTER, DIMENSION(:)   :: zhnew               ! new layers thicknesses
-      !!-------------------------------------------------------------------
-
-      CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )
-      CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )
-      CALL wrk_alloc( jpij, zhnew )
-
-      !--------------------------------------------------------------------------
-      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
-      !--------------------------------------------------------------------------
-      zqh_cum0(:,0:nlay_i+2) = 0._wp 
-      zh_cum0 (:,0:nlay_i+2) = 0._wp
-      DO jk0 = 1, nlay_i+2
-         DO ji = kideb, kiut
-            zqh_cum0(ji,jk0) = zqh_cum0(ji,jk0-1) + qh_i_old(ji,jk0-1)
-            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1)
-         ENDDO
-      ENDDO
-
-      !------------------------------------
-      !  2) Interpolation on the new layers
-      !------------------------------------
-      ! new layer thickesses
-      DO ji = kideb, kiut
-         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i  
-      ENDDO
-
-      ! new layers interfaces
-      zh_cum1(:,0:nlay_i) = 0._wp
-      DO jk1 = 1, nlay_i
-         DO ji = kideb, kiut
-            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji)
-         ENDDO
-      ENDDO
-
-      zqh_cum1(:,0:nlay_i) = 0._wp 
-      ! new cumulative q*h => linear interpolation
-      DO jk0 = 1, nlay_i+1
-         DO jk1 = 1, nlay_i-1
-            DO ji = kideb, kiut
-               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN
-                  zqh_cum1(ji,jk1) = ( zqh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  &
-                     &                 zqh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  &
-                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) )
-               ENDIF
-            ENDDO
-         ENDDO
-      ENDDO
-      ! to ensure that total heat content is strictly conserved, set:
-      zqh_cum1(:,nlay_i) = zqh_cum0(:,nlay_i+2) 
-
-      ! new enthalpies
-      DO jk1 = 1, nlay_i
-         DO ji = kideb, kiut
-            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 
-            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
-         ENDDO
-      ENDDO
-
-      ! --- diag error on heat remapping --- !
-      ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac), 
-      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0
-      DO ji = kideb, kiut
-         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  &
-            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) ) 
-      END DO
-      
-      !
-      CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )
-      CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )
-      CALL wrk_dealloc( jpij, zhnew )
-      !
-   END SUBROUTINE lim_thd_ent
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                               NO  LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_thd_ent          ! Empty routine
-   END SUBROUTINE lim_thd_ent
-#endif
-
-   !!======================================================================
-END MODULE limthd_ent
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 8568)
+++ 	(revision )
@@ -1,533 +1,0 @@
-MODULE limthd_lac
-   !!======================================================================
-   !!                       ***  MODULE limthd_lac   ***
-   !!                lateral thermodynamic growth of the ice 
-   !!======================================================================
-   !! History :  LIM  ! 2005-12 (M. Vancoppenolle)  Original code
-   !!             -   ! 2006-01 (M. Vancoppenolle)  add ITD
-   !!            3.0  ! 2007-07 (M. Vancoppenolle)  Mass and energy conservation tested
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_lat_acr   : lateral accretion of ice
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE dom_oce        ! domain variables
-   USE phycst         ! physical constants
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbc_ice        ! Surface boundary condition: ice fields
-   USE thd_ice        ! LIM thermodynamics
-   USE ice            ! LIM variables
-   USE limtab         ! LIM 2D <==> 1D
-   USE limcons        ! LIM conservation
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE limthd_ent
-   USE limvar
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC lim_thd_lac     ! called by lim_thd
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_thd_lac
-      !!-------------------------------------------------------------------
-      !!               ***   ROUTINE lim_thd_lac  ***
-      !!  
-      !! ** Purpose : Computation of the evolution of the ice thickness and 
-      !!      concentration as a function of the heat balance in the leads.
-      !!      It is only used for lateral accretion
-      !!       
-      !! ** Method  : Ice is formed in the open water when ocean lose heat
-      !!      (heat budget of open water Bl is negative) .
-      !!      Computation of the increase of 1-A (ice concentration) fol-
-      !!      lowing the law :
-      !!      (dA/dt)acc = F[ (1-A)/(1-a) ] * [ Bl / (Li*h0) ]
-      !!       where - h0 is the thickness of ice created in the lead
-      !!             - a is a minimum fraction for leads
-      !!             - F is a monotonic non-increasing function defined as:
-      !!                  F(X)=( 1 - X**exld )**(1.0/exld)
-      !!             - exld is the exponent closure rate (=2 default val.)
-      !! 
-      !! ** Action : - Adjustment of snow and ice thicknesses and heat
-      !!                content in brine pockets
-      !!             - Updating ice internal temperature
-      !!             - Computation of variation of ice volume and mass
-      !!             - Computation of frldb after lateral accretion and 
-      !!               update ht_s_1d, ht_i_1d and tbif_1d(:,:)      
-      !!------------------------------------------------------------------------
-      INTEGER  ::   ji,jj,jk,jl      ! dummy loop indices
-      INTEGER  ::   nbpac            ! local integers 
-      INTEGER  ::   ii, ij, iter     !   -       -
-      REAL(wp) ::   ztmelts, zdv, zfrazb, zweight, zde                          ! local scalars
-      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      -
-      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      -
-      CHARACTER (len = 15) :: fieldid
-
-      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean)
-      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg)
-      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg)
-      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean)
-     
-      REAL(wp) ::   zv_newfra
-  
-      INTEGER , POINTER, DIMENSION(:) ::   jcat        ! indexes of categories where new ice grows
-      REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not
-
-      REAL(wp), POINTER, DIMENSION(:) ::   zv_newice   ! volume of accreted ice
-      REAL(wp), POINTER, DIMENSION(:) ::   za_newice   ! fractional area of accreted ice
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_newice   ! thickness of accreted ice
-      REAL(wp), POINTER, DIMENSION(:) ::   ze_newice   ! heat content of accreted ice
-      REAL(wp), POINTER, DIMENSION(:) ::   zs_newice   ! salinity of accreted ice
-      REAL(wp), POINTER, DIMENSION(:) ::   zo_newice   ! age of accreted ice
-      REAL(wp), POINTER, DIMENSION(:) ::   zdv_res     ! residual volume in case of excessive heat budget
-      REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget
-      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_1d    ! total ice fraction    
-      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb    ! accretion of frazil ice at the ice bottom
-      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector)
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_b      ! old volume of ice in category jl
-      REAL(wp), POINTER, DIMENSION(:,:) ::   za_b      ! old area of ice in category jl
-      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i
-
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d !: 1-D version of e_i
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel     ! relative ice / frazil velocity
-
-      REAL(wp) :: zcai = 1.4e-3_wp                     ! ice-air drag (clem: should be dependent on coupling/forcing used)
-      !!-----------------------------------------------------------------------!
-
-      CALL wrk_alloc( jpij, jcat )   ! integer
-      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
-      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
-      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
-      CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )
-      CALL wrk_alloc( jpi,jpj, zvrel )
-
-      CALL lim_var_agg(1)
-      CALL lim_var_glo2eqv
-      !------------------------------------------------------------------------------|
-      ! 2) Convert units for ice internal energy
-      !------------------------------------------------------------------------------|
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !Energy of melting q(S,T) [J.m-3]
-                  rswitch          = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )   !0 if no ice
-                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp )
-               END DO
-            END DO
-         END DO
-      END DO
-
-      !------------------------------------------------------------------------------!
-      ! 3) Collection thickness of ice formed in leads and polynyas
-      !------------------------------------------------------------------------------!    
-      ! hicol is the thickness of new ice formed in open water
-      ! hicol can be either prescribed (frazswi = 0) or computed (frazswi = 1)
-      ! Frazil ice forms in open water, is transported by wind
-      ! accumulates at the edge of the consolidated ice edge
-      ! where it forms aggregates of a specific thickness called
-      ! collection thickness.
-
-      ! Note : the following algorithm currently breaks vectorization
-      ! 
-
-      zvrel(:,:) = 0._wp
-
-      ! Default new ice thickness
-      WHERE( qlead(:,:) < 0._wp ) ; hicol(:,:) = rn_hnewice
-      ELSEWHERE                   ; hicol(:,:) = 0._wp
-      END WHERE
-
-      IF( ln_frazil ) THEN
-
-         !--------------------
-         ! Physical constants
-         !--------------------
-         hicol(:,:) = 0._wp
-
-         zhicrit = 0.04 ! frazil ice thickness
-         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav
-         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag)
-         zgamafr = 0.03
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast
-                  !-------------
-                  ! Wind stress
-                  !-------------
-                  ! C-grid wind stress components
-                  ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   &
-                     &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp
-                  ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   &
-                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
-                  ! Square root of wind stress
-                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
-
-                  !---------------------
-                  ! Frazil ice velocity
-                  !---------------------
-                  rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) )
-                  zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 )
-                  zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 )
-
-                  !-------------------
-                  ! Pack ice velocity
-                  !-------------------
-                  ! C-grid ice velocity
-                  zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
-                  zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
-
-                  !-----------------------------------
-                  ! Relative frazil/pack ice velocity
-                  !-----------------------------------
-                  ! absolute relative velocity
-                  rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
-                  zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   &
-                     &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch
-                  zvrel(ji,jj) = SQRT( zvrel2 )
-
-                  !---------------------
-                  ! Iterative procedure
-                  !---------------------
-                  hicol(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    &
-                     &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2
-
-                  iter = 1
-                  DO WHILE ( iter < 20 ) 
-                     zf  = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj) * hicol(ji,jj) - zhicrit * zhicrit ) -   &
-                        &    hicol(ji,jj) * zhicrit * ztwogp * zvrel2
-                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2
-
-                     hicol(ji,jj) = hicol(ji,jj) - zf / MAX( zfp, epsi20 )
-                     iter = iter + 1
-                  END DO
-
-               ENDIF ! end of selection of pixels where ice forms
-
-            END DO 
-         END DO 
-         ! 
-         CALL lbc_lnk( zvrel, 'T', 1. )
-         CALL lbc_lnk( hicol, 'T', 1. )
-
-      ENDIF ! End of computation of frazil ice collection thickness
-
-      !------------------------------------------------------------------------------!
-      ! 4) Identify grid points where new ice forms
-      !------------------------------------------------------------------------------!
-
-      !-------------------------------------
-      ! Select points for new ice formation
-      !-------------------------------------
-      ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice
-      nbpac = 0
-      npac(:) = 0
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN
-               nbpac = nbpac + 1
-               npac( nbpac ) = (jj - 1) * jpi + ji
-            ENDIF
-         END DO
-      END DO
-
-      ! debug point to follow
-      jiindex_1d = 0
-      IF( ln_limctl ) THEN
-         DO ji = mi0(iiceprt), mi1(iiceprt)
-            DO jj = mj0(jiceprt), mj1(jiceprt)
-               IF ( qlead(ji,jj)  <  0._wp ) THEN
-                  jiindex_1d = (jj - 1) * jpi + ji
-               ENDIF
-            END DO
-         END DO
-      ENDIF
-   
-      IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
-
-      !------------------------------
-      ! Move from 2-D to 1-D vectors
-      !------------------------------
-      ! If ocean gains heat do nothing. Otherwise compute new ice formation
-
-      IF ( nbpac > 0 ) THEN
-
-         CALL tab_2d_1d( nbpac, zat_i_1d  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) )
-         DO jl = 1, jpl
-            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
-            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
-            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) )
-            DO jk = 1, nlay_i
-               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) )
-            END DO
-         END DO
-
-         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead     , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo      , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw   , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw   , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol     , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel     , jpi, jpj, npac(1:nbpac) )
-
-         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd   , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw   , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, rn_amax_1d(1:nbpac)     , rn_amax_2d, jpi, jpj, npac(1:nbpac) )
-
-         !------------------------------------------------------------------------------!
-         ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice
-         !------------------------------------------------------------------------------!
-
-         !-----------------------------------------
-         ! Keep old ice areas and volume in memory
-         !-----------------------------------------
-         zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:) 
-         za_b(1:nbpac,:) = za_i_1d(1:nbpac,:)
-
-         !----------------------
-         ! Thickness of new ice
-         !----------------------
-         zh_newice(1:nbpac) = hicol_1d(1:nbpac)
-
-         !----------------------
-         ! Salinity of new ice 
-         !----------------------
-         SELECT CASE ( nn_icesal )
-         CASE ( 1 )                    ! Sice = constant 
-            zs_newice(1:nbpac) = rn_icesal
-         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)]
-            DO ji = 1, nbpac
-               ii =   MOD( npac(ji) - 1 , jpi ) + 1
-               ij =      ( npac(ji) - 1 ) / jpi + 1
-               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij)  )
-            END DO
-         CASE ( 3 )                    ! Sice = F(z) [multiyear ice]
-            zs_newice(1:nbpac) =   2.3
-         END SELECT
-
-         !-------------------------
-         ! Heat content of new ice
-         !-------------------------
-         ! We assume that new ice is formed at the seawater freezing point
-         DO ji = 1, nbpac
-            ztmelts       = - tmut * zs_newice(ji) + rt0                  ! Melting point (K)
-            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                                         &
-               &                       + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   &
-               &                       - rcp  *         ( ztmelts - rt0 )  )
-         END DO
-
-         !----------------
-         ! Age of new ice
-         !----------------
-         DO ji = 1, nbpac
-            zo_newice(ji) = 0._wp
-         END DO
-
-         !-------------------
-         ! Volume of new ice
-         !-------------------
-         DO ji = 1, nbpac
-
-            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg]
-
-            zEw           = rcp * ( t_bo_1d(ji) - rt0 )            ! specific enthalpy of seawater at t_bo_1d [J/kg]
-                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 
-                                                                   
-            zdE           = zEi - zEw                              ! specific enthalpy difference [J/kg]
-                                              
-            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0) 
-                                                                   ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point   
-            zv_newice(ji) = - zfmdt * r1_rhoic
-
-            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux  
-
-            ! Contribution to heat flux to the ocean [W.m-2], >0  
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice
-            ! Total heat flux used in this process [W.m-2]  
-            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice
-            ! mass flux
-            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice
-            ! salt flux
-            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice
-         END DO
-         
-         zv_frazb(:) = 0._wp
-         IF( ln_frazil ) THEN
-            ! A fraction zfrazb of frazil ice is accreted at the ice bottom
-            DO ji = 1, nbpac
-               rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
-               zfrazb        = rswitch * ( TANH( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb
-               zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
-               zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
-            END DO
-         END IF
-         
-         !-----------------
-         ! Area of new ice
-         !-----------------
-         DO ji = 1, nbpac
-            za_newice(ji) = zv_newice(ji) / zh_newice(ji)
-         END DO
-
-         !------------------------------------------------------------------------------!
-         ! 6) Redistribute new ice area and volume into ice categories                  !
-         !------------------------------------------------------------------------------!
-
-         !------------------------
-         ! 6.1) lateral ice growth
-         !------------------------
-         ! If lateral ice growth gives an ice concentration gt 1, then
-         ! we keep the excessive volume in memory and attribute it later to bottom accretion
-         DO ji = 1, nbpac
-            IF ( za_newice(ji) >  ( rn_amax_1d(ji) - zat_i_1d(ji) ) ) THEN
-               zda_res(ji)   = za_newice(ji) - ( rn_amax_1d(ji) - zat_i_1d(ji) )
-               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji) 
-               za_newice(ji) = za_newice(ji) - zda_res  (ji)
-               zv_newice(ji) = zv_newice(ji) - zdv_res  (ji)
-            ELSE
-               zda_res(ji) = 0._wp
-               zdv_res(ji) = 0._wp
-            ENDIF
-         END DO
-
-         ! find which category to fill
-         zat_i_1d(:) = 0._wp
-         DO jl = 1, jpl
-            DO ji = 1, nbpac
-               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN
-                  za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji)
-                  zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji)
-                  jcat    (ji)    = jl
-               ENDIF
-               zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d  (ji,jl)
-            END DO
-         END DO
-
-         ! Heat content
-         DO ji = 1, nbpac
-            jl = jcat(ji)                                                    ! categroy in which new ice is put
-            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice
-         END DO
-
-         DO jk = 1, nlay_i
-            DO ji = 1, nbpac
-               jl = jcat(ji)
-               rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) )
-               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                    &
-                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  &
-                  &        * rswitch / MAX( zv_i_1d(ji,jl), epsi20 )
-            END DO
-         END DO
-
-         !------------------------------------------------
-         ! 6.2) bottom ice growth + ice enthalpy remapping
-         !------------------------------------------------
-         DO jl = 1, jpl
-
-            ! for remapping
-            h_i_old (1:nbpac,0:nlay_i+1) = 0._wp
-            qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp
-            DO jk = 1, nlay_i
-               DO ji = 1, nbpac
-                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i
-                  qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk)
-               END DO
-            END DO
-
-            ! new volumes including lateral/bottom accretion + residual
-            DO ji = 1, nbpac
-               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) )
-               zv_newfra      = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 )
-               za_i_1d(ji,jl) = rswitch * za_i_1d(ji,jl)               
-               zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra
-               ! for remapping
-               h_i_old (ji,nlay_i+1) = zv_newfra
-               qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra
-            ENDDO
-            ! --- Ice enthalpy remapping --- !
-            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 
-         ENDDO
-
-         !-----------------
-         ! Update salinity
-         !-----------------
-         DO jl = 1, jpl
-            DO ji = 1, nbpac
-               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl)
-               zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji)
-            END DO
-         END DO
-
-         !------------------------------------------------------------------------------!
-         ! 7) Change 2D vectors to 1D vectors 
-         !------------------------------------------------------------------------------!
-         DO jl = 1, jpl
-            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj )
-            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj )
-            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj )
-            DO jk = 1, nlay_i
-               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj )
-            END DO
-         END DO
-         CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj )
-         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj )
-
-         CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj )
-         CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj )
-         !
-      ENDIF ! nbpac > 0
-
-      !------------------------------------------------------------------------------!
-      ! 8) Change units for e_i
-      !------------------------------------------------------------------------------!    
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! heat content in J/m2
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
-               END DO
-            END DO
-         END DO
-      END DO
-
-      !
-      CALL wrk_dealloc( jpij, jcat )   ! integer
-      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
-      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
-      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
-      CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )
-      CALL wrk_dealloc( jpi,jpj, zvrel )
-      !
-   END SUBROUTINE lim_thd_lac
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                               NO  LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_thd_lac           ! Empty routine
-   END SUBROUTINE lim_thd_lac
-#endif
-
-   !!======================================================================
-END MODULE limthd_lac
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 8568)
+++ 	(revision )
@@ -1,161 +1,0 @@
-MODULE limthd_sal
-   !!======================================================================
-   !!                       ***  MODULE limthd_sal ***
-   !! LIM-3 sea-ice :  computation of salinity variations in the ice
-   !!======================================================================
-   !! History :   -   ! 2003-05 (M. Vancoppenolle) UCL-ASTR first coding for LIM3-1D
-   !!            3.0  ! 2005-12 (M. Vancoppenolle) adapted to the 3-D version
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!---------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_thd_sal   : salinity variations in the ice
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE phycst         ! physical constants (ocean directory)
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE ice            ! LIM variables
-   USE thd_ice        ! LIM thermodynamics
-   USE limvar         ! LIM variables
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_thd_sal        ! called by limthd module
-   PUBLIC   lim_thd_sal_init   ! called by sbc_lim_init
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_thd_sal( kideb, kiut )
-      !!-------------------------------------------------------------------
-      !!                ***  ROUTINE lim_thd_sal  ***    
-      !!   
-      !! ** Purpose :   computes new salinities in the ice
-      !!
-      !! ** Method  :  3 possibilities
-      !!               -> nn_icesal = 1 -> Sice = cst    [ice salinity constant in both time & space] 
-      !!               -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
-      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice]
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index
-      !
-      INTEGER  ::   ii, ij, ji, jk               ! dummy loop indices 
-      REAL(wp) ::   iflush, igravdr              ! local scalars
-      REAL(wp) ::   zs_sni, zsm_i_gd, zsm_i_fl, zsm_i_si, zsm_i_bg   ! local scalars
-      !!---------------------------------------------------------------------
-
-      !--------------------------------------------------------------------|
-      ! 1) salinity constant in time                                       |
-      !--------------------------------------------------------------------|
-      ! do nothing
-
-      !----------------------------------------------------------------------|
-      !  2) salinity varying in time                                         |
-      !----------------------------------------------------------------------|
-      IF(  nn_icesal == 2  ) THEN
-
-         DO ji = kideb, kiut
-
-            ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-            !---------------------------------------------------------
-            !  Update ice salinity from snow-ice and bottom growth
-            !---------------------------------------------------------
-            zs_sni   = sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic   ! Salinity of snow ice
-            rswitch  = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
-            zsm_i_si = ( zs_sni      - sm_i_1d(ji) ) *             dh_snowice(ji)  / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! snow-ice    
-            zsm_i_bg = ( s_i_new(ji) - sm_i_1d(ji) ) * MAX( 0._wp, dh_i_bott(ji) ) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! bottom growth
-
-            ! Update salinity (nb: salt flux already included in limthd_dh)
-            sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_bg + zsm_i_si
-
-            IF( ln_limdS ) THEN
-               !---------------------------------------------------------
-               !  Update ice salinity from brine drainage and flushing
-               !---------------------------------------------------------
-               iflush   = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0         ) )  ! =1 if summer 
-               igravdr  = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )  ! =1 if t_su < t_bo
-               zsm_i_gd = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice  ! gravity drainage 
-               zsm_i_fl = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice  ! flushing
-               
-               ! Update salinity   
-               sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_fl + zsm_i_gd
-               
-               ! Salt flux
-               sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( zsm_i_fl + zsm_i_gd ) * r1_rdtice
-            ENDIF
-         END DO
-
-         ! Salinity profile
-         CALL lim_var_salprof1d( kideb, kiut )
-         !
-      ENDIF 
-
-      !------------------------------------------------------------------------------|
-      !  3) vertical profile of salinity, constant in time                           |
-      !------------------------------------------------------------------------------|
-      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut )
-
-      !
-   END SUBROUTINE lim_thd_sal
-
-
-   SUBROUTINE lim_thd_sal_init
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_thd_sal_init  ***
-      !!
-      !! ** Purpose :   initialization of ice salinity parameters
-      !!
-      !! ** Method  :   Read the namicesal namelist and check the parameter
-      !!              values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namicesal
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicesal/ ln_limdS, nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd,   &
-         &                rn_sal_fl, rn_time_fl, rn_simax, rn_simin 
-      !!-------------------------------------------------------------------
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namicesal in reference namelist : Ice salinity
-      READ  ( numnam_ice_ref, namicesal, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicesal in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicesal in configuration namelist : Ice salinity
-      READ  ( numnam_ice_cfg, namicesal, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicesal in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicesal )
-      !
-      IF(lwp) THEN                           ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity '
-         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '   activate gravity drainage and flushing (T) or not (F)   ln_limdS   = ', ln_limdS
-         WRITE(numout,*) '   switch for salinity                                     nn_icesal  = ', nn_icesal
-         WRITE(numout,*) '   bulk salinity value if nn_icesal = 1                    rn_icesal  = ', rn_icesal
-         WRITE(numout,*) '   restoring salinity for gravity drainage                 rn_sal_gd  = ', rn_sal_gd
-         WRITE(numout,*) '   restoring time for for gravity drainage                 rn_time_gd = ', rn_time_gd
-         WRITE(numout,*) '   restoring salinity for flushing                         rn_sal_fl  = ', rn_sal_fl
-         WRITE(numout,*) '   restoring time for flushing                             rn_time_fl = ', rn_time_fl
-         WRITE(numout,*) '   Maximum tolerated ice salinity                          rn_simax   = ', rn_simax
-         WRITE(numout,*) '   Minimum tolerated ice salinity                          rn_simin   = ', rn_simin
-      ENDIF
-      !
-   END SUBROUTINE lim_thd_sal_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Dummy Module          No LIM-3 sea-ice model
-   !!----------------------------------------------------------------------
-#endif
-   !!======================================================================
-END MODULE limthd_sal
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 8568)
+++ 	(revision )
@@ -1,545 +1,0 @@
-MODULE limtrp
-   !!======================================================================
-   !!                       ***  MODULE limtrp   ***
-   !! LIM transport ice model : sea-ice advection/diffusion
-   !!======================================================================
-   !! History : LIM-2 ! 2000-01 (M.A. Morales Maqueda, H. Goosse, and T. Fichefet)  Original code
-   !!            3.0  ! 2005-11 (M. Vancoppenolle)   Multi-layer sea ice, salinity variations
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_trp      : advection/diffusion process of sea ice
-   !!----------------------------------------------------------------------
-   USE phycst         ! physical constant
-   USE dom_oce        ! ocean domain
-   USE sbc_oce        ! ocean surface boundary condition
-   USE ice            ! ice variables
-   USE limhdf         ! ice horizontal diffusion
-   USE limvar         ! 
-   USE limadv_prather ! advection scheme (Prather)
-   USE limadv_umx     ! advection scheme (ultimate-macho)
-   !
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! lateral boundary conditions -- MPP exchanges
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE prtctl         ! Print control
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE timing         ! Timing
-   USE limcons        ! conservation tests
-   USE limctl         ! control prints
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_trp    ! called by sbcice_lim
-
-   INTEGER  ::   ncfl                 ! number of ice time step with CFL>1/2  
-
-   !! * Substitution
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_trp( kt ) 
-      !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_trp ***
-      !!                    
-      !! ** purpose : advection/diffusion process of sea ice
-      !!
-      !! ** method  : variables included in the process are scalar,   
-      !!     other values are considered as second order. 
-      !!     For advection, one can choose between
-      !!     a) an Ultimate-Macho scheme (whose order is defined by nn_limadv_ord) => nn_limadv=0
-      !!     b) and a second order Prather scheme => nn_limadv=-1
-      !!
-      !! ** action :
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! number of iteration
-      !
-      INTEGER  ::   ji, jj, jk, jm, jl, jt  ! dummy loop indices
-      INTEGER  ::   initad                  ! number of sub-timestep for the advection
-      REAL(wp) ::   zcfl , zusnit           !   -      -
-      CHARACTER(len=80) :: cltmp
-      !
-      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
-      REAL(wp) ::    zdv, zda
-      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold, zsmvold 
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax, zviold, zvsold
-      ! --- diffusion --- !
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhdfptab
-      INTEGER , PARAMETER                    ::   ihdf_vars  = 6 ! Number of variables in which we apply horizontal diffusion
-                                                                 !  inside limtrp for each ice category , not counting the 
-                                                                 !  variables corresponding to ice_layers 
-      ! --- ultimate macho only --- !
-      REAL(wp)                               ::   zdt
-      REAL(wp), POINTER, DIMENSION(:,:)      ::   zudy, zvdx, zcu_box, zcv_box
-      ! --- prather only --- !
-      REAL(wp), POINTER, DIMENSION(:,:)      ::   zarea
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0opw
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0ice, z0snw, z0ai, z0es , z0smi , z0oi
-      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   z0ei
-      !!
-      !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('limtrp')
-
-      CALL wrk_alloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold )
-      CALL wrk_alloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold )
-      CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)
- 
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)''
-         WRITE(numout,*)'limtrp'
-         WRITE(numout,*)'~~~~~~'
-         ncfl = 0                ! nb of time step with CFL > 1/2
-      ENDIF
-      
-      CALL lim_var_agg( 1 ) ! integrated values + ato_i
-
-      !-------------------------------------!
-      !   Advection of sea ice properties   !
-      !-------------------------------------!
-
-      ! conservation test
-      IF( ln_limdiachk )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-      
-      ! store old values for diag
-      zviold = v_i
-      zvsold = v_s
-      zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 )
-      zeiold (:,:) = et_i
-      zesold (:,:) = et_s 
-
-      !--- Thickness correction init. --- !
-      zatold(:,:) = at_i
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
-               ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-               ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-            END DO
-         END DO
-      END DO
-      ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- !
-      zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:)
-      DO jl = 1, jpl
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) )
-            END DO
-         END DO
-         CALL lbc_lnk(zhimax(:,:,jl),'T',1.)
-      END DO
-         
-      ! --- If ice drift field is too fast, use an appropriate time step for advection --- !        
-      zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )    ! CFL test for stability
-      zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
-      IF( lk_mpp )   CALL mpp_max( zcfl )
-      
-      IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
-      ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
-      ENDIF
-      
-!!      IF( zcfl > 0.5_wp .AND. lwp ) THEN
-!!         ncfl = ncfl + 1
-!!         IF( ncfl > 0 ) THEN   
-!!            WRITE(cltmp,'(i6.1)') ncfl
-!!            CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ')
-!!         ENDIF
-!!      ENDIF
-
-      SELECT CASE ( nn_limadv )
-         
-                       !=============================!
-      CASE ( 0 )       !==  Ultimate-MACHO scheme  ==!                   
-                       !=============================!
-      
-         CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )
-      
-         IF( kt == nit000 .AND. lwp ) THEN
-            WRITE(numout,*)''
-            WRITE(numout,*)'lim_adv_umx : Ultimate-MACHO advection scheme'
-            WRITE(numout,*)'~~~~~~~~~~~'
-         ENDIF
-         !
-         zdt = rdt_ice / REAL(initad)
-         
-         ! transport
-         zudy(:,:) = u_ice(:,:) * e2u(:,:)
-         zvdx(:,:) = v_ice(:,:) * e1v(:,:)
-         
-         ! define velocity for advection: u*grad(H)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               IF    ( u_ice(ji,jj) * u_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp
-               ELSEIF( u_ice(ji,jj)                  >  0._wp ) THEN   ;   zcu_box(ji,jj) = u_ice(ji-1,jj)
-               ELSE                                                    ;   zcu_box(ji,jj) = u_ice(ji  ,jj)
-               ENDIF
-               
-               IF    ( v_ice(ji,jj) * v_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp
-               ELSEIF( v_ice(ji,jj)                  >  0._wp ) THEN   ;   zcv_box(ji,jj) = v_ice(ji,jj-1)
-               ELSE                                                    ;   zcv_box(ji,jj) = v_ice(ji,jj  )
-               ENDIF
-            END DO
-         END DO
-         
-         ! advection
-         DO jt = 1, initad
-            CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, ato_i(:,:) )       ! Open water area 
-            DO jl = 1, jpl
-               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, a_i(:,:,jl) )      ! Ice area
-               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_i(:,:,jl) )      ! Ice  volume
-               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, smv_i(:,:,jl) )    ! Salt content
-               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, oa_i (:,:,jl) )    ! Age content
-               DO jk = 1, nlay_i
-                  CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_i(:,:,jk,jl) )   ! Ice  heat content
-               END DO
-               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_s(:,:,jl) )      ! Snow volume
-               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_s(:,:,1,jl) )    ! Snow heat content
-            END DO
-         END DO
-         !
-         at_i(:,:) = a_i(:,:,1)      ! total ice fraction
-         DO jl = 2, jpl
-            at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
-         END DO
-         !
-         CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )
-         
-                       !=============================!
-      CASE ( -1 )      !==     Prather scheme      ==!                   
-                       !=============================!
-
-         CALL wrk_alloc( jpi,jpj,            zarea )
-         CALL wrk_alloc( jpi,jpj,1,          z0opw )
-         CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
-         CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei )
-         
-         IF( kt == nit000 .AND. lwp ) THEN
-            WRITE(numout,*)''
-            WRITE(numout,*)'lim_adv_xy : Prather advection scheme'
-            WRITE(numout,*)'~~~~~~~~~~~'
-         ENDIF
-         
-         zarea(:,:) = e1e2t(:,:)
-         
-         !-------------------------
-         ! transported fields                                        
-         !-------------------------
-         z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area 
-         DO jl = 1, jpl
-            z0snw (:,:,jl)  = v_s  (:,:,  jl) * e1e2t(:,:)  ! Snow volume
-            z0ice(:,:,jl)   = v_i  (:,:,  jl) * e1e2t(:,:)  ! Ice  volume
-            z0ai  (:,:,jl)  = a_i  (:,:,  jl) * e1e2t(:,:)  ! Ice area
-            z0smi (:,:,jl)  = smv_i(:,:,  jl) * e1e2t(:,:)  ! Salt content
-            z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content
-            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content
-            DO jk = 1, nlay_i
-               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content
-            END DO
-         END DO
-
-
-         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==!
-            DO jt = 1, initad
-               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
-                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &
-                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               DO jl = 1, jpl
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
-                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &
-                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
-                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &
-                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
-                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &
-                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---     
-                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &
-                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations ---
-                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
-                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents ---
-                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &
-                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  DO jk = 1, nlay_i                                                                !--- ice heat contents ---
-                     CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
-                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
-                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
-                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
-                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                  END DO
-               END DO
-            END DO
-         ELSE
-            DO jt = 1, initad
-               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
-                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &
-                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               DO jl = 1, jpl
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
-                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &
-                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
-                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &
-                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
-                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &
-                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
-                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &
-                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
-                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &
-                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
-                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &
-                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  DO jk = 1, nlay_i                                                           !--- ice heat contents ---
-                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
-                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
-                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
-                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
-                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         !-------------------------------------------
-         ! Recover the properties from their contents
-         !-------------------------------------------
-         ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:)
-         DO jl = 1, jpl
-            v_i  (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:)
-            v_s  (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:)
-            smv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:)
-            oa_i (:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:)
-            a_i  (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:)
-            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:)
-            DO jk = 1, nlay_i
-               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:)
-            END DO
-         END DO
-
-         at_i(:,:) = a_i(:,:,1)      ! total ice fraction
-         DO jl = 2, jpl
-            at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
-         END DO
-         
-         CALL wrk_dealloc( jpi,jpj,            zarea )
-         CALL wrk_dealloc( jpi,jpj,1,          z0opw )
-         CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
-         CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei )
-
-      END SELECT
-      
-      !------------------------------!
-      ! Diffusion of Ice fields                  
-      !------------------------------!
-      IF( nn_ahi0 /= -1 .AND. nn_limdyn == 2 ) THEN
-         !
-         ! --- Prepare diffusion for variables with categories --- !
-         !     mask eddy diffusivity coefficient at ocean U- and V-points
-         jm=1
-         DO jl = 1, jpl
-            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row
-               DO ji = 1 , fs_jpim1
-                  pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,  jl ) ) ) )   &
-                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,  jl ) ) ) ) * ahiu(ji,jj)
-                  pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,  jj,  jl ) ) ) )   &
-                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,  jj+1,jl ) ) ) ) * ahiv(ji,jj)
-               END DO
-            END DO
-
-            zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1
-            zhdfptab(:,:,jm)= v_i  (:,:,  jl); jm = jm + 1
-            zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1
-            zhdfptab(:,:,jm)= smv_i(:,:,  jl); jm = jm + 1
-            zhdfptab(:,:,jm)= oa_i (:,:,  jl); jm = jm + 1
-            zhdfptab(:,:,jm)= e_s  (:,:,1,jl); jm = jm + 1
-            ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased)
-            !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1  
-            !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 
-            DO jk = 1, nlay_i
-              zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1
-            END DO
-         END DO
-
-         ! --- Prepare diffusion for open water area --- !
-         !     mask eddy diffusivity coefficient at ocean U- and V-points
-         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row
-            DO ji = 1 , fs_jpim1
-               pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   &
-                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)
-               pahv3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   &
-                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)
-            END DO
-         END DO
-         !
-         zhdfptab(:,:,jm)= ato_i  (:,:);
-
-         ! --- Apply diffusion --- !
-         CALL lim_hdf( zhdfptab, ihdf_vars )
-
-         ! --- Recover properties --- !
-         jm=1
-         DO jl = 1, jpl
-            a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
-            v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
-            v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
-            smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
-            oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
-            e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1
-            ! Sample of adding more variables to apply lim_hdf
-            !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
-            !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1
-            DO jk = 1, nlay_i
-               e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1
-            END DO
-         END DO
-         ato_i  (:,:) = zhdfptab(:,:,jm)
-              
-      ENDIF
-
-      ! --- diags ---
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            diag_trp_ei (ji,jj) = ( SUM( e_i  (ji,jj,1:nlay_i,:) ) -  zeiold(ji,jj) ) * r1_rdtice
-            diag_trp_es (ji,jj) = ( SUM( e_s  (ji,jj,1:nlay_s,:) ) -  zesold(ji,jj) ) * r1_rdtice
-            diag_trp_smv(ji,jj) = ( SUM( smv_i(ji,jj,:)          ) - zsmvold(ji,jj) ) * r1_rdtice
-            diag_trp_vi (ji,jj) =   SUM(   v_i(ji,jj,:)            -  zviold(ji,jj,:) ) * r1_rdtice
-            diag_trp_vs (ji,jj) =   SUM(   v_s(ji,jj,:)            -  zvsold(ji,jj,:) ) * r1_rdtice
-         END DO
-      END DO
-      
-      IF( nn_limdyn == 2) THEN
-
-         ! zap small areas
-         CALL lim_var_zapsmall
-           
-         !--- Thickness correction in case too high --- !
-         DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  
-                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN
-                     
-                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
-                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-                     
-                     zdv  = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)  
-                     
-                     IF ( ( zdv >  0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. &
-                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN
-                        
-                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) )
-                        a_i(ji,jj,jl)  = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 )
-                        
-                        ! small correction due to *rswitch for a_i
-                        v_i  (ji,jj,jl)        = rswitch * v_i  (ji,jj,jl)
-                        v_s  (ji,jj,jl)        = rswitch * v_s  (ji,jj,jl)
-                        smv_i(ji,jj,jl)        = rswitch * smv_i(ji,jj,jl)
-                        e_s(ji,jj,1,jl)        = rswitch * e_s(ji,jj,1,jl)
-                        e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
-                                                
-                     ENDIF
-                     
-                  ENDIF
-                
-               END DO
-            END DO
-         END DO
-         ! -------------------------------------------------
-         
-         ! Force the upper limit of ht_i to always be < hi_max (99 m).
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch         = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) )
-               ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) )
-               a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch
-            END DO
-         END DO
-
-      ENDIF
-         
-      !------------------------------------------------------------
-      ! Impose a_i < amax if no ridging/rafting or in mono-category
-      !------------------------------------------------------------
-      !
-      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-      IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2
-         DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch       = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) )
-                  zda           = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp )  &
-                     &                    * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 )
-                  a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda
-               END DO
-            END DO
-         END DO
-      ENDIF
-      
-      ! --- agglomerate variables -----------------
-      vt_i(:,:) = SUM( v_i(:,:,:), dim=3 )
-      vt_s(:,:) = SUM( v_s(:,:,:), dim=3 )
-      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-      
-      ! --- open water = 1 if at_i=0 --------------------------------
-      WHERE( at_i == 0._wp ) ato_i = 1._wp 
-      
-      ! conservation test
-      IF( ln_limdiachk )   CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-        
-      ! -------------------------------------------------
-      ! control prints
-      ! -------------------------------------------------
-      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' )
-      !
-      CALL wrk_dealloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold )
-      CALL wrk_dealloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold )
-      CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('limtrp')
-      !
-   END SUBROUTINE lim_trp
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Empty Module                No sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_trp        ! Empty routine
-   END SUBROUTINE lim_trp
-#endif
-   !!======================================================================
-END MODULE limtrp
-
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 8568)
+++ 	(revision )
@@ -1,156 +1,0 @@
-MODULE limupdate1
-   !!======================================================================
-   !!                     ***  MODULE  limupdate1  ***
-   !!   LIM-3 : Update of sea-ice global variables at the end of the time step
-   !!======================================================================
-   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
-   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!    lim_update1   : computes update of sea-ice global variables from trend terms
-   !!----------------------------------------------------------------------
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE dom_oce
-   USE phycst          ! physical constants
-   USE ice
-   USE thd_ice         ! LIM thermodynamic sea-ice variables
-   USE limitd_th
-   USE limvar
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-   USE limcons         ! conservation tests
-   USE limctl          ! control prints
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_update1
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_update1( kt )
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_update1  ***
-      !!               
-      !! ** Purpose :  Computes update of sea-ice global variables at 
-      !!               the end of the dynamics.
-      !!                
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! number of iteration
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      REAL(wp) ::   zsal
-      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      !!-------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('limupdate1')
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)'' 
-         WRITE(numout,*)' lim_update1 ' 
-         WRITE(numout,*)' ~~~~~~~~~~~ '
-      ENDIF
-
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      !----------------------------------------------------
-      ! ice concentration should not exceed amax 
-      !-----------------------------------------------------
-      at_i(:,:) = 0._wp
-      DO jl = 1, jpl
-         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
-      END DO
-
-      DO jl  = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
-                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
-               ENDIF
-            END DO
-         END DO
-      END DO
-    
-      !---------------------
-      ! Ice salinity bounds
-      !---------------------
-      IF (  nn_icesal == 2  ) THEN 
-         DO jl = 1, jpl
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  zsal            = smv_i(ji,jj,jl)
-                  ! salinity stays in bounds
-                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
-                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
-                  ! associated salt flux
-                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      !----------------------------------------------------
-      ! Rebin categories with thickness out of bounds
-      !----------------------------------------------------
-      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
-
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_var_zapsmall
-
-      ! -------------------------------------------------
-      ! Diagnostics
-      ! -------------------------------------------------
-      DO jl  = 1, jpl
-         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
-      END DO
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi            
-            ! heat content variation (W.m-2)
-            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
-               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
-               &                 ) * r1_rdtice
-            ! salt, volume
-            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
-            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
-            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
-         END DO
-      END DO
-
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      ! control prints
-      IF( ln_ctl )       CALL lim_prt3D( 'limupdate1' )
-   
-      IF( nn_timing == 1 )  CALL timing_stop('limupdate1')
-
-   END SUBROUTINE lim_update1
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Empty Module               No sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_update1     ! Empty routine
-   END SUBROUTINE lim_update1
-
-#endif
-
-END MODULE limupdate1
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 8568)
+++ 	(revision )
@@ -1,197 +1,0 @@
-MODULE limupdate2
-   !!======================================================================
-   !!                     ***  MODULE  limupdate2  ***
-   !!   LIM-3 : Update of sea-ice global variables at the end of the time step
-   !!======================================================================
-   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
-   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!    lim_update2   : computes update of sea-ice global variables from trend terms
-   !!----------------------------------------------------------------------
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE dom_oce
-   USE phycst          ! physical constants
-   USE ice
-   USE thd_ice         ! LIM thermodynamic sea-ice variables
-   USE limitd_th
-   USE limvar
-   USE lbclnk          ! lateral boundary condition - MPP exchanges
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-   USE limcons         ! conservation tests
-   USE limctl
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE in_out_manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_update2   ! routine called by ice_step
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_update2( kt )
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_update2  ***
-      !!               
-      !! ** Purpose :  Computes update of sea-ice global variables at 
-      !!               the end of the time step.
-      !!
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! number of iteration
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      REAL(wp) ::   zsal
-      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      !!-------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('limupdate2')
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)''
-         WRITE(numout,*)' lim_update2 '
-         WRITE(numout,*)' ~~~~~~~~~~~ '
-      ENDIF
-
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      !----------------------------------------------------------------------
-      ! Constrain the thickness of the smallest category above himin
-      !----------------------------------------------------------------------
-      DO jj = 1, jpj 
-         DO ji = 1, jpi
-            rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) )   !0 if no ice and 1 if yes
-            ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch
-            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN
-               a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin
-               oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin
-            ENDIF
-         END DO
-      END DO
-      
-      !-----------------------------------------------------
-      ! ice concentration should not exceed amax 
-      !-----------------------------------------------------
-      at_i(:,:) = 0._wp
-      DO jl = 1, jpl
-         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
-      END DO
-
-      DO jl  = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
-                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      !---------------------
-      ! Ice salinity
-      !---------------------
-      IF (  nn_icesal == 2  ) THEN 
-         DO jl = 1, jpl
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  zsal            = smv_i(ji,jj,jl)
-                  ! salinity stays in bounds
-                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
-                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
-                  ! associated salt flux
-                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      !----------------------------------------------------
-      ! Rebin categories with thickness out of bounds
-      !----------------------------------------------------
-      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
-
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_var_zapsmall
-
-      !------------------------------------------------------------------------------
-      ! Corrections to avoid wrong values                                        |
-      !------------------------------------------------------------------------------
-      ! Ice drift
-      !------------
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice
-               IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj)   = 0._wp ! right side
-               IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side
-               IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj)   = 0._wp ! upper side
-               IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side
-            ENDIF
-         END DO
-      END DO
-      !lateral boundary conditions
-      CALL lbc_lnk( u_ice(:,:), 'U', -1. )
-      CALL lbc_lnk( v_ice(:,:), 'V', -1. )
-      !mask velocities
-      u_ice(:,:) = u_ice(:,:) * umask(:,:,1)
-      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1)
- 
-      ! -------------------------------------------------
-      ! Diagnostics
-      ! -------------------------------------------------
-      DO jl  = 1, jpl
-         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging
-         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
-      END DO
-      afx_tot = afx_thd + afx_dyn
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi            
-            ! heat content variation (W.m-2)
-            diag_heat(ji,jj) = diag_heat(ji,jj) -  &
-               &               ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
-               &                 SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
-               &               ) * r1_rdtice   
-            ! salt, volume
-            diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
-            diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
-            diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
-         END DO
-      END DO
-
-      ! conservation test
-      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      ! control prints
-      IF( ln_limctl )    CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )
-      IF( ln_ctl )       CALL lim_prt3D( 'limupdate2' )
-   
-      IF( nn_timing == 1 )  CALL timing_stop('limupdate2')
-
-   END SUBROUTINE lim_update2
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Empty Module               No sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_update2     ! Empty routine
-   END SUBROUTINE lim_update2
-
-#endif
-
-END MODULE limupdate2
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 8568)
+++ 	(revision )
@@ -1,796 +1,0 @@
-MODULE limvar
-   !!======================================================================
-   !!                       ***  MODULE limvar ***
-   !!                 Different sets of ice model variables 
-   !!                   how to switch from one to another
-   !!
-   !!                 There are three sets of variables
-   !!                 VGLO : global variables of the model
-   !!                        - v_i (jpi,jpj,jpl)
-   !!                        - v_s (jpi,jpj,jpl)
-   !!                        - a_i (jpi,jpj,jpl)
-   !!                        - t_s (jpi,jpj,jpl)
-   !!                        - e_i (jpi,jpj,nlay_i,jpl)
-   !!                        - smv_i(jpi,jpj,jpl)
-   !!                        - oa_i (jpi,jpj,jpl)
-   !!                 VEQV : equivalent variables sometimes used in the model
-   !!                        - ht_i(jpi,jpj,jpl)
-   !!                        - ht_s(jpi,jpj,jpl)
-   !!                        - t_i (jpi,jpj,nlay_i,jpl)
-   !!                        ...
-   !!                 VAGG : aggregate variables, averaged/summed over all
-   !!                        thickness categories
-   !!                        - vt_i(jpi,jpj)
-   !!                        - vt_s(jpi,jpj)
-   !!                        - at_i(jpi,jpj)
-   !!                        - et_s(jpi,jpj)  !total snow heat content
-   !!                        - et_i(jpi,jpj)  !total ice thermal content 
-   !!                        - smt_i(jpi,jpj) !mean ice salinity
-   !!                        - tm_i (jpi,jpj) !mean ice temperature
-   !!======================================================================
-   !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code
-   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE phycst         ! physical constants (ocean directory) 
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE ice            ! ice variables
-   USE thd_ice        ! ice variables (thermodynamics)
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   lim_var_agg          
-   PUBLIC   lim_var_glo2eqv      
-   PUBLIC   lim_var_eqv2glo      
-   PUBLIC   lim_var_salprof      
-   PUBLIC   lim_var_bv           
-   PUBLIC   lim_var_salprof1d    
-   PUBLIC   lim_var_zapsmall
-   PUBLIC   lim_var_itd
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lim_var_agg( kn )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_var_agg  ***
-      !!
-      !! ** Purpose :   aggregates ice-thickness-category variables to all-ice variables
-      !!              i.e. it turns VGLO into VAGG
-      !! ** Method  :
-      !!
-      !! ** Arguments : n = 1, at_i vt_i only
-      !!                n = 2 everything
-      !!
-      !! note : you could add an argument when you need only at_i, vt_i
-      !!        and when you need everything
-      !!------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kn     ! =1 at_i & vt only ; = what is needed
-      !
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      !!------------------------------------------------------------------
-
-      ! integrated values
-      vt_i (:,:) = SUM( v_i, dim=3 )
-      vt_s (:,:) = SUM( v_s, dim=3 )
-      at_i (:,:) = SUM( a_i, dim=3 )
-      et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 )
-      et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 )
-
-      ! open water fraction
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp )   
-         END DO
-      END DO
-
-      IF( kn > 1 ) THEN
-
-         ! mean ice/snow thickness
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
-               htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch
-               htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch
-            ENDDO
-         ENDDO
-
-         ! mean temperature (K), salinity and age
-         smt_i(:,:) = 0._wp
-         tm_i(:,:)  = 0._wp
-         tm_su(:,:) = 0._wp
-         om_i (:,:) = 0._wp
-         DO jl = 1, jpl
-            
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
-                  tm_su(ji,jj) = tm_su(ji,jj) + rswitch * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 )
-                  om_i (ji,jj) = om_i (ji,jj) + rswitch *   oa_i(ji,jj,jl)                         / MAX( at_i(ji,jj) , epsi10 )
-               END DO
-            END DO
-            
-            DO jk = 1, nlay_i
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
-                     tm_i(ji,jj)  = tm_i(ji,jj)  + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  &
-                        &            / MAX( vt_i(ji,jj) , epsi10 )
-                     smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl)  &
-                        &            / MAX( vt_i(ji,jj) , epsi10 )
-                  END DO
-               END DO
-            END DO
-         END DO
-         tm_i  = tm_i  + rt0
-         tm_su = tm_su + rt0
-         !
-      ENDIF
-      !
-   END SUBROUTINE lim_var_agg
-
-
-   SUBROUTINE lim_var_glo2eqv
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_var_glo2eqv ***
-      !!
-      !! ** Purpose :   computes equivalent variables as function of global variables 
-      !!              i.e. it turns VGLO into VEQV
-      !!------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      REAL(wp) ::   zq_i, zaaa, zbbb, zccc, zdiscrim     ! local scalars
-      REAL(wp) ::   ztmelts, zq_s, zfac1, zfac2   !   -      -
-      !!------------------------------------------------------------------
-
-      !-------------------------------------------------------
-      ! Ice thickness, snow thickness, ice salinity, ice age
-      !-------------------------------------------------------
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
-               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-            END DO
-         END DO
-      END DO
-      ! Force the upper limit of ht_i to always be < hi_max (99 m).
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) )
-            ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) )
-            a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch
-         END DO
-      END DO
-
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
-               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
-            END DO
-         END DO
-      END DO
-      
-      IF(  nn_icesal == 2  )THEN
-         DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
-                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch
-                  !                                      ! bounding salinity
-                  sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin )
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      CALL lim_var_salprof      ! salinity profile
-
-      !-------------------
-      ! Ice temperatures
-      !-------------------
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !                                                              ! Energy of melting q(S,T) [J.m-3]
-                  rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
-                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp) 
-                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0              ! Ice layer melt temperature
-                  !
-                  zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation)
-                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus
-                  zccc       =  lfus * (ztmelts-rt0)
-                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
-                  t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
-                  t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) )  ! -100 < t_i < ztmelts
-               END DO
-            END DO
-         END DO
-      END DO
-
-      !--------------------
-      ! Snow temperatures
-      !--------------------
-      zfac1 = 1._wp / ( rhosn * cpic )
-      zfac2 = lfus / cpic  
-      DO jl = 1, jpl
-         DO jk = 1, nlay_s
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !Energy of melting q(S,T) [J.m-3]
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
-                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp)
-                  !
-                  t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 )
-                  t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) )     ! -100 < t_s < rt0
-               END DO
-            END DO
-         END DO
-      END DO
-
-      ! integrated values
-      vt_i (:,:) = SUM( v_i, dim=3 )
-      vt_s (:,:) = SUM( v_s, dim=3 )
-      at_i (:,:) = SUM( a_i, dim=3 )
-
-      !
-   END SUBROUTINE lim_var_glo2eqv
-
-
-   SUBROUTINE lim_var_eqv2glo
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_var_eqv2glo ***
-      !!
-      !! ** Purpose :   computes global variables as function of equivalent variables
-      !!                i.e. it turns VEQV into VGLO
-      !! ** Method  :
-      !!
-      !! ** History :  (01-2006) Martin Vancoppenolle, UCL-ASTR
-      !!------------------------------------------------------------------
-      !
-      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
-      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
-      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
-      !
-   END SUBROUTINE lim_var_eqv2glo
-
-
-   SUBROUTINE lim_var_salprof
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_var_salprof ***
-      !!
-      !! ** Purpose :   computes salinity profile in function of bulk salinity     
-      !!
-      !! ** Method  : If bulk salinity greater than zsi1, 
-      !!              the profile is assumed to be constant (S_inf)
-      !!              If bulk salinity lower than zsi0,
-      !!              the profile is linear with 0 at the surface (S_zero)
-      !!              If it is between zsi0 and zsi1, it is a
-      !!              alpha-weighted linear combination of s_inf and s_zero
-      !!
-      !! ** References : Vancoppenolle et al., 2007
-      !!------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
-      REAL(wp) ::   zfac0, zfac1, zsal
-      REAL(wp) ::   zswi0, zswi01, zargtemp , zs_zero   
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha
-      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
-      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
-      !!------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )
-
-      !---------------------------------------
-      ! Vertically constant, constant in time
-      !---------------------------------------
-      IF(  nn_icesal == 1  )  THEN
-         s_i (:,:,:,:) = rn_icesal
-         sm_i(:,:,:)   = rn_icesal
-      ENDIF
-
-      !-----------------------------------
-      ! Salinity profile, varying in time
-      !-----------------------------------
-      IF(  nn_icesal == 2  ) THEN
-         !
-         DO jk = 1, nlay_i
-            s_i(:,:,jk,:)  = sm_i(:,:,:)
-         END DO
-         !
-         DO jl = 1, jpl                               ! Slope of the linear profile 
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) )
-                  z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) )
-               END DO
-            END DO
-         END DO
-         !
-         zfac0 = 1._wp / ( zsi0 - zsi1 )       ! Weighting factor between zs_zero and zs_inf
-         zfac1 = zsi1  / ( zsi1 - zsi0 )
-         !
-         zalpha(:,:,:) = 0._wp
-         DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
-                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , zsi0 - sm_i(ji,jj,jl) ) ) 
-                  ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
-                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , zsi1 - sm_i(ji,jj,jl) ) ) 
-                  ! If 2.sm_i GE sss_m then rswitch = 1
-                  ! this is to force a constant salinity profile in the Baltic Sea
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
-                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 )
-                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch )
-               END DO
-            END DO
-         END DO
-
-         ! Computation of the profile
-         DO jl = 1, jpl
-            DO jk = 1, nlay_i
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     !                                      ! linear profile with 0 at the surface
-                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i
-                     !                                      ! weighting the profile
-                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
-                     !                                      ! bounding salinity
-                     s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) )
-                  END DO
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF ! nn_icesal
-
-      !-------------------------------------------------------
-      ! Vertically varying salinity profile, constant in time
-      !-------------------------------------------------------
-
-      IF(  nn_icesal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
-         !
-         sm_i(:,:,:) = 2.30_wp
-         !
-         DO jl = 1, jpl
-            DO jk = 1, nlay_i
-               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
-               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
-               s_i(:,:,jk,jl) =  zsal
-            END DO
-         END DO
-         !
-      ENDIF ! nn_icesal
-      !
-      CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
-      !
-   END SUBROUTINE lim_var_salprof
-
-
-   SUBROUTINE lim_var_bv
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_var_bv ***
-      !!
-      !! ** Purpose :   computes mean brine volume (%) in sea ice
-      !!
-      !! ** Method  : e = - 0.054 * S (ppt) / T (C)
-      !!
-      !! References : Vancoppenolle et al., JGR, 2007
-      !!------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      !!------------------------------------------------------------------
-      !
-      bvm_i(:,:)   = 0._wp
-      bv_i (:,:,:) = 0._wp
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch        = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  )
-                  bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i  &
-                     &                            / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )
-               END DO
-            END DO
-         END DO
-         
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch      = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
-               bvm_i(ji,jj) = bvm_i(ji,jj) + rswitch * bv_i(ji,jj,jl) * v_i(ji,jj,jl) / MAX( vt_i(ji,jj), epsi10 )
-            END DO
-         END DO
-      END DO
-      !
-   END SUBROUTINE lim_var_bv
-
-
-   SUBROUTINE lim_var_salprof1d( kideb, kiut )
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_thd_salprof1d  ***
-      !!
-      !! ** Purpose :   1d computation of the sea ice salinity profile
-      !!                Works with 1d vectors and is used by thermodynamic modules
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index
-      !
-      INTEGER  ::   ji, jk    ! dummy loop indices
-      INTEGER  ::   ii, ij    ! local integers
-      REAL(wp) ::   zfac0, zfac1, zargtemp, zsal   ! local scalars
-      REAL(wp) ::   zalpha, zswi0, zswi01, zs_zero              !   -      -
-      !
-      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s
-      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
-      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
-      !!---------------------------------------------------------------------
-
-      CALL wrk_alloc( jpij, z_slope_s )
-
-      !---------------------------------------
-      ! Vertically constant, constant in time
-      !---------------------------------------
-      IF( nn_icesal == 1 )   s_i_1d(:,:) = rn_icesal
-
-      !------------------------------------------------------
-      ! Vertically varying salinity profile, varying in time
-      !------------------------------------------------------
-
-      IF(  nn_icesal == 2  ) THEN
-         !
-         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero
-            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
-            z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) )
-         END DO
-
-         ! Weighting factor between zs_zero and zs_inf
-         !---------------------------------------------
-         zfac0 = 1._wp / ( zsi0 - zsi1 )
-         zfac1 = zsi1 / ( zsi1 - zsi0 )
-         DO jk = 1, nlay_i
-            DO ji = kideb, kiut
-               ii =  MOD( npb(ji) - 1 , jpi ) + 1
-               ij =     ( npb(ji) - 1 ) / jpi + 1
-               ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
-               zswi0  = MAX( 0._wp , SIGN( 1._wp  , zsi0 - sm_i_1d(ji) ) ) 
-               ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
-               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) ) 
-               ! if 2.sm_i GE sss_m then rswitch = 1
-               ! this is to force a constant salinity profile in the Baltic Sea
-               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
-               !
-               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1._wp - rswitch )
-               !
-               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i
-               ! weighting the profile
-               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
-               ! bounding salinity
-               s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) )
-            END DO 
-         END DO 
-
-      ENDIF 
-
-      !-------------------------------------------------------
-      ! Vertically varying salinity profile, constant in time
-      !-------------------------------------------------------
-
-      IF( nn_icesal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
-         !
-         sm_i_1d(:) = 2.30_wp
-         !
-         DO jk = 1, nlay_i
-            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
-            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) )
-            DO ji = kideb, kiut
-               s_i_1d(ji,jk) = zsal
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-      CALL wrk_dealloc( jpij, z_slope_s )
-      !
-   END SUBROUTINE lim_var_salprof1d
-
-   SUBROUTINE lim_var_zapsmall
-      !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_var_zapsmall ***
-      !!
-      !! ** Purpose :   Remove too small sea ice areas and correct fluxes
-      !!
-      !! history : LIM3.5 - 01-2014 (C. Rousset) original code
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
-      REAL(wp) ::   zsal, zvi, zvs, zei, zes
-      !!-------------------------------------------------------------------
-      at_i (:,:) = 0._wp
-      DO jl = 1, jpl
-         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
-      END DO
-
-      DO jl = 1, jpl
-
-         !-----------------------------------------------------------------
-         ! Zap ice energy and use ocean heat to melt ice
-         !-----------------------------------------------------------------
-         DO jk = 1, nlay_i
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
-                  rswitch          = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
-                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
-                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
-                     &                                       / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
-                  zei              = e_i(ji,jj,jk,jl)
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch
-                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch )
-                  ! update exchanges with ocean
-                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0
-               END DO
-            END DO
-         END DO
-
-         DO jj = 1 , jpj
-            DO ji = 1 , jpi
-               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
-               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
-               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
-               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
-                  &                              / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
-               zsal = smv_i(ji,jj,  jl)
-               zvi  = v_i  (ji,jj,  jl)
-               zvs  = v_s  (ji,jj,  jl)
-               zes  = e_s  (ji,jj,1,jl)
-               !-----------------------------------------------------------------
-               ! Zap snow energy 
-               !-----------------------------------------------------------------
-               t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch )
-               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch
-
-               !-----------------------------------------------------------------
-               ! zap ice and snow volume, add water and salt to ocean
-               !-----------------------------------------------------------------
-               ato_i(ji,jj)    = a_i  (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj)
-               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * rswitch
-               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * rswitch
-               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * rswitch
-               t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch )
-               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch
-               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch
-
-               ! update exchanges with ocean
-               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
-               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice
-               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice
-               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
-            END DO
-         END DO
-      END DO 
-
-      ! to be sure that at_i is the sum of a_i(jl)
-      at_i (:,:) = 0._wp
-      DO jl = 1, jpl
-         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
-      END DO
-
-      ! open water = 1 if at_i=0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
-            ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
-         END DO
-      END DO
-
-      !
-   END SUBROUTINE lim_var_zapsmall
-
-   SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_var_itd   ***
-      !!
-      !! ** Purpose :  converting 1-cat ice to multiple ice categories
-      !!
-      !!                  ice thickness distribution follows a gaussian law
-      !!               around the concentration of the most likely ice thickness
-      !!                           (similar as limistate.F90)
-      !!
-      !! ** Method:   Iterative procedure
-      !!                
-      !!               1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian
-      !!
-      !!               2) Check whether the distribution conserves area and volume, positivity and
-      !!                  category boundaries
-      !!              
-      !!               3) If not (input ice is too thin), the last category is empty and
-      !!                  the number of categories is reduced (jpl-1)
-      !!
-      !!               4) Iterate until ok (SUM(itest(:) = 4)
-      !!
-      !! ** Arguments : zhti: 1-cat ice thickness
-      !!                zhts: 1-cat snow depth
-      !!                zai : 1-cat ice concentration
-      !!
-      !! ** Output    : jpl-cat 
-      !!
-      !!  (Example of application: BDY forcings when input are cell averaged)  
-      !!
-      !!-------------------------------------------------------------------
-      !! History : LIM3.5 - 2012    (M. Vancoppenolle)  Original code
-      !!                    2014    (C. Rousset)        Rewriting
-      !!-------------------------------------------------------------------
-      !! Local variables
-      INTEGER  :: ji, jk, jl             ! dummy loop indices
-      INTEGER  :: ijpij, i_fill, jl0  
-      REAL(wp) :: zarg, zV, zconv, zdh, zdv
-      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables
-      INTEGER , POINTER, DIMENSION(:)         ::   itest
- 
-      CALL wrk_alloc( 4, itest )
-      !--------------------------------------------------------------------
-      ! initialisation of variables
-      !--------------------------------------------------------------------
-      ijpij = SIZE(zhti,1)
-      zht_i(1:ijpij,1:jpl) = 0._wp
-      zht_s(1:ijpij,1:jpl) = 0._wp
-      za_i (1:ijpij,1:jpl) = 0._wp
-
-      ! ----------------------------------------
-      ! distribution over the jpl ice categories
-      ! ----------------------------------------
-      DO ji = 1, ijpij
-         
-         IF( zhti(ji) > 0._wp ) THEN
-
-            ! find which category (jl0) the input ice thickness falls into
-            jl0 = jpl
-            DO jl = 1, jpl
-               IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN
-                  jl0 = jl
-                  CYCLE
-               ENDIF
-            END DO
-
-            ! initialisation of tests
-            itest(:)  = 0
-         
-            i_fill = jpl + 1                                             !====================================
-            DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories
-               ! iteration                                               !====================================
-               i_fill = i_fill - 1
-               
-               ! initialisation of ice variables for each try
-               zht_i(ji,1:jpl) = 0._wp
-               za_i (ji,1:jpl) = 0._wp
-               itest(:)        = 0      
-               
-               ! *** case very thin ice: fill only category 1
-               IF ( i_fill == 1 ) THEN
-                  zht_i(ji,1) = zhti(ji)
-                  za_i (ji,1) = zai (ji)
-                  
-               ! *** case ice is thicker: fill categories >1
-               ELSE
-
-                  ! Fill ice thicknesses in the (i_fill-1) cat by hmean 
-                  DO jl = 1, i_fill - 1
-                     zht_i(ji,jl) = hi_mean(jl)
-                  END DO
-                  
-                  ! Concentrations in the (i_fill-1) categories 
-                  za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
-                  DO jl = 1, i_fill - 1
-                     IF ( jl /= jl0 ) THEN
-                        zarg        = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
-                        za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2)
-                     ENDIF
-                  END DO
-                  
-                  ! Concentration in the last (i_fill) category
-                  za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
-                  
-                  ! Ice thickness in the last (i_fill) category
-                  zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
-                  zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 ) 
-                  
-                  ! clem: correction if concentration of upper cat is greater than lower cat
-                  !       (it should be a gaussian around jl0 but sometimes it is not)
-                  IF ( jl0 /= jpl ) THEN
-                     DO jl = jpl, jl0+1, -1
-                        IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN
-                           zdv = zht_i(ji,jl) * za_i(ji,jl)
-                           zht_i(ji,jl    ) = 0._wp
-                           za_i (ji,jl    ) = 0._wp
-                           za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 )
-                        END IF
-                     ENDDO
-                  ENDIF
-               
-               ENDIF ! case ice is thick or thin
-            
-               !---------------------
-               ! Compatibility tests
-               !--------------------- 
-               ! Test 1: area conservation
-               zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
-               IF ( zconv < epsi06 ) itest(1) = 1
-            
-               ! Test 2: volume conservation
-               zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
-               IF ( zconv < epsi06 ) itest(2) = 1
-               
-               ! Test 3: thickness of the last category is in-bounds ?
-               IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
-               
-               ! Test 4: positivity of ice concentrations
-               itest(4) = 1
-               DO jl = 1, i_fill
-                  IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0
-               END DO
-               !                                         !============================
-            END DO                                       ! end iteration on categories
-               !                                         !============================
-         ENDIF ! if zhti > 0
-      END DO ! i loop
-
-      ! ------------------------------------------------
-      ! Adding Snow in each category where za_i is not 0
-      ! ------------------------------------------------ 
-      DO jl = 1, jpl
-         DO ji = 1, ijpij
-            IF( za_i(ji,jl) > 0._wp ) THEN
-               zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
-               ! In case snow load is in excess that would lead to transformation from snow to ice
-               ! Then, transfer the snow excess into the ice (different from limthd_dh)
-               zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 ) 
-               ! recompute ht_i, ht_s avoiding out of bounds values
-               zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh )
-               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn )
-            ENDIF
-         ENDDO
-      ENDDO
-
-      CALL wrk_dealloc( 4, itest )
-      !
-    END SUBROUTINE lim_var_itd
-
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option         Dummy module          NO  LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_var_agg          ! Empty routines
-   END SUBROUTINE lim_var_agg
-   SUBROUTINE lim_var_glo2eqv      ! Empty routines
-   END SUBROUTINE lim_var_glo2eqv
-   SUBROUTINE lim_var_eqv2glo      ! Empty routines
-   END SUBROUTINE lim_var_eqv2glo
-   SUBROUTINE lim_var_salprof      ! Empty routines
-   END SUBROUTINE lim_var_salprof
-   SUBROUTINE lim_var_bv           ! Emtpy routines
-   END SUBROUTINE lim_var_bv
-   SUBROUTINE lim_var_salprof1d    ! Emtpy routines
-   END SUBROUTINE lim_var_salprof1d
-   SUBROUTINE lim_var_zapsmall
-   END SUBROUTINE lim_var_zapsmall
-   SUBROUTINE lim_var_itd
-   END SUBROUTINE lim_var_itd
-#endif
-
-   !!======================================================================
-END MODULE limvar
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 8568)
+++ 	(revision )
@@ -1,364 +1,0 @@
-MODULE limwri
-   !!======================================================================
-   !!                     ***  MODULE  limwri  ***
-   !!         Ice diagnostics :  write ice output files
-   !!======================================================================
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_wri      : write of the diagnostics variables in ouput file 
-   !!   lim_wri_state : write for initial state or/and abandon
-   !!----------------------------------------------------------------------
-   USE ioipsl
-   USE dianam          ! build name of file (routine)
-   USE phycst
-   USE dom_oce
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE ice
-   USE limvar
-   USE in_out_manager
-   USE lbclnk
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! work arrays
-   USE iom
-   USE timing          ! Timing
-   USE lib_fortran     ! Fortran utilities
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC lim_wri        ! routine called by lim_step.F90
-   PUBLIC lim_wri_state  ! called by dia_wri_state 
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-
-   SUBROUTINE lim_wri( kindic )
-      !!-------------------------------------------------------------------
-      !!  This routine computes the average of some variables and write it
-      !!  on the ouput files.
-      !!  ATTENTION cette routine n'est valable que si le pas de temps est
-      !!  egale a une fraction entiere de 1 jours.
-      !!  Diff 1-D 3-D : suppress common also included in etat
-      !!                 suppress cmoymo 11-18
-      !!  modif : 03/06/98
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere
-      !
-      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices
-      REAL(wp) ::  z1_365
-      REAL(wp) ::  z2da, z2db, ztmp
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zswi2
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, zswi    ! 2D workspace
-      !!-------------------------------------------------------------------
-
-      IF( nn_timing == 1 )  CALL timing_start('limwri')
-
-      CALL wrk_alloc( jpi,jpj,jpl, zswi2 )
-      CALL wrk_alloc( jpi,jpj    , z2d, zswi )
-
-      !-----------------------------
-      ! Mean category values
-      !-----------------------------
-      z1_365 = 1._wp / 365._wp
-
-      ! brine volume
-      CALL lim_var_bv 
-
-      ! tresholds for outputs
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) )
-         END DO
-      END DO
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zswi2(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-            END DO
-         END DO
-      END DO
-      !
-      ! fluxes
-      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
-      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface
-      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface
-      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface
-      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface
-      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice
-      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )  
-      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   &
-         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) )
-      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )  
-      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )  
-      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice)
-      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice)
-
-      ! velocity
-      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 
-         DO jj = 2 , jpjm1
-            DO ji = 2 , jpim1
-               z2da  = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp
-               z2db  = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp
-               z2d(ji,jj) = SQRT( z2da * z2da + z2db * z2db )
-           END DO
-         END DO
-         CALL lbc_lnk( z2d, 'T', 1. )
-         CALL iom_put( "uice_ipa"     , u_ice      )       ! ice velocity u component
-         CALL iom_put( "vice_ipa"     , v_ice      )       ! ice velocity v component
-         CALL iom_put( "icevel"       , z2d        )       ! ice velocity module
-      ENDIF
-
-      IF ( iom_use( "tau_icebfr" ) )    CALL iom_put( "tau_icebfr"  , tau_icebfr             )  ! ice friction with ocean bottom (landfast ice)  
-      !
-      IF ( iom_use( "miceage" ) )       CALL iom_put( "miceage"     , om_i * zswi * z1_365   )  ! mean ice age
-      IF ( iom_use( "icethic_cea" ) )   CALL iom_put( "icethic_cea" , htm_i * zswi           )  ! ice thickness mean
-      IF ( iom_use( "snowthic_cea" ) )  CALL iom_put( "snowthic_cea", htm_s * zswi           )  ! snow thickness mean
-      IF ( iom_use( "micet" ) )         CALL iom_put( "micet"       , ( tm_i  - rt0 ) * zswi )  ! ice mean    temperature
-      IF ( iom_use( "icest" ) )         CALL iom_put( "icest"       , ( tm_su - rt0 ) * zswi )  ! ice surface temperature
-      IF ( iom_use( "icecolf" ) )       CALL iom_put( "icecolf"     , hicol                  )  ! frazil ice collection thickness
-      !
-      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature
-      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity
-      CALL iom_put( "iceconc"     , at_i  * zswi        )        ! ice concentration
-      CALL iom_put( "icevolu"     , vt_i  * zswi        )        ! ice volume = mean ice thickness over the cell
-      CALL iom_put( "icehc"       , et_i  * zswi        )        ! ice total heat content
-      CALL iom_put( "isnowhc"     , et_s  * zswi        )        ! snow total heat content
-      CALL iom_put( "ibrinv"      , bvm_i * zswi * 100. )        ! brine volume
-      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point
-      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point
-      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation 
-      CALL iom_put( "micesalt"    , smt_i   * zswi      )        ! mean ice salinity
-
-      CALL iom_put( "icestr"      , strength * zswi )    ! ice strength
-      CALL iom_put( "idive"       , divu_i * 1.0e8      )    ! divergence
-      CALL iom_put( "ishear"      , shear_i * 1.0e8     )    ! shear
-      CALL iom_put( "snowvol"     , vt_s   * zswi       )        ! snow volume
-      
-      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport
-      CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport
-      CALL iom_put( "saltrp"      , diag_trp_smv * rday * rhoic ) ! salt content transport
-      CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2)
-      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2)
-
-      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from bottom growth
-      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melting
-      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melting
-      CALL iom_put( "sfxlam"      , sfx_lam * rday      )        ! salt flux from lateral melting
-      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from snow ice formation
-      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from open water formation
-      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting
-      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant)
-      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines
-      CALL iom_put( "sfxsub"      , sfx_sub * rday      )        ! salt flux from sublimation
-      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux
-
-      ztmp = rday / rhoic
-      CALL iom_put( "vfxres"     , wfx_res * ztmp       )        ! daily prod./melting due to limupdate 
-      CALL iom_put( "vfxopw"     , wfx_opw * ztmp       )        ! daily lateral thermodynamic ice production
-      CALL iom_put( "vfxsni"     , wfx_sni * ztmp       )        ! daily snowice ice production
-      CALL iom_put( "vfxbog"     , wfx_bog * ztmp       )        ! daily bottom thermodynamic ice production
-      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp       )        ! daily dynamic ice production (rid/raft)
-      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt 
-      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt 
-      CALL iom_put( "vfxlam"     , wfx_lam * ztmp       )        ! lateral melt 
-      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt 
-
-      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations  
-         WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog
-         ELSEWHERE                                       ; z2d = 0._wp
-         END WHERE
-         CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp )
-      ENDIF
-
-      ztmp = rday / rhosn
-      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow)
-      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt 
-      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow/ice) 
-      CALL iom_put( "vfxsub_err" , wfx_err_sub * ztmp   )        ! "excess" of sublimation sent to ocean 
-      
-      CALL iom_put( "afxtot"     , afx_tot * rday       )        ! concentration tendency (total)
-      CALL iom_put( "afxdyn"     , afx_dyn * rday       )        ! concentration tendency (dynamics)
-      CALL iom_put( "afxthd"     , afx_thd * rday       )        ! concentration tendency (thermo)
-
-      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   !  
-      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   !  
-      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   !  
-      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   !  
-      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   !  
-      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   !  
-      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   !  
-      CALL iom_put ('hfxerr'     , hfx_err(:,:)         )   !  
-      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   !  
-      
-      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   !  
-      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   !  
-      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   !  
-      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !  
-      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !  
-      CALL iom_put ('hfxtur'     , fhtur(:,:) * at_i_b(:,:) ) ! turbulent heat flux at ice base 
-      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice 
-      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip 
-
-      
-      !--------------------------------
-      ! Output values for each category
-      !--------------------------------
-      IF ( iom_use( "iceconc_cat"  ) )  CALL iom_put( "iceconc_cat"      , a_i   * zswi2   )        ! area for categories
-      IF ( iom_use( "icethic_cat"  ) )  CALL iom_put( "icethic_cat"      , ht_i  * zswi2   )        ! thickness for categories
-      IF ( iom_use( "snowthic_cat" ) )  CALL iom_put( "snowthic_cat"     , ht_s  * zswi2   )        ! snow depth for categories
-      IF ( iom_use( "salinity_cat" ) )  CALL iom_put( "salinity_cat"     , sm_i  * zswi2   )        ! salinity for categories
-      ! ice temperature
-      IF ( iom_use( "icetemp_cat"  ) )  CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 )
-      ! snow temperature
-      IF ( iom_use( "snwtemp_cat"  ) )  CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 )
-      ! ice age
-      IF ( iom_use( "iceage_cat"   ) )  CALL iom_put( "iceage_cat" , o_i * zswi2 * z1_365 )
-      ! brine volume
-      IF ( iom_use( "brinevol_cat" ) )  CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 )
-
-      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
-      !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' )
-      !     not yet implemented
-      
-      CALL wrk_dealloc( jpi, jpj, jpl, zswi2 )
-      CALL wrk_dealloc( jpi, jpj     , z2d, zswi )
-
-      IF( nn_timing == 1 )  CALL timing_stop('limwri')
-      
-   END SUBROUTINE lim_wri
-
- 
-   SUBROUTINE lim_wri_state( kt, kid, kh_i )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lim_wri_state  ***
-      !!        
-      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
-      !!      the instantaneous ice state and forcing fields for ice model
-      !!        Used to find errors in the initial state or save the last
-      !!      ocean state in case of abnormal end of a simulation
-      !!
-      !! History :
-      !!   4.0  !  2013-06  (C. Rousset)
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in )   ::   kt               ! ocean time-step index)
-      INTEGER, INTENT( in )   ::   kid , kh_i
-      INTEGER                 ::   nz_i, jl
-      REAL(wp), DIMENSION(jpl) :: jcat
-      !!----------------------------------------------------------------------
-      DO jl = 1, jpl
-         jcat(jl) = REAL(jl)
-      ENDDO
-      
-      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up")
-
-      CALL histdef( kid, "sithic", "Ice thickness"           , "m"      ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "siconc", "Ice concentration"       , "%"      ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "sitemp", "Ice temperature"         , "C"      ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "sivelu", "i-Ice speed "            , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "sivelv", "j-Ice speed "            , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa"     ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa"     ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "sisflx", "Solar flux over ocean"     , "w/m2" ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "sisali", "Ice salinity"            , "PSU"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "sivolu", "Ice volume"              , "m"      ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "sidive", "Ice divergence"          , "10-8s-1",   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-
-      CALL histdef( kid, "vfxbog", "Ice bottom production"   , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "vfxdyn", "Ice dynamic production"  , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "vfxopw", "Ice open water prod"     , "m/s"    ,   &
-      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "vfxsni", "Snow ice production "    , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "vfxres", "Ice prod from limupdate" , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "vfxbom", "Ice bottom melt"         , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "vfxsum", "Ice surface melt"        , "m/s"    ,   &
-      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-
-      CALL histdef( kid, "sithicat", "Ice thickness"         , "m"      ,   &
-      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "siconcat", "Ice concentration"     , "%"      ,   &
-      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "sisalcat", "Ice salinity"           , ""      ,   &
-      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "sitemcat", "Ice temperature"       , "C"      ,   &
-      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "snthicat", "Snw thickness"         , "m"      ,   &
-      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "sntemcat", "Snw temperature"       , "C"      ,   &
-      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
-
-      CALL histend( kid, snc4set )   ! end of the file definition
-
-      CALL histwrite( kid, "sithic", kt, htm_i         , jpi*jpj, (/1/) )    
-      CALL histwrite( kid, "siconc", kt, at_i          , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sitemp", kt, tm_i - rt0    , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sivelu", kt, u_ice          , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sivelv", kt, v_ice          , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sistru", kt, utau_ice       , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sistrv", kt, vtau_ice       , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sisali", kt, smt_i          , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sivolu", kt, vt_i           , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "sidive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
-
-      CALL histwrite( kid, "vfxbog", kt, wfx_bog        , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "vfxdyn", kt, wfx_dyn        , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "vfxopw", kt, wfx_opw        , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "vfxsni", kt, wfx_sni        , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "vfxres", kt, wfx_res        , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "vfxbom", kt, wfx_bom        , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "vfxsum", kt, wfx_sum        , jpi*jpj, (/1/) )
-
-      CALL histwrite( kid, "sithicat", kt, ht_i        , jpi*jpj*jpl, (/1/) )    
-      CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )    
-      CALL histwrite( kid, "sisalcat", kt, sm_i        , jpi*jpj*jpl, (/1/) )    
-      CALL histwrite( kid, "sitemcat", kt, tm_i - rt0  , jpi*jpj*jpl, (/1/) )    
-      CALL histwrite( kid, "snthicat", kt, ht_s        , jpi*jpj*jpl, (/1/) )    
-      CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) )    
-
-      ! Close the file
-      ! -----------------
-      !CALL histclo( kid )
-
-    END SUBROUTINE lim_wri_state
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :         Empty module          NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_wri          ! Empty routine
-   END SUBROUTINE lim_wri
-#endif
-
-   !!======================================================================
-END MODULE limwri
Index: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 8568)
+++ 	(revision )
@@ -1,184 +1,0 @@
-MODULE thd_ice
-   !!======================================================================
-   !!                       ***  MODULE thd_ice  ***
-   !! LIM sea-ice :   Ice thermodynamics in 1D
-   !!=====================================================================
-   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE ice, ONLY :   nlay_i, nlay_s
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90
-
-   !!-----------------------------
-   !! * Share 1D Module variables
-   !!-----------------------------
-   !: In ice thermodynamics, to spare memory, the vectors are folded
-   !: from 1D to 2D vectors. The following variables, with ending _1d
-   !: are the variables corresponding to 2d vectors
-
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: address vector for 1d vertical thermo computations
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nplm   !: address vector for mono-category lateral melting
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: address vector for new ice formation
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d     
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d   
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d   
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d   
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d     
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rn_amax_1d
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bom_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bog_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dif_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_opw_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d
-
-   ! heat flux associated with ice-atmosphere mass exchange
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d
-
-   ! heat flux associated with ice-ocean mass exchange
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d   
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d   
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d  
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sub_1d
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qevap_ice_1d  !: <==> the 3D  qevap_ice
-   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_1d       !: <==> the 2D  ht_s
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_1d       !: <==> the 2D  ht_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_sub      !: Ice surface sublimation [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_1d   !: profiled ice salinity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_1d   !:    Ice  enthalpy per unit volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_1d   !:    Snow enthalpy per unit volume
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old !: ice heat content (q*h, J.m-2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m)
-
-   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   FUNCTION thd_ice_alloc()
-      !!---------------------------------------------------------------------!
-      !!                ***  ROUTINE thd_ice_alloc ***
-      !!---------------------------------------------------------------------!
-      INTEGER ::   thd_ice_alloc   ! return value
-      INTEGER ::   ierr(4), ii
-      !!---------------------------------------------------------------------!
-      ierr(:) = 0
-
-      ii = 1
-      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   &
-         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   &
-         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   &
-         &      t_bo_1d   (jpij) ,                                         &
-         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    & 
-         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      &
-         &      rn_amax_1d(jpij) ,                                         &
-         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      &
-         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   &
-         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(ii) )
-      !
-      ii = ii + 1
-      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     &
-         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     &
-         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  &
-         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  &
-         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         &
-         &      qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0         (jpij) ,                     &  
-         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  &
-         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  &
-         &      hicol_1d   (jpij) , STAT=ierr(ii) )
-      !
-      ii = ii + 1
-      ALLOCATE( t_su_1d   (jpij) , a_i_1d    (jpij) , ht_i_1d  (jpij) ,                      &
-         &      ht_s_1d   (jpij) , fc_su     (jpij) , fc_bo_i  (jpij) ,                      &    
-         &      dh_s_tot  (jpij) , dh_i_surf (jpij) , dh_i_sub (jpij) ,                      &    
-         &      dh_i_bott (jpij) , dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    &
-         &      STAT=ierr(ii) )
-      !
-      ii = ii + 1
-      ALLOCATE( t_s_1d  (jpij,nlay_s)     , t_i_1d (jpij,nlay_i)     , s_i_1d(jpij,nlay_i) ,  &            
-         &      q_i_1d  (jpij,nlay_i+1)   , q_s_1d (jpij,nlay_s)     ,                        &
-         &      qh_i_old(jpij,0:nlay_i+1) , h_i_old(jpij,0:nlay_i+1) , STAT=ierr(ii) )
-      !
-      thd_ice_alloc = MAXVAL( ierr(:) )
-      IF( thd_ice_alloc /= 0 )   CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' )
-      !
-   END FUNCTION thd_ice_alloc
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :         Empty module          NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE thd_ice_alloc          ! Empty routine
-   END SUBROUTINE thd_ice_alloc
-#endif
- 
-   !!======================================================================
-END MODULE thd_ice
