Index: /branches/UKMO/dev_r8126_LIM3_couple/DOC/Namelists/nambdy_dta
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/DOC/Namelists/nambdy_dta	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/DOC/Namelists/nambdy_dta	(revision 8879)
@@ -11,8 +11,4 @@
    bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
    bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-! for lim2
-!   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
 ! for lim3
 !   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
Index: /branches/UKMO/dev_r8126_LIM3_couple/DOC/Namelists/namsbc
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/DOC/Namelists/namsbc	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/DOC/Namelists/namsbc	(revision 8879)
@@ -23,7 +23,7 @@
                            !  = 2  Redistribute a single flux over categories (coupled mode only)
                      ! Sea-ice :
-   nn_ice      = 2         !  =0 no ice boundary condition   ,
+   nn_ice      = 3         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice")
+                           !  =3-4 ice-model used                         ("key_lim3", "key_cice")
    nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
                            !  =1 levitating ice with mass and salt exchange but no presure effect
Index: /branches/UKMO/dev_r8126_LIM3_couple/DOC/TexFiles/Chapters/Chap_SBC.tex
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 8879)
@@ -1266,5 +1266,5 @@
 ice-ocean fluxes, that are combined with the air-sea fluxes using the ice fraction of 
 each model cell to provide the surface ocean fluxes. Note that the activation of a 
-sea-ice model is is done by defining a CPP key (\key{lim2}, \key{lim3} or \key{cice}). 
+sea-ice model is is done by defining a CPP key (\key{lim3} or \key{cice}). 
 The activation automatically overwrites the read value of nn{\_}ice to its appropriate 
 value ($i.e.$ $2$ for LIM-2, $3$ for LIM-3 or $4$ for CICE).
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg	(revision 8879)
@@ -20,12 +20,7 @@
 /
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
-/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------  
-   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
    nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
    !
@@ -46,7 +41,7 @@
 !-----------------------------------------------------------------------
    ln_blk      = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)
-   nn_ice      = 3         !  =0 no ice boundary condition   ,
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+                           !  =2 ice-model used                         ("key_lim3")
    ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
    ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
@@ -176,4 +171,5 @@
 &namdyn_hpg    !   Hydrostatic pressure gradient option
 !-----------------------------------------------------------------------
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
 /
 !-----------------------------------------------------------------------
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml	(revision 8879)
@@ -95,11 +95,11 @@
 	  <field field_ref="avt"          name="difvho"   />
 	  <field field_ref="w_masstr"     name="vovematr" />
-          <!-- variables available with key_zdftmx_new -->
-          <field field_ref="av_wave"      name="av_wave"    />
-          <field field_ref="bn2"          name="bn2"        />
-          <field field_ref="bflx_tmx"     name="bflx_tmx"   />
-          <field field_ref="pcmap_tmx"    name="pcmap_tmx"  />
-          <field field_ref="emix_tmx"     name="emix_tmx"   />
-          <field field_ref="av_ratio"     name="av_ratio"   />
+     <!-- variables available with key_zdftmx_new -->
+     <field field_ref="av_wave"      name="av_wave"    />
+     <field field_ref="bn2"          name="bn2"        />
+     <field field_ref="bflx_tmx"     name="bflx_tmx"   />
+     <field field_ref="pcmap_tmx"    name="pcmap_tmx"  />
+     <field field_ref="emix_tmx"     name="emix_tmx"   />
+     <field field_ref="av_ratio"     name="av_ratio"   />
 	</file>
 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg	(revision 8879)
@@ -19,9 +19,4 @@
 /
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
-/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
@@ -53,4 +48,6 @@
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
+/
+&namsbc_cpl
 /
 !-----------------------------------------------------------------------
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg	(revision 8879)
@@ -1,48 +1,84 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref
-!!              1 - Generic parameters                 (namicerun)
-!!              2 - Diagnostics                        (namicediag)
-!!              3 - Ice initialization                 (namiceini)
-!!              4 - Ice discretization                 (namiceitd)
-!!              5 - Ice dynamics and transport         (namicedyn)
-!!              6 - Ice diffusion                      (namicehdf)
-!!              7 - Ice thermodynamics                 (namicethd)
-!!              8 - Ice salinity                       (namicesal)
-!!              9 - Ice mechanical redistribution      (namiceitdme)
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! ESIM configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref
+!!              1 - Generic parameters                 (nampar)
+!!              2 - Ice thickness discretization       (namitd)
+!!              3 - Ice dynamics                       (namdyn)
+!!              4 - Ice ridging/rafting                (namdyn_rdgrft)
+!!              5 - Ice rheology                       (namdyn_rhg)
+!!              6 - Ice advection                      (namdyn_adv)
+!!              7 - Ice surface forcing                (namforcing)
+!!              8 - Ice thermodynamics                 (namthd)
+!!              9 - Ice heat diffusion                 (namthd_zdf)
+!!             10 - Ice lateral melting                (namthd_da)
+!!             11 - Ice growth in open water           (namthd_do)
+!!             12 - Ice salinity                       (namthd_sal)
+!!             13 - Ice melt ponds                     (namthd_pnd)
+!!             14 - Ice initialization                 (namini)
+!!             15 - Ice/snow albedos                   (namalb)
+!!             16 - Ice diagnostics                    (namdia)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
 !------------------------------------------------------------------------------
-&namicerun     !   Generic parameters
+&nampar         !   Generic parameters
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicediag    !   Diagnostics
+&namitd         !   Ice discretization
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namiceini     !   Ice initialization
+&namdyn         !   Ice dynamics
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namiceitd     !   Ice discretization
+&namdyn_rdgrft  !   Ice ridging/rafting
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicedyn     !   Ice dynamics and transport
+&namdyn_rhg     !   Ice rheology
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicehdf     !   Ice horizontal diffusion
+&namdyn_adv     !   Ice advection
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicethd     !   Ice thermodynamics
+&namforcing     !   Ice surface forcing
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicesal     !   Ice salinity
+&namthd         !   Ice thermodynamics
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+&namthd_zdf     !   Ice heat diffusion
 !------------------------------------------------------------------------------
 /
+!------------------------------------------------------------------------------
+&namthd_da      !   Ice lateral melting
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_do      !   Ice growth in open water
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_sal     !   Ice salinity
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_pnd     !   Melt ponds
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namini         !   Ice initialization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namalb         !   albedo parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdia         !   Diagnostics
+!------------------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml	(revision 8879)
@@ -21,7 +21,7 @@
     -->
     
-    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
     
-      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="2ts" output_freq="2ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
 
       <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
@@ -39,5 +39,5 @@
       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->
       
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
 	
 	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
@@ -110,162 +110,7 @@
 
 	<file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." >
-          <field field_ref="snowthic_cea"    name="snthic" />
-          <field field_ref="icethic_cea"     name="sithic" />
           <field field_ref="icevolu"         name="sivolu" />
-          <field field_ref="snowvol"         name="snvolu" />
-          <field field_ref="iceconc"         name="siconc" />
-
-          <field field_ref="vfxbog"          name="vfxbog" />
-          <field field_ref="vfxdyn"          name="vfxdyn" />
-          <field field_ref="vfxopw"          name="vfxopw" />
-          <field field_ref="vfxsni"          name="vfxsni" />
-          <field field_ref="vfxsum"          name="vfxsum" />
-          <field field_ref="vfxbom"          name="vfxbom" />
-          <field field_ref="vfxres"          name="vfxres" />
-          <field field_ref="vfxice"          name="vfxice" />
-          <field field_ref="vfxsnw"          name="vfxsnw" />
-          <field field_ref="vfxsub"          name="vfxsub" />
-          <field field_ref="vfxspr"          name="vfxspr" />
-
-          <field field_ref="icetrp"          name="sivtrp" />
-          <field field_ref="snwtrp"          name="snvtrp" />
-          <field field_ref="saltrp"          name="saltrp" />
-          <field field_ref="deitrp"          name="deitrp" />
-          <field field_ref="destrp"          name="destrp" />
-
-          <field field_ref="sfxbri"          name="sfxbri" />
-          <field field_ref="sfxdyn"          name="sfxdyn" />
-          <field field_ref="sfxres"          name="sfxres" />
-          <field field_ref="sfxbog"          name="sfxbog" />
-          <field field_ref="sfxbom"          name="sfxbom" />
-          <field field_ref="sfxsum"          name="sfxsum" />
-          <field field_ref="sfxsni"          name="sfxsni" />
-          <field field_ref="sfxopw"          name="sfxopw" />
-          <field field_ref="sfx"             name="sfx"    />
-
-          <field field_ref="hfxsum"          name="hfxsum"     />
-          <field field_ref="hfxbom"          name="hfxbom"     />
-          <field field_ref="hfxbog"          name="hfxbog"     />
-          <field field_ref="hfxdif"          name="hfxdif"     />
-          <field field_ref="hfxopw"          name="hfxopw"     />
-          <field field_ref="hfxout"          name="hfxout"     />
-          <field field_ref="hfxin"           name="hfxin"      />
-          <field field_ref="hfxsnw"          name="hfxsnw"     />
-          <field field_ref="hfxerr"          name="hfxerr"     />
-          <field field_ref="hfxerr_rem"      name="hfxerr_rem" />
-
-	  <!-- ice-ocean heat flux from mass exchange -->
-          <field field_ref="hfxdyn"          name="hfxdyn" />
-          <field field_ref="hfxres"          name="hfxres" />
-          <field field_ref="hfxthd"          name="hfxthd" />
-	  <!-- ice-atm. heat flux from mass exchange -->
-          <field field_ref="hfxsub"          name="hfxsub" />
-          <field field_ref="hfxspr"          name="hfxspr" />
-
-	  <!-- diags -->
-          <field field_ref="hfxdhc"          name="hfxdhc" />
-          <field field_ref="hfxtur"          name="hfxtur" />
-
-          <field field_ref="isst"            name="sst"    />
-          <field field_ref="isss"            name="sss"    />
-          <field field_ref="micesalt"        name="sisali" />
-          <field field_ref="micet"           name="sitemp" />
-          <field field_ref="icest"           name="sistem" />
-          <field field_ref="icehc"           name="siheco" />
-          <field field_ref="isnowhc"         name="snheco" />
-          <field field_ref="miceage"         name="siages" />
-
-          <field field_ref="uice_ipa"        name="sivelu" />
-          <field field_ref="vice_ipa"        name="sivelv" />
-          <field field_ref="icevel"          name="sivelo" />
-          <field field_ref="idive"           name="sidive" />
-          <field field_ref="ishear"          name="sishea" />
-          <field field_ref="icestr"          name="sistre" />
-
-          <field field_ref="ibrinv"          name="sibrin" />
-          <field field_ref="icecolf"         name="sicolf" />
-
-          <field field_ref="iceage_cat"      name="siagecat" />
-          <field field_ref="iceconc_cat"     name="siconcat" />
-          <field field_ref="icethic_cat"     name="sithicat" />
-          <field field_ref="snowthic_cat"    name="snthicat" />
-          <field field_ref="salinity_cat"    name="salincat" />
-          <field field_ref="brinevol_cat"    name="sibricat" />
-	  <field field_ref="icetemp_cat"     name="sitemcat" />
-	  <field field_ref="snwtemp_cat"     name="sntemcat" />
 
 	</file>
-
-        <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." >
-          <field field_ref="voltot"       name="scvoltot"   />
-          <field field_ref="sshtot"       name="scsshtot"   />
-          <field field_ref="sshsteric"    name="scsshste"   />
-          <field field_ref="sshthster"    name="scsshtst"   />
-          <field field_ref="masstot"      name="scmastot"   />
-          <field field_ref="temptot"      name="sctemtot"   />
-          <field field_ref="saltot"       name="scsaltot"   />
-
-          <field field_ref="bgtemper"     name="bgtemper"   />
-          <field field_ref="bgsaline"     name="bgsaline"   />
-          <field field_ref="bgheatco"     name="bgheatco"   />
-          <field field_ref="bgsaltco"     name="bgsaltco"   />
-          <field field_ref="bgvolssh"     name="bgvolssh"   /> 
-          <field field_ref="bgvole3t"     name="bgvole3t"   />
-          <field field_ref="bgfrcvol"     name="bgfrcvol"   />
-          <field field_ref="bgfrctem"     name="bgfrctem"   />
-          <field field_ref="bgfrcsal"     name="bgfrcsal"   />
-
-          <field field_ref="ibgvoltot"    name="ibgvoltot"  />
-          <field field_ref="sbgvoltot"    name="sbgvoltot"  />
-          <field field_ref="ibgarea"      name="ibgarea"    />
-          <field field_ref="ibgsaline"    name="ibgsaline"  />
-          <field field_ref="ibgtemper"    name="ibgtemper"  />
-          <field field_ref="ibgheatco"    name="ibgheatco"  />
-          <field field_ref="sbgheatco"    name="sbgheatco"  />
-          <field field_ref="ibgsaltco"    name="ibgsaltco"  />
-
-          <field field_ref="ibgvfx"       name="ibgvfx"     />
-          <field field_ref="ibgvfxbog"    name="ibgvfxbog"  />
-          <field field_ref="ibgvfxopw"    name="ibgvfxopw"  />
-          <field field_ref="ibgvfxsni"    name="ibgvfxsni"  />
-          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"  />
-          <field field_ref="ibgvfxbom"    name="ibgvfxbom"  />
-          <field field_ref="ibgvfxsum"    name="ibgvfxsum"  />
-          <field field_ref="ibgvfxres"    name="ibgvfxres"  />
-          <field field_ref="ibgvfxspr"    name="ibgvfxspr"  />
-          <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"  />
-          <field field_ref="ibgvfxsub"    name="ibgvfxsub"  />
-
-          <field field_ref="ibgsfx"       name="ibgsfx"     />
-          <field field_ref="ibgsfxbri"    name="ibgsfxbri"  />
-          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn"  />
-          <field field_ref="ibgsfxres"    name="ibgsfxres"  />
-          <field field_ref="ibgsfxbog"    name="ibgsfxbog"  />
-          <field field_ref="ibgsfxopw"    name="ibgsfxopw"  />
-          <field field_ref="ibgsfxsni"    name="ibgsfxsni"  />
-          <field field_ref="ibgsfxbom"    name="ibgsfxbom"  />
-          <field field_ref="ibgsfxsum"    name="ibgsfxsum"  />
-
-          <field field_ref="ibghfxdhc"    name="ibghfxdhc"  />
-          <field field_ref="ibghfxspr"    name="ibghfxspr"  />
-
-          <field field_ref="ibghfxres"    name="ibghfxres"  />
-          <field field_ref="ibghfxsub"    name="ibghfxsub"  />
-          <field field_ref="ibghfxdyn"    name="ibghfxdyn"  />
-          <field field_ref="ibghfxthd"    name="ibghfxthd"  />
-          <field field_ref="ibghfxsum"    name="ibghfxsum"  />
-          <field field_ref="ibghfxbom"    name="ibghfxbom"  />
-          <field field_ref="ibghfxbog"    name="ibghfxbog"  />
-          <field field_ref="ibghfxdif"    name="ibghfxdif"  />
-          <field field_ref="ibghfxopw"    name="ibghfxopw"  />
-          <field field_ref="ibghfxout"    name="ibghfxout"  />
-          <field field_ref="ibghfxin"     name="ibghfxin"   />
-          <field field_ref="ibghfxsnw"    name="ibghfxsnw"  />
-
-          <field field_ref="ibgfrcvol"    name="ibgfrcvol"  />
-          <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  />
-          <field field_ref="ibgvolgrm"    name="ibgvolgrm"  />
-
-        </file>
 
 	<!--
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg	(revision 8879)
@@ -19,9 +19,4 @@
 /
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
-/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
@@ -81,5 +76,4 @@
 &nambbc        !   bottom temperature boundary condition                (default: NO)
 !-----------------------------------------------------------------------
-   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
 /
 !-----------------------------------------------------------------------
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg	(revision 8879)
@@ -1,48 +1,84 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref
-!!              1 - Generic parameters                 (namicerun)
-!!              2 - Diagnostics                        (namicediag)
-!!              3 - Ice initialization                 (namiceini)
-!!              4 - Ice discretization                 (namiceitd)
-!!              5 - Ice dynamics and transport         (namicedyn)
-!!              6 - Ice diffusion                      (namicehdf)
-!!              7 - Ice thermodynamics                 (namicethd)
-!!              8 - Ice salinity                       (namicesal)
-!!              9 - Ice mechanical redistribution      (namiceitdme)
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! ESIM configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref
+!!              1 - Generic parameters                 (nampar)
+!!              2 - Ice thickness discretization       (namitd)
+!!              3 - Ice dynamics                       (namdyn)
+!!              4 - Ice ridging/rafting                (namdyn_rdgrft)
+!!              5 - Ice rheology                       (namdyn_rhg)
+!!              6 - Ice advection                      (namdyn_adv)
+!!              7 - Ice surface forcing                (namforcing)
+!!              8 - Ice thermodynamics                 (namthd)
+!!              9 - Ice heat diffusion                 (namthd_zdf)
+!!             10 - Ice lateral melting                (namthd_da)
+!!             11 - Ice growth in open water           (namthd_do)
+!!             12 - Ice salinity                       (namthd_sal)
+!!             13 - Ice melt ponds                     (namthd_pnd)
+!!             14 - Ice initialization                 (namini)
+!!             15 - Ice/snow albedos                   (namalb)
+!!             16 - Ice diagnostics                    (namdia)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
 !------------------------------------------------------------------------------
-&namicerun     !   Generic parameters
+&nampar         !   Generic parameters
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicediag    !   Diagnostics
+&namitd         !   Ice discretization
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namiceini     !   Ice initialization
+&namdyn         !   Ice dynamics
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namiceitd     !   Ice discretization
+&namdyn_rdgrft  !   Ice ridging/rafting
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicedyn     !   Ice dynamics and transport
+&namdyn_rhg     !   Ice rheology
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicehdf     !   Ice horizontal diffusion
+&namdyn_adv     !   Ice advection
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicethd     !   Ice thermodynamics
+&namforcing     !   Ice surface forcing
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicesal     !   Ice salinity
+&namthd         !   Ice thermodynamics
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+&namthd_zdf     !   Ice heat diffusion
 !------------------------------------------------------------------------------
 /
+!------------------------------------------------------------------------------
+&namthd_da      !   Ice lateral melting
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_do      !   Ice growth in open water
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_sal     !   Ice salinity
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_pnd     !   Melt ponds
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namini         !   Ice initialization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namalb         !   albedo parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdia         !   Diagnostics
+!------------------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm	(revision 8879)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_trabbl key_lim3  key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
+ bld::tool::fppkeys key_lim3 key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml	(revision 8879)
@@ -12,30 +12,109 @@
       <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc -->
 
-         <!-- LIM2(only) fields -->
-         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         />
-         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
-         <field id="qla_ai_cea"   long_name="Air-Ice downward Latent heat flux (cell average)"             standard_name="surface_downward_latent_heat_flux"                  unit="W/m2"         />         
-         <field id="qsr_io_cea"   long_name="Ice-Oce downward solar heat flux (cell average)"              standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         />
-         <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
-         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                                                                                   unit="m/s"          />
-         <field id="iiceconc"     long_name="Ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="1"            />
-         <field id="ice_pres"     long_name="Ice presence"                                                                                                                    unit=""             />
-         <field id="ist_cea"      long_name="Ice surface temperature (cell average)"                       standard_name="surface_temperature"                                unit="degC"         />
-         <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               standard_name="surface_temperature"                                unit="degC"         />
-         <field id="u_imasstr"    long_name="Sea-ice mass transport along i-axis"                          standard_name="sea_ice_x_transport"                                unit="kg/s"         />
-         <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          standard_name="sea_ice_y_transport"                                unit="kg/s"         />
+         <!-- SIMIP LIM fields -->
+         <field id="icethick"     long_name="Sea-ice thickness per area"                           standard_name="sea_ice_thickness"                          unit="m"   />
+         <field id="icethic"      long_name="Sea-ice thickness"                                    standard_name="sea_ice_thickness"                          unit="m"   />
+         <field id="uice_mv"      long_name="X-component of sea ice velocity"                      standard_name="sea_ice_x_velocity"                         unit="m/s" /> 
+         <field id="vice_mv"      long_name="Y-component of sea ice velocity"                      standard_name="sea_ice_y_velocity"                         unit="m/s" />      
+         <field id="icevel_mv"    long_name="Sea-ice speed"                                        standard_name="sea_ice_speed"                              unit="m/s" />
+         <field id="icepres"      long_name="Fraction of time steps with sea ice"                  standard_name="sea_ice_time_fraction"                      unit=""             />
+         <field id="iceconc"      long_name="Sea-ice area fraction"                                standard_name="sea_ice_area_fraction"                      unit=""             />
+         <field id="iceconc_pct"  long_name="Sea-ice area fraction in percent"                     standard_name="sea_ice_area_fraction_in_percent"           unit="%"             > iceconc * 100. </field >
+         <field id="icemass"      long_name="Sea-ice mass per area"                                standard_name="sea_ice_amount"                             unit="kg/m2"        />
+         <field id="icevolu"      long_name="Sea-ice volume per area"                              standard_name="sea_ice_thickness"                          unit="m"            />
+         <field id="snomass"      long_name="Snow mass per area"                                   standard_name="liquid_water_content_of_surface_snow"       unit="kg/m2"        />
+         <field id="snothic"      long_name="Snow thickness"                                       standard_name="surface_snow_thickness"                     unit="m"            />
+
+         <field id="iceconc_cat_mv"     long_name="Sea-ice area fractions in thickness categories" standard_name="sea_ice_area_fraction_over_categories"      unit=""   grid_ref="grid_T_3D_ncatice" />
+         <field id="iceconc_cat_pct_mv" long_name="Sea-ice area fractions in thickness categories" standard_name="sea_ice_area_fraction_over_categories"      unit="%"  grid_ref="grid_T_3D_ncatice"  > iceconc_cat_mv * 100. </field >
+         <field id="icethic_cat_mv"     long_name="Sea-ice thickness in thickness categories"      standard_name="sea_ice_thickness_over_categories"          unit="m"  grid_ref="grid_T_3D_ncatice" />
+         <field id="snowthic_cat_mv"    long_name="Snow thickness in thickness categories"         standard_name="snow_thickness_over_categories"             unit="m"  grid_ref="grid_T_3D_ncatice" />
+
+         <field id="icestK"       long_name="Surface temperature of sea ice"                       standard_name="sea_ice_surface_temperature"                unit="K"            /> 
+         <field id="icesntK"      long_name="Temperature at snow-ice interface"                    standard_name="sea_ice_snow_interface_temperature"         unit="K"            />
+         <field id="icebotK"      long_name="Temperature at ice-ocean interface"                   standard_name="sea_ice_bottom_temperature"                 unit="K"            />
+
+         <field id="iceage"       long_name="Age of sea ice"                                       standard_name="age_of_sea_ice"                             unit="s"            />
+         <field id="icealb"       long_name="Sea-ice or snow albedo"                               standard_name="sea_ice_albedo"                             unit=""             />
+         <field id="icesmass"     long_name="Mass of salt in sea ice per area"                     standard_name="sea_ice_salt_mass"                          unit="kg/m2"        />
+         <field id="icesal"       long_name="Sea ice salinity"                                     standard_name="sea_ice_salinity"                           unit="g/kg"         />
+         <field id="icefb"        long_name="Sea-ice freeboard"                                    standard_name="sea_ice_freeboard"                          unit="m"            />
+
+         <field id="icehcneg"     long_name="Sea-ice heat content per unit area"  standard_name="integral_of_sea_ice_temperature_wrt_depth_expressed_as_heat_content" unit="J/m2" > (-1.0)*icehc </field>
+         <field id="isnhcneg"     long_name="Snow-heat content per unit area"     standard_name="thermal_energy_content_of_surface_snow"                              unit="J/m2" > </field>
+
+         <field id="wfxsum"       long_name="Freshwater flux from sea-ice surface"               standard_name="freshwater_flux_from_ice_surface"                   unit="kg/m2/s"      />
+
+         <field id="afxthd"       long_name="sea-ice area fraction change from thermodynamics"   standard_name="tendency_of_sea_ice_area_fraction_due_to_dynamics"  unit="s-1"   />
+         <field id="afxdyn"       long_name="sea-ice area fraction change from dynamics"         standard_name="tendency_of_sea_ice_area_fraction_due_to_dynamics"  unit="s-1"   />
+
+         <field id="dmithd"       long_name="sea-ice mass change from thermodynamics"            standard_name="tendency_of_sea_ice_amount_due_to_thermodynamics"   unit="kg/m2/s" />
+         <field id="dmidyn"       long_name="sea-ice mass change from dynamics"                  standard_name="tendency_of_sea_ice_amount_due_to_dynamics"         unit="kg/m2/s" />
+         <field id="dmiopw"       long_name="sea-ice mass change through growth in supercooled open water (aka frazil)"   standard_name="tendency_of_sea_ice_amount_due_to_freezing_in_open_water"   unit="kg/m2/s" />
+         <field id="dmibog"       long_name="sea-ice mass change through basal growth"           standard_name="tendency_of_sea_ice_amount_due_to_congelation_ice_accumulation"  unit="kg/m2/s" />
+         <field id="dmisni"       long_name="sea-ice mass change through snow-to-ice conversion" standard_name="tendency_of_sea_ice_amount_due_to_snow_conversion"               unit="kg/m2/s" />
+         <field id="dmtsub"       long_name="snow and sea ice mass change through sublimation"   standard_name="tendency_of_snow_and_ice_amount_due_to_sublimation"              unit="kg/m2/s" />
+         <field id="dmssub"       long_name="sea-ice mass change through evaporation and sublimation" standard_name="water_evaporation_flux"                                     unit="kg/m2/s" />
+         <field id="dmisub"       long_name="snow mass change through evaporation or sublimation"     standard_name="surface_snow_sublimation_flux"           unit="kg/m2/s" />
+         <field id="dmisum"       long_name="sea-ice mass change through surface melting"        standard_name="tendency_of_sea_ice_amount_due_to_surface_melting"               unit="kg/m2/s" />
+         <field id="dmibom"       long_name="sea-ice mass change through bottom melting"         standard_name="tendency_of_sea_ice_amount_due_to_basal_melting"                 unit="kg/m2/s" />
+
+         <field id="dmsspr"       long_name="snow mass change through snow fall"                 standard_name="snowfall_flux"                                                   unit="kg/m2/s" />
+         <field id="dmsmel"       long_name="snow mass change through melt"                      standard_name="surface_snow_melt_flux"                                          unit="kg/m2/s" />
+         <field id="dmsdyn"       long_name="snow mass change through advection by sea-ice dynamics" standard_name="tendency_of_snow_mass_due_to_sea_ice_dynamics"               unit="kg/m2/s" />
+         <field id="dmsssi"       long_name="snow mass change through snow-to-ice conversion"    standard_name="tendency_of_snow_mass_due_to_snow_to_ice_conversion"             unit="kg/m2/s" />
+
+         <field id="hfxsenso"     long_name="Net sensible heat flux under sea ice"               standard_name="ice_ocean_heat_flux"                          unit="W/m2" />
+         <field id="hfxconsu"     long_name="Net conductive heat flux in ice at the surface"     standard_name="conductive_heat_flux_at_sea_ice_surface"      unit="W/m2" /> 
+         <field id="hfxconbo"     long_name="Net conductive heat fluxes in ice at the bottom"    standard_name="conductive_heat_flux_at_sea_ice_bottom"       unit="W/m2" />
+
+         <field id="sfx_mv"       long_name="Salt flux from sea ice"                             standard_name="salt_flux_from_ice"                           unit="kg/m2/s" />
+         <field id="wfxtot"       long_name="Freshwater flux from sea ice"                       standard_name="freshwater_flux_from_ice"                     unit="kg/m2/s" /> 
+
+         <field id="utau_ice"     long_name="X-component of atmospheric stress on sea ice"       standard_name="surface_downward_x_stress"                    unit="N/m2"    />
+         <field id="vtau_ice"     long_name="Y-component of atmospheric stress on sea ice"       standard_name="surface_downward_y_stress"                    unit="N/m2"    />
+
+         <field id="utau_oi"      long_name="X-component of ocean stress on sea ice"             standard_name="sea_ice_base_upward_x_stress"                 unit="N/m2"    />
+         <field id="vtau_oi"      long_name="Y-component of ocean stress on sea ice"             standard_name="sea_ice_base_upward_y_stress"                 unit="N/m2"    />
+
+         <field id="icestr"       long_name="Compressive sea ice strength"                       standard_name="compressive_strength_of_sea_ice"              unit="N/m"     />
+
+         <field id="dssh_dx"      long_name="Sea-surface tilt term in force balance (x-component)"  standard_name="sea_surface_tilt_force_on_sea_ice_x"       unit="N/m2"    />
+         <field id="dssh_dy"      long_name="Sea-surface tilt term in force balance (y-component)"  standard_name="sea_surface_tilt_force_on_sea_ice_y"       unit="N/m2"    />
+
+         <field id="corstrx"      long_name="Coriolis force term in force balance (x-component)"    standard_name="coriolis_force_on_sea_ice_x"               unit="N/m2"    />
+         <field id="corstry"      long_name="Coriolis force term in force balance (y-component)"    standard_name="coriolis_force_on_sea_ice_y"               unit="N/m2"    />
+
+         <field id="intstrx"      long_name="Internal stress term in force balance (x-component)"   standard_name="internal_stress_in_sea_ice_x"              unit="N/m2"    />
+         <field id="intstry"      long_name="Internal stress term in force balance (y-component)"   standard_name="internal_stress_in_sea_ice_y"              unit="N/m2"    />
+
+         <field id="xmtrpice"     long_name="X-component of ice mass transport"                  standard_name="ice_x_transport"                              unit="kg/s" />
+         <field id="ymtrpice"     long_name="Y-component of ice mass transport"                  standard_name="ice_y_transport"                              unit="kg/s" />
+
+         <field id="xmtrpsnw"     long_name="X-component of snw mass transport"                  standard_name="snw_x_transport"                              unit="kg/s" />
+         <field id="ymtrpsnw"     long_name="Y-component of snw mass transport"                  standard_name="snw_y_transport"                              unit="kg/s" />
+
+         <field id="xatrp"        long_name="X-component of ice area transport"                  standard_name="area_x_transport"                             unit="m2/s" />
+         <field id="yatrp"        long_name="Y-component of ice area transport"                  standard_name="area_y_transport"                             unit="m2/s" />
+
+         <field id="xmtrptot"     long_name="X-component of sea-ice mass transport"              standard_name="sea_ice_x_transport"                          unit="kg/s" > xmtrpice + xmtrpsnw </field>
+         <field id="ymtrptot"     long_name="Y-component of sea-ice mass transport"              standard_name="sea_ice_y_transport"                          unit="kg/s" > ymtrpice + ymtrpsnw </field>
+
+         <field id="normstr"      long_name="Average normal stress in sea ice"                   standard_name="average_normal_stress"                        unit="N/m"     />
+         <field id="sheastr"      long_name="Maximum shear stress in sea ice"                    standard_name="maximum_shear_stress"                         unit="N/m"     />
+
+         <field id="idive"        long_name="Divergence of the sea-ice velocity field"           standard_name="divergence_of_sea_ice_velocity"               unit="s-1"     />
+         <field id="ishear"       long_name="Maximum shear of sea-ice velocity field"            standard_name="maximum_shear_of_sea_ice_velocity"            unit="s-1"     />
+
+
 
          <!-- LIM3 fields -->  
+
          <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            />
- 
-         <field id="snowthic_cea" long_name="Snow thickness (cell average)"                                standard_name="surface_snow_thickness"                             unit="m"            />
-         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 standard_name="sea_ice_thickness"                                  unit="m"            />
-
-         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  standard_name="sea_ice_x_velocity"                                 unit="m/s"          />      
-         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  standard_name="sea_ice_y_velocity"                                 unit="m/s"          />               
-         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             standard_name="surface_downward_x_stress"                          unit="N/m2"         />
-         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             standard_name="surface_downward_y_stress"                          unit="N/m2"         />
-         
-         <field id="iceconc"      long_name="ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="%"            />
+         <field id="icepres"      long_name="Ice presence"                                                                                                                    unit=""             />
+
+         <field id="uice_ipa"     long_name="X-component of sea ice velocity"                              standard_name="sea_ice_x_velocity"                                 unit="m/s"          /> 
+         <field id="vice_ipa"     long_name="Y-component of sea ice velocity"                              standard_name="sea_ice_y_velocity"                                 unit="m/s"          />      
+         <field id="icevel"       long_name="Sea-ice speed"                                                standard_name="sea_ice_speed"                                      unit="m/s"          />
        	 <field id="isst"         long_name="sea surface temperature"                                      standard_name="sea_surface_temperature"                            unit="degC"         />
          <field id="isss"         long_name="sea surface salinity"                                         standard_name="sea_surface_salinity"                               unit="1e-3"         /> 
@@ -48,68 +127,68 @@
          <field id="qtr_ice"      long_name="solar heat flux transmitted through ice: sum over categories"                                                                    unit="W/m2"         />
          <field id="qemp_ice"     long_name="Downward Heat Flux from E-P over ice"                                                                                            unit="W/m2"         />
-         <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="1e-3"         />
-         <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        />
-         <field id="alb_ice"      long_name="Mean albedo over sea ice"                                                                                                        unit=""             />
          <field id="albedo"       long_name="Mean albedo over sea ice and ocean"                                                                                              unit=""             />
 
+	 <field id="iceamp"       long_name="melt pond fraction"                                           standard_name="sea_ice_meltpond_fraction"                          unit="%"            /> 
+         <field id="icevmp"       long_name="melt pond volume"                                             standard_name="sea_ice_meltpond_volume"                            unit="m"            /> 
+
+         <field id="iceconc_cat"  long_name="Sea-ice concentration in thickness categories"                unit=""   grid_ref="grid_T_3D_ncatice" />
+         <field id="icethic_cat"  long_name="Sea-ice thickness in thickness categories"                    unit="m"  grid_ref="grid_T_3D_ncatice" />
+         <field id="snowthic_cat" long_name="Snow thickness in thickness categories"                       unit="m"  grid_ref="grid_T_3D_ncatice" />
          <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   grid_ref="grid_T_3D_ncatice" />
-         <field id="iceconc_cat"  long_name="Ice concentration for categories"                             unit="%"      grid_ref="grid_T_3D_ncatice" />
-         <field id="icethic_cat"  long_name="Ice thickness for categories"                                 unit="m"      grid_ref="grid_T_3D_ncatice" />
-         <field id="snowthic_cat" long_name="Snow thicknessi for categories"                               unit="m"      grid_ref="grid_T_3D_ncatice" />
          <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="g/kg"   grid_ref="grid_T_3D_ncatice" />
          <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      grid_ref="grid_T_3D_ncatice" />
          <field id="icetemp_cat"  long_name="Ice temperature for categories"                               unit="degC"   grid_ref="grid_T_3D_ncatice" />
          <field id="snwtemp_cat"  long_name="Snow temperature for categories"                              unit="degC"   grid_ref="grid_T_3D_ncatice" />
+         <field id="iceamp_cat"   long_name="Ice melt pond concentration for categories"                   unit="%"      grid_ref="grid_T_3D_ncatice" /> 
+         <field id="icevmp_cat"   long_name="Ice melt pond volume for categories"                          unit="m"      grid_ref="grid_T_3D_ncatice" /> 
+         <field id="icehmp_cat"   long_name="Ice melt pond thickness for categories"                       unit="m"      grid_ref="grid_T_3D_ncatice" /> 
+         <field id="iceafp_cat"   long_name="Ice melt pond fraction for categories"                        unit="m"      grid_ref="grid_T_3D_ncatice" /> 
 
          <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     />
-         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9J"    /> 
-         <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    />
+         <field id="miceage"      long_name="Age of sea ice"                                               unit="s"        />
+         <field id="micesalt"     long_name="Sea ice salinity"                                             unit="g/kg"     />
+         <field id="icehc"        long_name="ice total heat content"                                       unit="J/m2"     /> 
+         <field id="isnowhc"      long_name="snow total heat content"                                      unit="J/m2"     />
          <field id="icest"        long_name="ice surface temperature"                                      unit="degC"     />
          <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        />
          <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        />
-         <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      />
-         <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      />
-         <field id="idive"        long_name="divergence"                                                   unit="1e-8s-1"  />
-         <field id="ishear"       long_name="shear"                                                        unit="1e-8s-1"  />
-         <field id="icevolu"      long_name="ice volume"                                                   unit="m"        />
          <field id="snowvol"      long_name="snow volume"                                                  unit="m"        />
          <field id="tau_icebfr"   long_name="ice friction on ocean bottom for landfast ice"                unit="N/2"      />
 
-         <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"          />
-         <field id="snwtrp"       long_name="snw volume transport"                                         unit="m/day"          />
-         <field id="saltrp"       long_name="salt content transport"                                       unit="1e-3*kg/m2/day" />
+         <field id="icetrp"       long_name="ice mass transport"                                           unit="kg/m2/s"          />
+         <field id="snwtrp"       long_name="snw mass transport"                                           unit="kg/m2/s"          />
+         <field id="saltrp"       long_name="salt     transport"                                           unit="1e-3*kg/m2/s" />
          <field id="deitrp"       long_name="advected ice enthalpy"                                        unit="W/m2"           />
          <field id="destrp"       long_name="advected snw enthalpy"                                        unit="W/m2"           />
 
-         <field id="sfxbri"       long_name="brine salt flux"                                              unit="1e-3*kg/m2/day" />
-         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="1e-3*kg/m2/day" />
-         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="1e-3*kg/m2/day" />
-         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="1e-3*kg/m2/day" />
-         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/day" />
-         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/day" />
-         <field id="sfxlam"       long_name="salt flux from lateral melt"                                  unit="1e-3*kg/m2/day" />
-         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" />
-         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" />
-         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/day" />
-         <field id="sfx"          long_name="salt flux total"                                              unit="1e-3*kg/m2/day" />
-
-         <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   />
-         <field id="vfxdyn"       long_name="daily  dynamic ice prod."                                     unit="m/day"   />
-         <field id="vfxopw"       long_name="daily lateral thermo ice prod."                               unit="m/day"   />
-         <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   />
-         <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   />
-         <field id="vfxlam"       long_name="lateral melt"                                                 unit="m/day"   />
-         <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   />
-         <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   />
-         <field id="vfxice"       long_name="ice melt/growth"                                              unit="m/day"   />
-         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   />
-         <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   />
-         <field id="vfxsub_err"   long_name="excess of snw sublimation sent to ocean"                      unit="m/day"   />
-         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   />
-         <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(20cm) + open water"      unit="m/day"   />
-
-         <field id="afxtot"       long_name="area tendency (total)"                                        unit="day-1"   />
-         <field id="afxdyn"       long_name="area tendency (dynamics)"                                     unit="day-1"   />
-         <field id="afxthd"       long_name="area tendency (thermo)"                                       unit="day-1"   />
+         <field id="sfxbri"       long_name="salt flux from brines"                                        unit="1e-3*kg/m2/s" />
+         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="1e-3*kg/m2/s" />
+         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="1e-3*kg/m2/s" />
+         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="1e-3*kg/m2/s" />
+         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/s" />
+         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/s" />
+         <field id="sfxlam"       long_name="salt flux from lateral melt"                                  unit="1e-3*kg/m2/s" />
+         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/s" />
+         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/s" />
+         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/s" />
+         <field id="sfx"          long_name="Salt flux from sea ice"                                       unit="1e-3*kg/m2/s" />
+
+         <field id="vfxbog"       long_name="bottom thermo ice prod."                                      unit="kg/m2/s"   />
+         <field id="vfxdyn"       long_name="dynamic ice prod."                                            unit="kg/m2/s"   />
+         <field id="vfxopw"       long_name="lateral thermo ice prod."                                     unit="kg/m2/s"   />
+         <field id="vfxsni"       long_name="snowice ice prod."                                            unit="kg/m2/s"   />
+         <field id="vfxsum"       long_name="surface melt"                                                 unit="kg/m2/s"   />
+         <field id="vfxlam"       long_name="lateral melt"                                                 unit="kg/m2/s"   />
+         <field id="vfxbom"       long_name="bottom melt"                                                  unit="kg/m2/s"   />
+         <field id="vfxres"       long_name="resultant ice prod./melting"                                  unit="kg/m2/s"   />
+         <field id="vfxice"       long_name="ice melt/growth"                                              unit="kg/m2/s"   />
+         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="kg/m2/s"   />
+         <field id="vfxsub"       long_name="snw sublimation"                                              unit="kg/m2/s"   />
+         <field id="vfxsub_err"   long_name="excess of snw sublimation sent to ocean"                      unit="kg/m2/s"   />
+         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="kg/m2/s"   />
+         <field id="vfxthin"      long_name="thermo ice prod. for thin ice(20cm) + open water"             unit="kg/m2/s"   />
+         <field id="vfxpnd"       long_name="melt pond water flux to ocean"                                unit="kg/m2/s"   />
+
+         <field id="afxtot"       long_name="area tendency (total)"                                        unit="s-1"   />
 
          <field id="hfxsum"       long_name="heat fluxes causing surface ice melt"                         unit="W/m2"  />
@@ -135,5 +214,5 @@
          <field id="hfxtur"       long_name="turbulent heat flux at the ice base"                          unit="W/m2" />
 
-	 <!-- sbcssm variables -->
+	     <!-- sbcssm variables -->
          <field id="sst_m"    unit="degC" />
          <field id="sss_m"    unit="psu"  />
@@ -144,4 +223,9 @@
          <field id="frq_m"    unit="-"    />
 
+         <!-- specific for rheology -->
+         <field id="isig1"        long_name="1st principal stress component for EVP rhg"                   unit="unitless" />
+         <field id="isig2"        long_name="2nd principal stress component for EVP rhg"                   unit="unitless" />
+         <field id="isig3"        long_name="convergence measure for EVP rheology (must be =1)"            unit="unitless" />
+
       </field_group>
 
@@ -149,23 +233,35 @@
       <field_group id="SBC_scalar"  grid_ref="grid_T_2D" >
          <!-- available with ln_limdiaout -->
-         <field id="ibgfrcvoltop"    long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)"   unit="km3"       />
-         <field id="ibgfrcvolbot"    long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3"       />
-         <field id="ibgfrctemtop"    long_name="global mean heat on top of ice/snw/ocean-atm "                                             unit="1e20J"     />
-         <field id="ibgfrctembot"    long_name="global mean heat below ice (on top of ocean) "                                             unit="1e20J"     />
-         <field id="ibgfrcsal"       long_name="global mean ice/snow forcing (salt equivalent ocean volume)"                               unit="pss*km3"   />
-         <field id="ibgfrchfxtop"    long_name="global mean heat flux on top of ice/snw/ocean-atm "                                        unit="W/m2"      />
-         <field id="ibgfrchfxbot"    long_name="global mean heat flux below ice (on top of ocean) "                                        unit="W/m2"      />
+         <field id="ibgfrcvoltop"    long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)"   unit="km3"        />
+         <field id="ibgfrcvolbot"    long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3"        />
+         <field id="ibgfrctemtop"    long_name="global mean heat on top of ice/snw/ocean-atm "                                             unit="1e20J"      />
+         <field id="ibgfrctembot"    long_name="global mean heat below ice (on top of ocean) "                                             unit="1e20J"      />
+         <field id="ibgfrcsal"       long_name="global mean ice/snow forcing (salt equivalent ocean volume)"                               unit="pss*km3"    />
+         <field id="ibgfrchfxtop"    long_name="global mean heat flux on top of ice/snw/ocean-atm "                                        unit="W/m2"       />
+         <field id="ibgfrchfxbot"    long_name="global mean heat flux below ice (on top of ocean) "                                        unit="W/m2"       />
  
-         <field id="ibgvolume"       long_name="drift in ice/snow volume (equivalent ocean volume)"            unit="km3"        />
-         <field id="ibgsaltco"       long_name="drift in ice salt content (equivalent ocean volume)"           unit="pss*km3"    />
-         <field id="ibgheatco"       long_name="drift in ice/snow heat content"                                unit="1e20J"      />
-         <field id="ibgheatfx"       long_name="drift in ice/snow heat flux"                                   unit="W/m2"       />
-
-         <field id="ibgvol_tot"      long_name="global mean ice volume"                                        unit="km3"        />
-         <field id="sbgvol_tot"      long_name="global mean snow volume"                                       unit="km3"        />
-         <field id="ibgarea_tot"     long_name="global mean ice area"                                          unit="km2"        />
-         <field id="ibgsalt_tot"     long_name="global mean ice salt content"                                  unit="1e-3*km3"   />
-         <field id="ibgheat_tot"     long_name="global mean ice heat content"                                  unit="1e20J"      />
-         <field id="sbgheat_tot"     long_name="global mean snow heat content"                                 unit="1e20J"      />
+         <field id="ibgvolume"       long_name="drift in ice/snow volume (equivalent ocean volume)"                                        unit="km3"        />
+         <field id="ibgsaltco"       long_name="drift in ice salt content (equivalent ocean volume)"                                       unit="pss*km3"    />
+         <field id="ibgheatco"       long_name="drift in ice/snow heat content"                                                            unit="1e20J"      />
+         <field id="ibgheatfx"       long_name="drift in ice/snow heat flux"                                                               unit="W/m2"       />
+
+         <field id="ibgvol_tot"      long_name="global mean ice volume"                                                                    unit="km3"        />
+         <field id="sbgvol_tot"      long_name="global mean snow volume"                                                                   unit="km3"        />
+         <field id="ibgarea_tot"     long_name="global mean ice area"                                                                      unit="km2"        />
+         <field id="ibgsalt_tot"     long_name="global mean ice salt content"                                                              unit="1e-3*km3"   />
+         <field id="ibgheat_tot"     long_name="global mean ice heat content"                                                              unit="1e20J"      />
+         <field id="sbgheat_tot"     long_name="global mean snow heat content"                                                             unit="1e20J"      />
+
+         <field id="NH_iceextt"      long_name="Sea ice extent North"                            standard_name="sea_ice_extent_n"          unit="1e6_km2"    />
+         <field id="SH_iceextt"      long_name="Sea ice extent South"                            standard_name="sea_ice_extent_s"          unit="1e6_km2"    />
+         <field id="NH_icevolu"      long_name="Sea ice volume North"                            standard_name="sea_ice_volume_n"          unit="1e3_km3"    />
+         <field id="SH_icevolu"      long_name="Sea ice volume South"                            standard_name="sea_ice_volume_s"          unit="1e3_km3"    />
+         <field id="NH_icearea"      long_name="Sea ice area North"                              standard_name="sea_ice_area_n"            unit="1e6_km2"    />
+         <field id="SH_icearea"      long_name="Sea ice area South"                              standard_name="sea_ice_area_s"            unit="1e6_km2"    />
+
+         <field id="strait_mifl"     long_name="Sea ice mass flux through straits"      standard_name="sea_ice_mass_transport_across_line" unit="kg/s"  grid_ref="grid_4strait"   />
+         <field id="strait_arfl"     long_name="Sea ice area flux through straits"      standard_name="sea_ice_area_transport_across_line" unit="m2/s"  grid_ref="grid_4strait"   />  
+         <field id="strait_msfl"     long_name="Sea ice snow flux through straits"      standard_name="snow_mass_transport_across_line"    unit="kg/s"  grid_ref="grid_4strait"   />
+
       </field_group>
   
@@ -176,8 +272,159 @@
       
       <field_group id="myvarICE" >
-         <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        />
+         <field field_ref="icethick"          name="sithic"     long_name="sea_ice_thickness"        />
          <field field_ref="icevolu"          name="sivolu"  />
          <field field_ref="iceconc"          name="siconc"  />
       </field_group>    
-      
+
+      <field_group id="ICE_globalbudget">
+
+    	<field field_ref="ibgvol_tot"     grid_ref="grid_1point"  name="ibgvol_tot"   />
+	    <field field_ref="sbgvol_tot"     grid_ref="grid_1point"  name="sbgvol_tot"   />
+    	<field field_ref="ibgarea_tot"    grid_ref="grid_1point"  name="ibgarea_tot"  />
+    	<field field_ref="ibgsalt_tot"    grid_ref="grid_1point"  name="ibgsalt_tot"  />
+    	<field field_ref="ibgheat_tot"    grid_ref="grid_1point"  name="ibgheat_tot"  />
+    	<field field_ref="sbgheat_tot"    grid_ref="grid_1point"  name="sbgheat_tot"  />
+
+     	<field field_ref="ibgvolume"      grid_ref="grid_1point"  name="ibgvolume"    />
+    	<field field_ref="ibgsaltco"      grid_ref="grid_1point"  name="ibgsaltco"    />
+    	<field field_ref="ibgheatco"      grid_ref="grid_1point"  name="ibgheatco"    />
+        <field field_ref="ibgheatfx"      grid_ref="grid_1point"  name="ibgheatfx"    />
+
+    	<field field_ref="ibgfrcvoltop"   grid_ref="grid_1point"  name="ibgfrcvoltop" />
+    	<field field_ref="ibgfrcvolbot"   grid_ref="grid_1point"  name="ibgfrcvolbot" />
+    	<field field_ref="ibgfrctemtop"   grid_ref="grid_1point"  name="ibgfrctemtop" />
+    	<field field_ref="ibgfrctembot"   grid_ref="grid_1point"  name="ibgfrctembot" />
+    	<field field_ref="ibgfrcsal"      grid_ref="grid_1point"  name="ibgfrcsal"    />
+        <field field_ref="ibgfrchfxtop"   grid_ref="grid_1point"  name="ibgfrchfxtop" />
+        <field field_ref="ibgfrchfxbot"   grid_ref="grid_1point"  name="ibgfrchfxbot" />
+
+      </field_group>
+
+
+      <!--============================-->
+      <!-- SIMIP sea ice field groups -->
+      <!-- Notz et al 2016            -->
+      <!--============================-->
+
+      <!-- SIMIP monthly scalar variables -->
+      <field_group id="SImon_scalars">
+        <!-- Integrated quantities -->
+        <field field_ref="NH_iceextt"     grid_ref="grid_1point"  name="siextentn"    />
+        <field field_ref="SH_iceextt"     grid_ref="grid_1point"  name="siextents"    />
+        <field field_ref="NH_icevolu"     grid_ref="grid_1point"  name="sivoln"       />
+        <field field_ref="SH_icevolu"     grid_ref="grid_1point"  name="sivols"       />
+        <field field_ref="NH_icearea"     grid_ref="grid_1point"  name="siarean"      />
+        <field field_ref="SH_icearea"     grid_ref="grid_1point"  name="siareas"      />
+      </field_group>
+
+      <!-- SIMIP daily fields --> <field_group id="SIday_fields"> 
+          <field field_ref="icepres"          name="sitimefrac"   /> 
+          <field field_ref="iceconc_pct"      name="siconc"       /> 
+          <field field_ref="icethic"          name="sithick"      default_value="1.0e20" detect_missing_value="true" operation="average" /> 
+          <field field_ref="snothic"          name="sisnthick"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icestK"           name="sitemptop"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="uice_mv"          name="siu"          default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="vice_mv"          name="siv"          default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icevel_mv"        name="sispeed"      default_value="1.0e20" detect_missing_value="true" operation="average" />
+      </field_group>
+
+      <!-- SIMIP monthly fields -->
+      <field_group id="SImon_fields">
+          <!-- Sea-ice state variables -->
+          <field field_ref="icepres"          name="sitimefrac"   />
+          <field field_ref="iceconc_pct"      name="siconc"       />
+          <field field_ref="icemass"          name="simass"       />
+          <field field_ref="icethic"          name="sithick"      default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icevolu"          name="sivol"        />
+          <field field_ref="snomass"          name="sisnmass"     default_value="1.0e20" detect_missing_value="true" operation="average" /> 
+          <field field_ref="snothic"          name="sisnthick"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+   
+          <!-- category-dependent fields -->
+          <field field_ref="iceconc_cat_pct_mv"  name="siitdconc"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icethic_cat_mv"      name="siitdthick"   default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="snowthic_cat_mv"     name="siitdsnthick" default_value="1.0e20" detect_missing_value="true" operation="average"/>
+
+          <!-- additional state variables-->
+          <field field_ref="icestK"           name="sitemptop"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icesntK"          name="sitempsnic"   default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icebotK"          name="sitempbot"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="iceage"           name="siage"        default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icesmass"         name="sisaltmass"   />
+          <field field_ref="icesal"           name="sisali"       default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icefb"            name="sifb"         default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icehcneg"         name="sihc"         />
+          <field field_ref="isnhcneg"         name="sisnhc"       default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <!-- freshwater fluxes -->
+          <field field_ref="wfxtot"           name="siflfwbot"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="wfxsum"           name="siflfwdrain"  default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <!-- area balance -->
+          <field field_ref="afxthd"           name="sidconcth"    />
+          <field field_ref="afxdyn"           name="sidconcdyn"   />
+
+          <!-- mass balance -->
+          <field field_ref="dmithd"           name="sidmassth"    />
+          <field field_ref="dmidyn"           name="sidmassdyn"   />
+          <field field_ref="dmiopw"           name="sidmassgrowthwat" />
+          <field field_ref="dmibog"           name="sidmassgrowthbot" />
+          <field field_ref="dmisni"           name="sidmasssi"        />
+          <field field_ref="dmisub"           name="sidmassevapsubl"  />
+          <field field_ref="dmisum"           name="sidmassmelttop"   />
+          <field field_ref="dmibom"           name="sidmassmeltbot"   />
+          <field field_ref="dmsspr"           name="sndmasssnf"       />
+          <field field_ref="dmsmel"           name="sndmassmelt"      />
+          <field field_ref="dmssub"           name="sndmasssubl"      />
+          <field field_ref="dmsdyn"           name="sndmassdyn"       />
+          <field field_ref="dmsssi"           name="sndmasssi"        />
+
+          <!-- heat balance -->
+          <field field_ref="hfxsenso"         name="siflsensupbot"    default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="hfxconsu"         name="siflcondtop"      default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="hfxconbo"         name="siflcondbot"      default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <!-- salt balance -->
+          <field field_ref="sfx_mv"           name="siflsaltbot"      default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <!-- sea-ice dynamics -->
+          <field field_ref="uice_mv"          name="siu"              default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="vice_mv"          name="siv"              default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="icevel_mv"        name="sispeed"          default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <field field_ref="utau_ice"         name="sistrxdtop"       default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="vtau_ice"         name="sistrydtop"       default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <field field_ref="utau_oi"          name="sistrxubot"       default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="vtau_oi"          name="sistryubot"       default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <field field_ref="icestr"           name="sicompstren"      default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <field field_ref="dssh_dx"          name="siforcetiltx"     default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="dssh_dy"          name="siforcetilty"     default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <field field_ref="corstrx"          name="siforcecoriolx"   default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="corstry"          name="siforcecorioly"   default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <field field_ref="intstrx"          name="siforceintstrx"   default_value="1.0e20" detect_missing_value="true" operation="average" />
+          <field field_ref="intstry"          name="siforceintstry"   default_value="1.0e20" detect_missing_value="true" operation="average" />
+
+          <field field_ref="xmtrptot"         name="sidmasstranx"     />
+          <field field_ref="ymtrptot"         name="sidmasstrany"     />
+
+          <field field_ref="normstr"          name="sistresave"       default_value="1.0e20" detect_missing_value="true" operation="instant" />
+          <field field_ref="sheastr"          name="sistremax"        default_value="1.0e20" detect_missing_value="true" operation="instant" />
+
+          <field field_ref="idive"            name="sidivvel"         default_value="1.0e20" detect_missing_value="true" operation="instant" />
+          <field field_ref="ishear"           name="sishevel"         default_value="1.0e20" detect_missing_value="true" operation="instant" />
+
+          <!-- sea ice fluxes across straits: 2D arrays to be post-processed  -->
+          <field field_ref="xmtrpice"         name="simassacrossline_x" />
+          <field field_ref="ymtrpice"         name="simassacrossline_y" />
+          <field field_ref="xmtrpsnw"         name="snmassacrossline_x" />
+          <field field_ref="ymtrpsnw"         name="snmassacrossline_y" />
+          <field field_ref="xatrp"            name="siareaacrossline_x" />
+          <field field_ref="yatrp"            name="siareaacrossline_y" />
+
+      </field_group>
+
    </field_definition>
Index: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref	(revision 8878)
+++ 	(revision )
@@ -1,131 +1,0 @@
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/LIM-2 : 1 - dynamics/advection/thermo          (namicerun)
-!! namelists    2 - ice intialisation                  (namiceini)
-!!              3 - ice dynamic                        (namicedyn)
-!!              4 - ice advection                      (namicetrp)
-!!              5 - thermodynamic                      (namicethd)
-!!              6 - ice damping                        (namice_dmp)
-!!              7 - ice diagnostics                    (namicedia)
-!!              8 - ice outputs                        (namiceout)
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-!-----------------------------------------------------------------------
-&namicerun     !   Share parameters for dynamics/advection/thermo
-!-----------------------------------------------------------------------
-   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
-   cn_icerst_indir = "."              !  directory from which to read input ice restarts
-   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
-   cn_icerst_outdir = "."             !  directory in which to write output ice restarts
-   ln_limdyn     = .true.             !  ice dynamics (T) or thermodynamics only (F)
-   ln_limdmp     = .false.            !  restoring ice thickness and fraction leads   (T => fill  namice_dmp)
-   acrit         = 1.0e-06 , 1.0e-06  !  minimum lead fraction in the Northern & Southern Hemispheres
-   hsndif        =  0.e0              !  computation of temperature in snow (=0.0) or not
-   hicdif        =  0.e0              !  computation of temperature in ice  (=0.0) or not (=9999.0)
-/
-!-----------------------------------------------------------------------
-&namiceini     !   ice initialisation
-!-----------------------------------------------------------------------
-   ln_limini   = .false.   !  read the initial state in 'Ice_initialization.nc' (T) or not (F)
-   ttest       =  2.0      !  threshold water temperature for initial sea ice
-   hninn       =  0.5      !  initial snow thickness in the north
-   hginn       =  3.0      !  initial ice  thickness in the north
-   alinn       =  0.05     !  initial leads area     in the north
-   hnins       =  0.1      !  same  three parameter  in the south
-   hgins       =  1.0      !        "                 "     south   
-   alins       =  0.1      !        "                 "     south
-/
-!-----------------------------------------------------------------------
-&namicedyn     !   ice dynamic
-!-----------------------------------------------------------------------
-   epsd        =   1.0e-20 !  tolerance parameter
-   alpha       =   0.5     !  coefficient for semi-implicit coriolis
-   dm          =   0.6e+03 !  diffusion constant for dynamics
-   nbiter      =   1       !  number of sub-time steps for relaxation
-   nbitdr      = 100       !  maximum number of iterations for relaxation
-   om          =   0.5     !  relaxation constant 
-   resl        =   5.0e-05 !  maximum value for the residual of relaxation
-   cw          =   5.0e-03 !  drag coefficient for oceanic stress
-   angvg       =   0.0     !  turning angle for oceanic stress
-   pstar       =   1.0e+04 !  1st bulk-rheology parameter
-   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
-   etamn       =   0.0e+07 !  minimun value for viscosity
-   rn_creepl   =   1.0e-08 !  creep limit
-   rn_ecc      =   2.0     !  eccentricity of the elliptical yield curve
-   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
-   nn_nevp     =   120     !  number of EVP subcycling iterations
-   telast      =   9600    !  timescale for EVP elastic waves
-   alphaevp    =   1.0     !  coefficient for the solution of EVP int. stresses
-/
-!-----------------------------------------------------------------------
-&namicetrp     !   ice transport
-!-----------------------------------------------------------------------
-   bound       =   0.0     !  boundary conditions (=0. no-slip, =1. free-slip)
-/
-!-----------------------------------------------------------------------
-&namicethd     !   ice thermodynamic
-!-----------------------------------------------------------------------
-   hmelt       = -0.15     !  maximum melting at the bottom
-   hiccrit     = 0.3 , 0.3 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere
-   !                       !  (caution 1.0, 1.0 best value to be used!!! (gilles G.))
-   hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket
-   hiclim      = 0.05      !  minimum ice thickness
-   amax        = 0.999     !  maximum lead fraction
-   swiqst      = 1.        !  energy stored in brine pocket (=1) or not (=0)	
-   sbeta       = 1.        !  numerical caracteritic of the scheme for diffusion in ice
-                           !        Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
-   parlat      = 0.0       !  percentage of energy used for lateral ablation
-   hakspl      = 0.5       !  slope of distr. for Hakkinen-Mellor's lateral melting
-   hibspl      = 0.5       !  slope of distribution for Hibler's lateral melting
-   exld        = 2.0       !  exponent for leads-closure rate
-   hakdif      = 1.0       !  coefficient for diffusions of ice and snow
-   thth        = 0.2       !  threshold thickness for comp. of eq. thermal conductivity
-   hnzst       = 0.1       !  thickness of the surf. layer in temp. computation
-   parsub      = 1.0       !  switch for snow sublimation or not
-   alphs       = 1.0       !  coefficient for snow density when snow ice formation
-/
-!-----------------------------------------------------------------------
-&namice_dmp    !   damping of sea ice alone open boundaries
-!              !   (hard coded damping area: check if it fit your config)
-!-----------------------------------------------------------------------
-!              !  file name     ! frequency (hours) ! variable ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !                !  (if <0  months)  !   name   !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_hicif    = 'ice_damping'  ,  -1.              , 'hicif'  ,   .true.     , .true. , 'yearly'  , ''       , ''       ,    ''
-   sn_frld     = 'ice_damping'  ,  -1.              , 'frld'   ,   .true.     , .true. , 'yearly'  , ''       , ''       ,    ''
-!
-   cn_dir      = './'      !  root directory for the location of the runoff files
-/
-!-----------------------------------------------------------------------
-&namicedia     !   ice diagnostics
-!-----------------------------------------------------------------------
-   fmtinf      = '1PE13.5' !  format of the output values
-   nfrinf      =  4        !  number of variables written in one line
-   ntmoy       =  1        !  instantaneous values of ice evolution or averaging
-   ninfo       =  1        !  frequency of ouputs on file ice_evolu in case of averaging
-/
-!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-&namiceout     !   parameters for outputs
-!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-!              !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
-!              !                                      !           !           ! or not !  factor  !  factor  !
-   field_1     = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
-   field_2     = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
-   field_3     = 'Ice produced                       ', 'iiceprod', 'm/kt    ',    1   ,  1.0     ,    0.0
-   field_4     = 'Ice concentration                  ', 'ileadfra', '%       ',    1   , -1.0     ,    1.0
-   field_5     = 'Ice temperature                    ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
-   field_6     = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_7     = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_8     = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_9     = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15
-   field_10    = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0
-   field_11    = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_12    = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_13    = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_14    = 'Salt flux at ocean surface         ', 'iocesafl', 'kg/m2/kt',    1   ,  1.0     ,    0.0
-   field_15    = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0
-   field_16    = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0 
-   field_17    = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_18    = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_19    = 'Snow precipitation                 ', 'isnowpre', 'kg/day  ',    1   ,  1.0     ,    0.0
-!
-   noumef      =   19      !  number of fields
-/      
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 8879)
@@ -1,187 +1,232 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! LIM3 namelist:  
-!!              1 - Generic parameters                 (namicerun)
-!!              2 - Diagnostics                        (namicediag)
-!!              3 - Ice initialization                 (namiceini)
-!!              4 - Ice discretization                 (namiceitd)
-!!              5 - Ice dynamics and transport         (namicedyn)
-!!              6 - Ice diffusion                      (namicehdf)
-!!              7 - Ice thermodynamics                 (namicethd)
-!!              8 - Ice salinity                       (namicesal)
-!!              9 - Ice mechanical redistribution      (namiceitdme)
+!! ESIM namelist:  
+!!              1 - Generic parameters                 (nampar)
+!!              2 - Ice thickness discretization       (namitd)
+!!              3 - Ice dynamics                       (namdyn)
+!!              4 - Ice ridging/rafting                (namdyn_rdgrft)
+!!              5 - Ice rheology                       (namdyn_rhg)
+!!              6 - Ice advection                      (namdyn_adv)
+!!              7 - Ice surface forcing                (namforcing)
+!!              8 - Ice thermodynamics                 (namthd)
+!!              9 - Ice heat diffusion                 (namthd_zdf)
+!!             10 - Ice lateral melting                (namthd_da)
+!!             11 - Ice growth in open water           (namthd_do)
+!!             12 - Ice salinity                       (namthd_sal)
+!!             13 - Ice melt ponds                     (namthd_pnd)
+!!             14 - Ice initialization                 (namini)
+!!             15 - Ice/snow albedos                   (namalb)
+!!             16 - Ice diagnostics                    (namdia)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !
 !------------------------------------------------------------------------------
-&namicerun     !   Generic parameters
-!------------------------------------------------------------------------------
-   jpl              =    5          !  number of ice  categories
-   nlay_i           =    2          !  number of ice  layers
-   nlay_s           =    1          !  number of snow layers (only 1 is working)
-   rn_amax_n        =   0.997       !  maximum tolerated ice concentration NH
-   rn_amax_s        =   0.997       !  maximum tolerated ice concentration SH
-   cn_icerst_in     = "restart_ice" !  suffix of ice restart name (input)
-   cn_icerst_out    = "restart_ice" !  suffix of ice restart name (output)
-   cn_icerst_indir  = "."           !  directory to read   input ice restarts
-   cn_icerst_outdir = "."           !  directory to write output ice restarts
-   ln_limthd        =  .true.       !  ice thermo   (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   ln_limdyn        =  .true.       !  ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   nn_limdyn        =   2           !     (ln_limdyn=T) switch for ice dynamics   
-                                    !      2: total
-                                    !      1: advection only (no diffusion, no ridging/rafting)
-                                    !      0: advection only (as 1 but with prescribed velocity, bypass rheology)
-   rn_uice          =   0.00001     !     (nn_limdyn=0) ice u-velocity
-   rn_vice          =  -0.00001     !     (nn_limdyn=0) ice v-velocity
-/
-!------------------------------------------------------------------------------
-&namicediag    !   Diagnostics
-!------------------------------------------------------------------------------
-   ln_limdiachk   =  .false.        !  check online the heat, mass & salt budgets (T) or not (F)
-   ln_limdiahsb   =  .false.        !  output the heat, mass & salt budgets (T) or not (F)
-   ln_limctl      =  .false.        !  ice points output for debug (T or F)
-   iiceprt        =    10           !  i-index for debug
-   jiceprt        =    10           !  j-index for debug
-/
-!------------------------------------------------------------------------------
-&namiceini     !   Ice initialization
-!------------------------------------------------------------------------------
-                  ! -- limistate -- !
-   ln_limini      = .true.          !  activate ice initialization (T) or not (F)
-   ln_limini_file = .false.         !  netcdf file provided for initialization (T) or not (F)
-   rn_thres_sst   =  2.0            !  maximum water temperature with initial ice (degC)
-   rn_hts_ini_n   =  0.3            !  initial real snow thickness (m), North
-   rn_hts_ini_s   =  0.3            !        "            "             South
-   rn_hti_ini_n   =  3.0            !  initial real ice thickness  (m), North
-   rn_hti_ini_s   =  1.0            !        "            "             South
-   rn_ati_ini_n   =  0.9            !  initial ice concentration   (-), North
-   rn_ati_ini_s   =  0.9            !        "            "             South
-   rn_smi_ini_n   =  6.3            !  initial ice salinity     (g/kg), North
-   rn_smi_ini_s   =  6.3            !        "            "             South
-   rn_tmi_ini_n   =  270.           !  initial ice/snw temperature (K), North
-   rn_tmi_ini_s   =  270.           !        "            "             South
-/
-!------------------------------------------------------------------------------
-&namiceitd     !   Ice discretization
-!------------------------------------------------------------------------------
-   nn_catbnd      =    2           !  computation of ice category boundaries based on
-                                   !      1: tanh function
-                                   !      2: h^(-alpha), function of rn_himean
-   rn_himean      =    2.0         !  expected domain-average ice thickness (m), nn_catbnd = 2 only
-/
-!------------------------------------------------------------------------------
-&namicedyn     !   Ice dynamics and transport
-!------------------------------------------------------------------------------
-                  ! -- limtrp & limadv -- !
-   nn_limadv      =    0            !  choose the advection scheme (-1=Prather ; 0=Ultimate-Macho)
-   nn_limadv_ord  =    5            !  choose the order of the advection scheme (if nn_limadv=0)
-                  ! -- limitd_me -- !
-   nn_icestr      =    0            !  ice strength parameteriztaion                      
-                                    !     0: Hibler_79     P = pstar*<h>*exp(-c_rhg*A)
-                                    !     1: Rothrock_75   P = Cf*coeff*integral(wr.h^2)    
-   rn_pe_rdg      =   17.0          !     (nn_icestr=1) ridging work divided by pot. energy change in ridging
-   rn_pstar       =    2.0e+04      !     (nn_icestr=0) ice strength thickness parameter (N/m2) 
-   rn_crhg        =   20.0          !     (nn_icestr=0) ice strength conc. parameter (-)
-   ln_icestr_bvf  =    .false.      !     ice strength function brine volume (T) or not (F)
-                                    !
-            ! -- limdyn & limrhg -- !
-   rn_cio         =    5.0e-03      !  ice-ocean drag coefficient (-)
-   rn_creepl      =    1.0e-12      !  creep limit (s-1)
-   rn_ecc         =    2.0          !  eccentricity of the elliptical yield curve          
-   nn_nevp        =  120            !  number of EVP subcycles                             
-   rn_relast      =    0.333        !  ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 
-                                    !     advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300)
-   ln_landfast    =  .false.        !  landfast ice parameterization (T or F)                           
-   rn_gamma       =    0.15         !     (ln_landfast=T)  fraction of ocean depth that ice must reach to initiate landfast
-                                    !                      recommended range: [0.1 ; 0.25]
-   rn_icebfr      =    10.          !     (ln_landfast=T)  maximum bottom stress per unit area of contact (N/m2)                 
-                                    !                      a very large value ensures ice velocity=0 even with a small contact area
-                                    !                      recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2)
-   rn_lfrelax     =    1.e-5        !     (ln_landfast=T)  relaxation time scale to reach static friction (s-1)                 
-/
-!------------------------------------------------------------------------------
-&namicehdf     !   Ice horizontal diffusion
-!------------------------------------------------------------------------------
-                     ! -- limhdf -- !
-   nn_ahi0        =    -1           !  horizontal diffusivity computation
-                                    !    -1: no diffusion (bypass limhdf)
-                                    !     0: use rn_ahi0_ref
-                                    !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length )
-                                    !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length )
-   rn_ahi0_ref    = 350.0           !  horizontal sea ice diffusivity (m2/s) 
-                                    !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution
-/
-!------------------------------------------------------------------------------
-&namicethd     !   Ice thermodynamics
-!------------------------------------------------------------------------------
-                 ! -- limthd_dif -- !
-   rn_kappa_i     = 1.0             !  radiation attenuation coefficient in sea ice (m-1)
-   nn_conv_dif    = 50              !  maximal number of iterations for heat diffusion computation
-   rn_terr_dif    = 1.0e-04         !  maximum temperature after heat diffusion (degC)
-   nn_ice_thcon   = 1               !  sea ice thermal conductivity
-                                    !     0: k = k0 + beta.S/T            (Untersteiner, 1964)
-                                    !     1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007)
-   ln_it_qnsice   = .true.          !  iterate the surface non-solar flux with surface temperature (T) or not (F)
-   nn_monocat     = 0               !  virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0)
-                                    !     2: simple piling instead of ridging    --- temporary option
-                                    !     3: activate G(he) only                 --- temporary option
-                                    !     4: activate extra lateral melting only --- temporary option
-   rn_cdsn     = 0.31              !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971)
-                                   !  Obs: 0.1-0.5 (Lecomte et al, JAMES 2013)
-                  ! -- limthd_dh -- !
-   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   rn_betas       = 0.66            !  exponent in lead-ice repratition of snow precipitation
-                                    !     betas = 1 -> equipartition, betas < 1 -> more on leads
-                  ! -- limthd_da -- !
-   ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   rn_beta        = 1.0             !     (ln_latmelt=T) coef. beta for lateral melting param. Recommended range=[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      
-   rn_dmin        = 8.              !     (ln_latmelt=T) minimum floe diameter for lateral melting param. Recommended range=[6-10]
-                                    !      => 6  vs 8m = +40% melting at the peak (A~0.5)
-                                    !         10 vs 8m = -20% melting
-                 ! -- limthd_lac -- !
-   ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   rn_hnewice     = 0.1             !  thickness for new ice formation in open water (m)
-   ln_frazil      = .false.         !  Frazil ice parameterization (ice collection as a function of wind)
-   rn_maxfrazb    = 1.0             !     (ln_frazil=T) maximum fraction of frazil ice collecting at the ice base
-   rn_vfrazb      = 0.417           !     (ln_frazil=T) thresold drift speed for frazil ice collecting at the ice bottom (m/s)
-   rn_Cfrazb      = 5.0             !     (ln_frazil=T) squeezing coefficient for frazil ice collecting at the ice bottom
-                  ! -- limitd_th -- !
-   rn_himin       = 0.1             !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice
-/
-!------------------------------------------------------------------------------
-&namicesal     !   Ice salinity
-!------------------------------------------------------------------------------
-                 ! -- limthd_sal -- !
-   ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   nn_icesal      =  2              !  ice salinity option
-                                    !     1: constant ice salinity (S=rn_icesal)
-                                    !     2: varying salinity parameterization S(z,t)
-                                    !     3: prescribed salinity profile S(z), Schwarzacher, 1959
-   rn_icesal      =  4.             !    (nn_icesal=1) ice salinity (g/kg)
-   rn_sal_gd      =  5.             !  restoring ice salinity, gravity drainage (g/kg)
-   rn_time_gd     =  1.73e+6        !  restoring time scale, gravity drainage  (s)
-   rn_sal_fl      =  2.             !  restoring ice salinity, flushing (g/kg)
-   rn_time_fl     =  8.64e+5        !  restoring time scale, flushing (s)
-   rn_simax       = 20.             !  maximum tolerated ice salinity (g/kg)
-   rn_simin       =  0.1            !  minimum tolerated ice salinity (g/kg)
-/
-!------------------------------------------------------------------------------
-&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
-!------------------------------------------------------------------------------
-                  ! -- limitd_me -- !
-   rn_cs          =   0.5           !  fraction of shearing energy contributing to ridging
-   nn_partfun     =   1             !  type of ridging participation function
-                                    !     0: linear      (Thorndike et al, 1975)
-                                    !     1: exponential (Lipscomb, 2007)
-   rn_gstar       =   0.15          !     (nn_partfun = 0) fractional area of thin ice being ridged 
-   rn_astar       =   0.03          !     (nn_partfun = 1) exponential measure of ridging ice fraction [set to 0.05 if hstar=100]
-   ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   rn_hstar       =  25.0           !     (ln_ridging = T) determines the maximum thickness of ridged ice (m) (Hibler, 1980)
-   rn_por_rdg     =   0.3           !     (ln_ridging = T) porosity of newly ridged ice (Lepparanta et al., 1995)
-   rn_fsnowrdg    =   0.5           !     (ln_ridging = T) snow volume fraction that survives in ridging
-   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   rn_hraft       =   0.75          !     (ln_rafting = T) threshold thickness for rafting (m)
-   rn_craft       =   5.0           !     (ln_rafting = T) squeezing coefficient used in the rafting function
-   rn_fsnowrft    =   0.5           !     (ln_rafting = T) snow volume fraction that survives in rafting
-/
+&nampar         !   Generic parameters
+!------------------------------------------------------------------------------
+   jpl              =   5             !  number of ice  categories
+   nlay_i           =   2             !  number of ice  layers
+   nlay_s           =   1             !  number of snow layers (only 1 is working)
+   nn_monocat       =   0             !  virtual ITD mono-category parameterizations (1-4 => jpl = 1 only) or not (0)
+                                      !     2: simple piling instead of ridging    --- temporary option
+                                      !     3: activate G(he) only                 --- temporary option
+                                      !     4: activate extra lateral melting only --- temporary option
+   ln_icedyn        = .true.          !  ice dynamics (T) or not (F)
+   ln_icethd        = .true.          !  ice thermo   (T) or not (F)
+   rn_amax_n        =   0.997         !  maximum tolerated ice concentration NH
+   rn_amax_s        =   0.997         !  maximum tolerated ice concentration SH
+   cn_icerst_in     = "restart_ice"   !  suffix of ice restart name (input)
+   cn_icerst_out    = "restart_ice"   !  suffix of ice restart name (output)
+   cn_icerst_indir  = "."             !  directory to read   input ice restarts
+   cn_icerst_outdir = "."             !  directory to write output ice restarts
+/
+!------------------------------------------------------------------------------
+&namitd         !   Ice discretization
+!------------------------------------------------------------------------------
+   ln_cat_hfn       = .true.          !  ice categories are defined by a function following rn_himean**(-0.05)
+      rn_himean     =   2.0           !  expected domain-average ice thickness (m)
+   ln_cat_usr       = .false.         !  ice categories are defined by rn_catbnd below (m)
+      rn_catbnd     =   0.,0.45,1.1,2.1,3.7,6.0  
+   rn_himin         =   0.1           !  minimum ice thickness (m) used in remapping
+/
+!------------------------------------------------------------------------------
+&namdyn         !   Ice dynamics
+!------------------------------------------------------------------------------
+   ln_dynFULL       = .true.          !  dyn.: full ice dynamics               (rheology + advection + ridging/rafting + correction)
+   ln_dynRHGADV     = .false.         !  dyn.: no ridge/raft & no corrections  (rheology + advection)
+   ln_dynADV        = .false.         !  dyn.: only advection w prescribed vel.(rn_uvice + advection)
+      rn_uice       =   0.00001       !        prescribed ice u-velocity
+      rn_vice       =   0.            !        prescribed ice v-velocity
+   rn_ishlat        =   2.            !  free slip (0) ; partial slip (0-2) ; no slip (2) ; strong slip (>2)
+   ln_landfast      = .false.         !  landfast ice parameterization (T or F)                           
+      rn_gamma      =   0.15          !     fraction of ocean depth that ice must reach to initiate landfast
+                                      !        recommended range: [0.1 ; 0.25]
+      rn_icebfr     =  10.            !     maximum bottom stress per unit area of contact [N/m2]                 
+                                      !        a very large value ensures ice velocity=0 even with a small contact area
+                                      !        recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2)
+      rn_lfrelax    =   1.e-5         !     relaxation time scale to reach static friction [s-1]
+/
+!------------------------------------------------------------------------------
+&namdyn_rdgrft  !   Ice ridging/rafting
+!------------------------------------------------------------------------------
+          ! -- ice_rdgrft_strength -- !
+   ln_str_H79       = .true.          !  ice strength param.: Hibler_79   => P = pstar*<h>*exp(-c_rhg*A)                      
+      rn_pstar      =   2.0e+04       !     ice strength thickness parameter [N/m2]
+      rn_crhg       =   20.0          !     ice strength conc. parameter (-)
+                   ! -- ice_rdgrft -- !
+   rn_csrdg         =   0.5           !  fraction of shearing energy contributing to ridging
+              ! -- ice_rdgrft_prep -- !
+   ln_partf_lin     = .false.         !  Linear ridging participation function (Thorndike et al, 1975)
+      rn_gstar      =   0.15          !     fractional area of thin ice being ridged 
+   ln_partf_exp     = .true.          !  Exponential ridging participation function (Lipscomb, 2007)
+      rn_astar      =   0.03          !     exponential measure of ridging ice fraction [set to 0.05 if hstar=100]
+   ln_ridging       = .true.          !  ridging activated (T) or not (F)
+      rn_hstar      =  25.0           !     determines the maximum thickness of ridged ice [m] (Hibler, 1980)
+      rn_porordg    =   0.3           !     porosity of newly ridged ice (Lepparanta et al., 1995)
+      rn_fsnwrdg    =   0.5           !     snow volume fraction that survives in ridging
+      rn_fpndrdg    =   1.0           !     pond fraction that survives in ridging (small a priori)
+   ln_rafting       = .true.          !  rafting activated (T) or not (F)
+      rn_hraft      =   0.75          !     threshold thickness for rafting [m]
+      rn_craft      =   5.0           !     squeezing coefficient used in the rafting function
+      rn_fsnwrft    =   0.5           !     snow volume fraction that survives in rafting
+      rn_fpndrft    =   1.0           !     pond fraction that survives in rafting (0.5 a priori)
+/
+!------------------------------------------------------------------------------
+&namdyn_rhg     !   Ice rheology
+!------------------------------------------------------------------------------
+   ln_rhg_EVP       = .true.          !  EVP rheology
+      ln_aEVP       = .false.         !     adaptive rheology (Kimmritz et al. 2016 & 2017)
+      rn_creepl     =   2.0e-9        !     creep limit [1/s]
+      rn_ecc        =   2.0           !     eccentricity of the elliptical yield curve          
+      nn_nevp       = 120             !     number of EVP subcycles                             
+      rn_relast     =   0.333         !     ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 
+                                      !        advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300)
+/
+!------------------------------------------------------------------------------
+&namdyn_adv     !   Ice advection
+!------------------------------------------------------------------------------
+   ln_adv_Pra       = .false.         !  Advection scheme (Prather)
+   ln_adv_UMx       = .true.          !  Advection scheme (Ultimate-Macho)
+      nn_UMx        =   5             !     order of the scheme for UMx (1-5 ; 20=centered 2nd order)
+/
+!------------------------------------------------------------------------------
+&namforcing     !   Ice surface forcing
+!------------------------------------------------------------------------------
+   rn_cio           =   5.0e-03       !  ice-ocean drag coefficient (-)
+   rn_blow_s        =   0.66          !  mesure of snow blowing into the leads
+                                      !     = 1 => no snow blowing, < 1 => some snow blowing
+   nn_iceflx        =  -1             !  Redistribute heat flux over ice categories
+                                      !     =-1  Do nothing (needs N(cat) fluxes)
+                                      !          ==> forced mode only
+                                      !     = 0  Average N(cat) fluxes then apply the average over the N(cat) ice
+                                      !          ==> forced and coupled modes
+                                      !     = 1  Average N(cat) fluxes then redistribute over the N(cat) ice using T-ice and albedo sensitivity
+                                      !          ==> forced mode only
+                                      !     = 2  Redistribute a single flux over categories
+                                      !          ==> coupled mode only
+   nice_jules       = 1               !  Jules coupling (0=OFF, 1=EMULATED, 2=ACTIVE)
+/
+!------------------------------------------------------------------------------
+&namthd         !   Ice thermodynamics
+!------------------------------------------------------------------------------
+   ln_icedH         = .true.          !  activate ice thickness change from growing/melting (T) or not (F)
+   ln_icedA         = .true.          !  activate lateral melting param. (T) or not (F)
+   ln_icedO         = .true.          !  activate ice growth in open-water (T) or not (F)
+   ln_icedS         = .true.          !  activate brine drainage (T) or not (F)
+/
+!------------------------------------------------------------------------------
+&namthd_zdf     !   Ice heat diffusion
+!------------------------------------------------------------------------------
+   ln_zdf_BL99      = .true.          !  Heat diffusion follows Bitz and Lipscomb 1999
+   ln_cndi_U64      = .false.         !  sea ice thermal conductivity: k = k0 + beta.S/T            (Untersteiner, 1964)
+   ln_cndi_P07      = .true.          !  sea ice thermal conductivity: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007)
+   rn_cnd_s         =   0.31          !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971)
+                                      !     Obs: 0.1-0.5 (Lecomte et al, JAMES 2013)
+   rn_kappa_i       =   1.0           !  radiation attenuation coefficient in sea ice [1/m]
+/
+!------------------------------------------------------------------------------
+&namthd_da     !   Ice lateral melting
+!------------------------------------------------------------------------------
+   rn_beta          =   1.0           !  coef. beta for lateral melting param. Recommended range=[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      
+   rn_dmin          =   8.            !  minimum floe diameter for lateral melting param. Recommended range=[6-10]
+                                      !   => 6  vs 8m = +40% melting at the peak (A~0.5)
+                                      !      10 vs 8m = -20% melting
+/
+!------------------------------------------------------------------------------
+&namthd_do      !   Ice growth in open water
+!------------------------------------------------------------------------------
+   rn_hinew         =   0.1           !  thickness for new ice formation in open water (m), must be larger than rn_hnewice
+   ln_frazil        = .false.         !  Frazil ice parameterization (ice collection as a function of wind)
+      rn_maxfraz    =   1.0           !     maximum fraction of frazil ice collecting at the ice base
+      rn_vfraz      =   0.417         !     thresold drift speed for frazil ice collecting at the ice bottom (m/s)
+      rn_Cfraz      =   5.0           !     squeezing coefficient for frazil ice collecting at the ice bottom
+/
+!------------------------------------------------------------------------------
+&namthd_sal     !   Ice salinity
+!------------------------------------------------------------------------------
+   nn_icesal        =   2             !  ice salinity option
+                                      !     1: constant ice salinity (S=rn_icesal)
+                                      !     2: varying salinity parameterization S(z,t)
+                                      !     3: prescribed salinity profile S(z), Schwarzacher, 1959
+   rn_icesal        =   4.            !    (nn_icesal=1) ice salinity (g/kg)
+   rn_sal_gd        =   5.            !  restoring ice salinity, gravity drainage (g/kg)
+   rn_time_gd       =   1.73e+6       !  restoring time scale, gravity drainage  (s)
+   rn_sal_fl        =   2.            !  restoring ice salinity, flushing (g/kg)
+   rn_time_fl       =   8.64e+5       !  restoring time scale, flushing (s)
+   rn_simax         =  20.            !  maximum tolerated ice salinity (g/kg)
+   rn_simin         =   0.1           !  minimum tolerated ice salinity (g/kg)
+/
+!------------------------------------------------------------------------------
+&namthd_pnd     !   Melt ponds
+!------------------------------------------------------------------------------
+   ln_pnd_H12       = .false.         !  activate evolutive melt ponds (from Holland et al 2012)
+      ln_pnd_fwb    = .false.         !     melt ponds store freshwater or not
+   ln_pnd_CST       = .false.         !  activate constant melt ponds
+      rn_apnd       =   0.2           !     prescribed pond fraction, at Tsu=0
+      rn_hpnd       =   0.05          !     prescribed pond depth, at Tsu=0
+   ln_pnd_alb       = .false.         !  melt ponds affect albedo or not
+/
+!------------------------------------------------------------------------------
+&namini         !   Ice initialization
+!------------------------------------------------------------------------------
+   ln_iceini        = .true.          !  activate ice initialization (T) or not (F)
+   ln_iceini_file   = .false.         !  netcdf file provided for initialization (T) or not (F)
+   rn_thres_sst     =   2.0           !  max delta temp. above Tfreeze with initial ice = (sst - tfreeze)
+   rn_hts_ini_n     =   0.3           !  initial real snow thickness (m), North
+   rn_hts_ini_s     =   0.3           !        "            "             South
+   rn_hti_ini_n     =   3.0           !  initial real ice thickness  (m), North
+   rn_hti_ini_s     =   1.0           !        "            "             South
+   rn_ati_ini_n     =   0.9           !  initial ice concentration   (-), North
+   rn_ati_ini_s     =   0.9           !        "            "             South
+   rn_smi_ini_n     =   6.3           !  initial ice salinity     (g/kg), North
+   rn_smi_ini_s     =   6.3           !        "            "             South
+   rn_tmi_ini_n     = 270.            !  initial ice/snw temperature (K), North
+   rn_tmi_ini_s     = 270.            !        "            "             South
+
+   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_hts = 'Ice_initialization'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_ati = 'Ice_initialization'    , -12 ,'ati'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_tsu = 'Ice_initialization'    , -12 ,'tsu'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_tmi = 'Ice_initialization'    , -12 ,'tmi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_smi = 'Ice_initialization'    , -12 ,'smi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   cn_dir='./'
+/
+!------------------------------------------------------------------------------
+&namalb         !   albedo parameters
+!------------------------------------------------------------------------------
+   !                                  !                          !  obs range (cloud-sky)
+   rn_alb_sdry      =   0.85          !  dry snow albedo         :  0.85 -- 0.87
+   rn_alb_smlt      =   0.75          !  melting snow albedo     :  0.72 -- 0.82
+   rn_alb_idry      =   0.60          !  dry ice albedo          :  0.54 -- 0.65
+   rn_alb_imlt      =   0.50          !  bare puddled ice albedo :  0.49 -- 0.58
+   rn_alb_dpnd      =   0.27          !  ponded ice albedo       :  0.10 -- 0.30 
+/
+!------------------------------------------------------------------------------
+&namdia         !   Diagnostics
+!------------------------------------------------------------------------------
+   ln_icediachk     = .false.         !  check online the heat, mass & salt budgets (T) or not (F)
+   ln_icediahsb     = .false.         !  output the heat, mass & salt budgets (T) or not (F)
+   ln_icectl        = .false.         !  ice points output for debug (T or F)
+   iiceprt          =  10             !  i-index for debug
+   jiceprt          =  10             !  j-index for debug
+/
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 8879)
@@ -188,20 +188,15 @@
    ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
    ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
+   ln_meto_cpl = .false.   !  Met Office coupling formulation, with surface exchange carried out in atmosphere (requires key_oasis3)
    nn_components = 0       !  configuration of the opa-sas OASIS coupling
                            !  =0 no opa-sas OASIS coupling: default single executable configuration
                            !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
                            !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
-   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used)
-                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled
-                           !  = 0  Average per-category fluxes (forced and coupled mode)
-                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled
-                           !  = 2  Redistribute a single flux over categories (coupled mode only)
                      ! Sea-ice :
-   nn_ice      = 3         !  =0 no ice boundary condition   ,
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 to 4 :  ice-model used (LIM2, LIM3 or CICE)                         ("key_lim3", "key_lim2", or "key_cice")
-   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
-                           !  =1 levitating ice with mass and salt exchange but no presure effect
-                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure)
+                           !  =2 & 3 :  ice-model used (LIM3 or CICE)                         ("key_lim3" or "key_cice")
+   ln_ice_embd = .false.   !  =F levitating ice with mass and salt exchange but no presure effect
+                           !  =T embedded sea-ice (full salt and mass exchanges and pressure)
                      ! Misc. options of sbc : 
    ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr)
@@ -264,6 +259,6 @@
    rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
                            !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
-   ln_Cd_L12   = .false.   !  Modify the drag ice-atm and oce-atm depending on ice concentration
-                           !  This parameterization is from Lupkes et al. (JGR 2012)
+   ln_Cd_L12   = .false.   !  Modify the drag ice-atm depending on ice concentration with Lupkes 2012
+   ln_Cd_L15   = .false.   !  Modify the drag ice-atm depending on ice concentration with Lupkes 2015
 /
 !-----------------------------------------------------------------------
@@ -281,4 +276,9 @@
    sn_snd_ifrac  =       'none'                 ,    'no'    ,     ''      ,         ''           ,   ''
    sn_snd_wlev   =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_cond   =   'weighted ice'         ,    'no'    ,     ''      ,             ''           ,   ''
+   sn_snd_thick1 =   'ice and snow'         ,    'no'    ,     ''      ,             ''           ,   ''
+   sn_snd_mpnd   =   'weighted ice'         ,    'no'    ,     ''      ,             ''           ,   ''
+   sn_snd_sstfrz =   'coupled'            ,    'no'    ,     ''      ,             ''           ,   ''
+   sn_snd_ttilyr =   'weighted ice'           ,    'no'    ,     ''      ,             ''           ,   ''
 ! receive
    sn_rcv_w10m   =   'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
@@ -302,8 +302,12 @@
    sn_rcv_wstrf  =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
    sn_rcv_wdrag  =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_ts_ice =       'ice'                  ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_isf    =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_icb    =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
 !
    nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentialy sending/receiving data
    ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models
    !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+   nn_cats_cpl   =     5   !  Number of sea ice categories over which coupling is to be carried out
 /
 !-----------------------------------------------------------------------
@@ -313,6 +317,6 @@
 !              !             !  (if <0  months)  !   name    !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
    l_sasread   = .TRUE.   ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE.
-   sn_usp      = 'sas_grid_U',     120           , 'vozocrtx',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
-   sn_vsp      = 'sas_grid_V',     120           , 'vomecrty',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_usp      = 'sas_grid_U',     120           ,    'uos'  ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_vsp      = 'sas_grid_V',     120           ,    'vos'  ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
    sn_tem      = 'sas_grid_T',     120           , 'sosstsst',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
    sn_sal      = 'sas_grid_T',     120           , 'sosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
@@ -321,5 +325,5 @@
    sn_frq      = 'sas_grid_T',     120           , 'frq_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
 
-   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field
+   ln_3d_uve   = .false.   !  specify whether we are supplying a 3D u,v and e3 field
    ln_read_frq = .false.   !  specify whether we must read frq or not
    cn_dir      = './'      !  root directory for the location of the bulk files are
@@ -340,5 +344,4 @@
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
    rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3
 /
 !-----------------------------------------------------------------------
@@ -434,16 +437,4 @@
    ln_sssr_bnd =  .true.   !  flag to bound erp term (associated with nn_sssr=2)
    rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
-/
-!-----------------------------------------------------------------------
-&namsbc_alb    !   albedo parameters
-!-----------------------------------------------------------------------
-   nn_ice_alb   =    1   !  parameterization of ice/snow albedo
-                         !     0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo
-                         !     1: "home made" based on Brandt et al. (JClim 2005) and Grenfell & Perovich (JGR 2004),
-                         !        giving cloud-sky albedo
-   rn_alb_sdry  =  0.85  !  dry snow albedo         : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky)
-   rn_alb_smlt  =  0.75  !  melting snow albedo     : 0.65 ( '' )          ; 0.75 ( '' )          ; obs 0.72-0.82 ( '' )
-   rn_alb_idry  =  0.60  !  dry ice albedo          : 0.72 ( '' )          ; 0.60 ( '' )          ; obs 0.54-0.65 ( '' )
-   rn_alb_imlt  =  0.50  !  bare puddled ice albedo : 0.53 ( '' )          ; 0.50 ( '' )          ; obs 0.49-0.58 ( '' )
 /
 !-----------------------------------------------------------------------
@@ -581,12 +572,8 @@
    bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
    bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-! for lim2
-!   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
 ! for lim3
 !   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_ht_i    = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_ht_s    = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_h_i    = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_h_s    = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
 
    cn_dir      = 'bdydta/' !  root directory for the location of the bulk files
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg	(revision 8879)
@@ -64,7 +64,7 @@
                            !  =1 use observed ice-cover      , 
                            !  =2 ice-model used                
-   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
-                           !  =1 levitating ice with mass and salt exchange but no presure effect
-                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure)
+   ln_ice_embd = .false.   !  =F levitating ice with mass and salt exchange but no presure effect
+                           !  =T embedded sea-ice (full salt and mass exchanges and pressure)
+                     ! Misc. options of sbc :
    ln_traqsr   = .false.   !  Light penetration (T) or not (F)
    ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg	(revision 8879)
@@ -26,5 +26,5 @@
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
-   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time
    !
    nn_msh      =    1      !  create (>0) a mesh file or not (=0)
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg	(revision 8879)
@@ -1,86 +1,94 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! LIM3 namelist:  
-!!              1 - Generic parameters                 (namicerun)
-!!              2 - Diagnostics                        (namicediag)
-!!              3 - Ice initialization                 (namiceini)
-!!              4 - Ice discretization                 (namiceitd)
-!!              5 - Ice dynamics and transport         (namicedyn)
-!!              6 - Ice diffusion                      (namicehdf)
-!!              7 - Ice thermodynamics                 (namicethd)
-!!              8 - Ice salinity                       (namicesal)
-!!              9 - Ice mechanical redistribution      (namiceitdme)
+!! ESIM namelist:  
+!!              1 - Generic parameters                 (nampar)
+!!              2 - Ice thickness discretization       (namitd)
+!!              3 - Ice dynamics                       (namdyn)
+!!              4 - Ice ridging/rafting                (namdyn_rdgrft)
+!!              5 - Ice rheology                       (namdyn_rhg)
+!!              6 - Ice advection                      (namdyn_adv)
+!!              7 - Ice surface forcing                (namforcing)
+!!              8 - Ice thermodynamics                 (namthd)
+!!              9 - Ice heat diffusion                 (namthd_zdf)
+!!             10 - Ice lateral melting                (namthd_da)
+!!             11 - Ice growth in open water           (namthd_do)
+!!             12 - Ice salinity                       (namthd_sal)
+!!             13 - Ice melt ponds                     (namthd_pnd)
+!!             14 - Ice initialization                 (namini)
+!!             15 - Ice/snow albedos                   (namalb)
+!!             16 - Ice diagnostics                    (namdia)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !
 !------------------------------------------------------------------------------
-&namicerun     !   Generic parameters
+&nampar         !   Generic parameters
 !------------------------------------------------------------------------------
-   jpl              =    1          !  number of ice  categories
-   nlay_i           =    1          !  number of ice  layers
-   ln_limthd        =  .false.       !  ice thermo   (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   ln_limdyn        =  .true.       !  ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   nn_limdyn        =   0           !     (ln_limdyn=T) switch for ice dynamics
-                                    !      2: total
-                                    !      1: advection only (no diffusion, no ridging/rafting)
-                                    !      0: advection only (as 1 but with prescribed velocity, bypass rheology)
-   rn_uice          =   0.5    !     (nn_limdyn=0) ice u-velocity
-   rn_vice          =   0.0    !     (nn_limdyn=0) ice v-velocity
+   jpl              =   1             !  number of ice  categories
+   nlay_i           =   1             !  number of ice  layers
+   ln_icedyn        = .true.          !  ice dynamics (T) or not (F)
+   ln_icethd        = .false.         !  ice thermo   (T) or not (F)
 /
 !------------------------------------------------------------------------------
-&namicediag    !   Diagnostics
+&namitd         !   Ice discretization
+!------------------------------------------------------------------------------
+   rn_himin         =   0.1           !  minimum ice thickness (m) used in remapping
+/
+!------------------------------------------------------------------------------
+&namdyn         !   Ice dynamics
+!------------------------------------------------------------------------------
+   ln_dynFULL       = .false.         !  dyn.: full ice dynamics               (rheology + advection + ridging/rafting + correction)
+   ln_dynRHGADV     = .false.         !  dyn.: no ridge/raft & no corrections  (rheology + advection)
+   ln_dynADV        = .true.          !  dyn.: only advection w prescribed vel.(rn_uvice + advection)
+      rn_uice       =   0.5           !        prescribed ice u-velocity
+      rn_vice       =   0.            !        prescribed ice v-velocity
+/
+!------------------------------------------------------------------------------
+&namdyn_rdgrft  !   Ice ridging/rafting
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namiceini     !   Ice initialization
-!------------------------------------------------------------------------------
-                  ! -- limistate -- !
-   ln_limini      = .true.         !  activate ice initialization (T) or not (F)
-   ln_limini_file = .true.         !  netcdf file provided for initialization (T) or not (F)
-   cn_dir="./"
-   sn_hti = 'initice'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', ''
-   sn_hts = 'initice'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', ''
-   sn_ati = 'initice'    , -12 ,'ati'   ,  .false.  , .true., 'yearly'  , '' , '', ''
-   sn_tsu = 'initice'    , -12 ,'tsu'   ,  .false.  , .true., 'yearly'  , '' , '', ''
-   sn_tmi = 'initice'    , -12 ,'tmi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
-   sn_smi = 'initice'    , -12 ,'smi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
-/
-!------------------------------------------------------------------------------
-&namiceitd     !   Ice discretization
+&namdyn_rhg     !   Ice rheology
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicedyn     !   Ice dynamics and transport
-!------------------------------------------------------------------------------
-                  ! -- limtrp & limadv -- !
-   nn_limadv      =    0            !  choose the advection scheme (-1=Prather ; 0=Ultimate-Macho)
-   nn_limadv_ord  =    5            !  choose the order of the advection scheme (if nn_limadv=0)
-/
-!------------------------------------------------------------------------------
-&namicehdf     !   Ice horizontal diffusion
+&namdyn_adv     !   Ice advection
 !------------------------------------------------------------------------------
 /
 !------------------------------------------------------------------------------
-&namicethd     !   Ice thermodynamics
+&namforcing     !   Ice surface forcing
 !------------------------------------------------------------------------------
-                  ! -- limthd_dh -- !
-   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-                  ! -- limthd_da -- !
-   ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-                 ! -- limthd_lac -- !
-   ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   rn_hnewice     = 0.02            !  thickness for new ice formation in open water (m)
-                  ! -- limitd_th -- !
-   rn_himin       = 0.01            !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice
 /
 !------------------------------------------------------------------------------
-&namicesal     !   Ice salinity
+&namthd         !   Ice thermodynamics
 !------------------------------------------------------------------------------
-                 ! -- limthd_sal -- !
-   ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
 /
 !------------------------------------------------------------------------------
-&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+&namthd_zdf     !   Ice heat diffusion
 !------------------------------------------------------------------------------
-                  ! -- limitd_me -- !
-   ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
-   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
 /
+!------------------------------------------------------------------------------
+&namthd_da      !   Ice lateral melting
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_do      !   Ice growth in open water
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_sal     !   Ice salinity
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_pnd     !   Melt ponds
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namini         !   Ice initialization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namalb         !   albedo parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdia         !   Diagnostics
+!------------------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90	(revision 8879)
@@ -351,28 +351,5 @@
         IF(lwp) WRITE(numout,*)
 
-#if defined key_lim2
-        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
-        SELECT CASE( cn_ice_lim(ib_bdy) )                  
-          CASE('none')
-             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
-             dta_bdy(ib_bdy)%ll_frld  = .false.
-             dta_bdy(ib_bdy)%ll_hicif = .false.
-             dta_bdy(ib_bdy)%ll_hsnif = .false.
-          CASE('frs')
-             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
-             dta_bdy(ib_bdy)%ll_frld  = .true.
-             dta_bdy(ib_bdy)%ll_hicif = .true.
-             dta_bdy(ib_bdy)%ll_hsnif = .true.
-          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' )
-        END SELECT
-        IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 
-           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   ! 
-              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'        
-              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file'
-              CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' )
-           END SELECT
-        ENDIF
-        IF(lwp) WRITE(numout,*)
-#elif defined key_lim3
+#if defined key_lim3
         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
         SELECT CASE( cn_ice_lim(ib_bdy) )                  
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 8879)
@@ -36,5 +36,5 @@
 #define LONG_FNAME 1000		// Max length for a file name
 #define LONG_C     200
-#define LONG_M     1500
+#define LONG_M     2000
 
 #define NB_CAT_VARIABLES 5
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 8879)
@@ -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,41 @@
    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) **
+   LOGICAL , PUBLIC ::   ln_aEVP          !: using adaptive EVP (T or F) 
    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
+
+   INTEGER , PUBLIC            ::   nice_jules            ! Choice of jules coupling 
+   !                                                      ! Associated indices
+   INTEGER , PUBLIC, PARAMETER ::   np_jules_OFF    = 0   ! no Jules coupling (ice thermodynamics forced via qsr and qns)
+   INTEGER , PUBLIC, PARAMETER ::   np_jules_EMULE  = 1   ! emulated Jules coupling via icethd_zdf.F90 (BL99) (1st round compute qcn and qsr_tr, 2nd round use it)
+   INTEGER , PUBLIC, PARAMETER ::   np_jules_ACTIVE = 2   ! active Jules coupling                      (SM0L) (compute qcn and qsr_tr via sbcblk.F90 or sbccpl.F90)
+
+   !                                     !!** 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 +208,24 @@
    !                                      ! 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
+   !                                     !!** namelist namthd_pnd
+   LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al 2012
+   LOGICAL , PUBLIC ::   ln_pnd_fwb       !: melt ponds store freshwater
+   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth
+   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1)
+   REAL(wp), PUBLIC ::   rn_hpnd          !: prescribed pond depth    (0<rn_hpnd<1)
+   LOGICAL , PUBLIC ::   ln_pnd_alb       !: melt ponds affect albedo
+
+   !                                     !!** 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 +233,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 +249,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 +254,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 +277,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 +296,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 +307,27 @@
 
    ! 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
-
-   !!--------------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice         !: temperature of the first layer (Jules coupling) [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice        !: effective conductivity at the top of ice/snow (Jules coupling) [W.m-2.K-1]
+
+   !!----------------------------------------------------------------------
    !! * 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 +340,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,10 +389,21 @@
    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] 
+
+   !
+   !!----------------------------------------------------------------------
+   !! * 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)
+
    !
    !!----------------------------------------------------------------------
@@ -463,5 +420,5 @@
       INTEGER :: ice_alloc
       !
-      INTEGER :: ierr(15), ii
+      INTEGER :: ierr(18), ii
       !!-----------------------------------------------------------------
 
@@ -471,19 +428,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 +451,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) ,cnd_ice(jpi,jpj,jpl), t1_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 +460,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 +488,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 +504,5 @@
 #else
    !!----------------------------------------------------------------------
-   !!   Default option         Empty module            NO LIM sea-ice model
+   !!   Default option         Empty module           NO ESIM sea-ice model
    !!----------------------------------------------------------------------
 #endif
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/ice1d.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/ice1d.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/ice1d.F90	(revision 8879)
@@ -0,0 +1,245 @@
+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(:) ::   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(:) ::   qml_ice_1d     !: heat available for snow / ice surface melting [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcn_ice_1d     !: heat available for snow / ice surface sublimation [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_tr_1d  !: solar flux transmitted below the ice surface [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t1_ice_1d      !: temperature of the 1st layer (Jules coupling) [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   cnd_ice_1d     !: conductivity at the top of ice/snow (Jules coupling) [W/K/m2]
+
+   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
+
+   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_s_mlt      !: Snow melt [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(:) ::   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(:) ::   a_ip_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ip_1d       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_frac_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) ,   &
+         &      qns_ice_1d(jpij)  ,   &
+         &      qml_ice_1d(jpij), qcn_ice_1d(jpij) , qsr_ice_tr_1d(jpij) , &
+         &      cnd_ice_1d(jpij), t1_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),                                                             &  
+         &      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_s_mlt(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) , &
+         &      h_ip_1d  (jpij) , a_ip_frac_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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90	(revision 8879)
@@ -0,0 +1,223 @@
+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)
+   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_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, palb_cs, palb_os )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE ice_alb  ***
+      !!          
+      !! ** Purpose :   Computation of the albedo of the snow/ice system 
+      !!       
+      !! ** Method  :   The scheme is "home made" (for cloudy skies) and based on Brandt et al. (J. Climate 2005)
+      !!                                                                      and Grenfell & Perovich (JGR 2004)
+      !!                  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
+      !!
+      !!                     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_imlt = 0.50      ! bare puddled ice albedo
+      !!                        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
+      !!
+      !! ** Note    :   The old parameterization from Shine & Henderson-Sellers (not here anymore) presented 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_su        !  ice surface temperature (Kelvin)
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice       !  sea-ice thickness
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_snw       !  snow depth
+      LOGICAL , INTENT(in   )                   ::   ld_pnd_alb   !  effect of melt ponds on albedo
+      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
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_cs      !  albedo of ice under clear    sky
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_os      !  albedo of ice under overcast sky
+      !
+      INTEGER  ::   ji, jj, jl                ! dummy loop indices
+      REAL(wp) ::   z1_c1, z1_c2,z1_c3, z1_c4 ! local scalar
+      REAL(wp) ::   z1_href_pnd               ! inverse of the characteristic length scale (Lecomte et al. 2015)
+      REAL(wp) ::   zalb_pnd, zafrac_pnd      ! ponded sea ice albedo & relative pound fraction
+      REAL(wp) ::   zalb_ice, zafrac_ice      ! bare sea ice albedo & relative ice fraction
+      REAL(wp) ::   zalb_snw, zafrac_snw      ! snow-covered sea ice albedo & relative snow fraction
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('icealb')
+      !
+      z1_href_pnd = 0.05
+      z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
+      z1_c2 = 1. / 0.05
+      z1_c3 = 1. / 0.02
+      z1_c4 = 1. / 0.03
+      !
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !                       !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time)
+               IF( ph_snw(ji,jj,jl) == 0._wp ) THEN
+                  zafrac_snw = 0._wp
+                  IF( ld_pnd_alb ) THEN
+                     zafrac_pnd = pafrac_pnd(ji,jj,jl)
+                  ELSE
+                     zafrac_pnd = 0._wp
+                  ENDIF
+                  zafrac_ice = 1._wp - zafrac_pnd
+               ELSE
+                  zafrac_snw = 1._wp      ! Snow fully "shades" melt ponds and ice
+                  zafrac_pnd = 0._wp
+                  zafrac_ice = 0._wp
+               ENDIF
+               !
+               !                       !--- Bare ice albedo (for hi > 150cm)
+               IF( ld_pnd_alb ) THEN
+                  zalb_ice = rn_alb_idry
+               ELSE
+                  IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN  ;   zalb_ice = rn_alb_imlt
+                  ELSE                                                               ;   zalb_ice = rn_alb_idry   ;   ENDIF
+               ENDIF
+               !                       !--- Bare ice albedo (for hi < 150cm)
+               IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm
+                  zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) )
+               ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm
+                  zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl)
+               ENDIF
+               !
+               !                       !--- Snow-covered ice albedo (freezing, melting cases)
+               IF( pt_su(ji,jj,jl) < rt0_snow ) THEN
+                  zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 )
+               ELSE
+                  zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 )
+               ENDIF
+               !                       !--- Ponded ice albedo
+               IF( ld_pnd_alb ) THEN
+                  zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 
+               ELSE
+                  zalb_pnd = rn_alb_dpnd
+               ENDIF
+               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions
+               palb_os(ji,jj,jl) = zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice
+               !
+            END DO
+         END DO
+      END DO
+      !
+      palb_cs(:,:,:) = palb_os(:,:,:) - ( - 0.1010 * palb_os(:,:,:) * palb_os(:,:,:) + 0.1933 * palb_os(:,:,:) - 0.0148 )
+      !
+      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/ 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,*) '      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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icecor.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icecor.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icecor.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90	(revision 8879)
@@ -0,0 +1,676 @@
+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_pnd(:,:)  +  &
+            &                    wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) +  &
+            &                    wfx_ice_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_pnd(:,:)  +  &
+            &                wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) +  &
+            &                wfx_ice_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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90	(revision 8879)
@@ -0,0 +1,283 @@
+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 
+      !                                           !-- correct pond fraction to avoid a_ip > a_i
+      WHERE( a_ip(:,:,:) > a_i(:,:,:) )   a_ip(:,:,:) = a_i(:,:,:)
+      !
+   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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90	(revision 8879)
@@ -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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_umx.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_umx.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_umx.F90	(revision 8879)
@@ -0,0 +1,659 @@
+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 ( ln_pnd_H12 ) 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 = 1, jpjm1
+            DO ji = 1, 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 = 1, jpjm1
+            DO ji = 1, 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 = 1, jpjm1
+         DO ji = 1, 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
+      
+      ! 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 = 2, jpjm1
+            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 = 2, jpjm1
+            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
+         !  
+      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24)
+         !
+         DO jj = 2, jpjm1
+            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 = 2, jpjm1
+            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 = 2, jpjm1
+            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 = fs_2, fs_jpim1
+               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 = fs_2, fs_jpim1
+               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 = fs_2, fs_jpim1
+               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 = fs_2, fs_jpim1
+               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 = fs_2, fs_jpim1
+               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 = 1, 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) )
+            !
+            paa(ji,jj) = paa(ji,jj) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+         END DO
+      END DO
+      !
+      DO jj = 1, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            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) )
+            !
+            pbb(ji,jj) = pbb(ji,jj) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+         END DO
+      END DO
+      !
+!!      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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90	(revision 8879)
@@ -0,0 +1,944 @@
+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(:,:,:) )
+         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(:,:,:) )
+         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(:,:) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:) )
+         
+         !-----------------------------------------------------------------------------!
+         ! 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(:,:,:) )
+         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(:,:,:) )
+         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(:,:) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:) )
+
+      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 ( ln_pnd_H12 ) 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 ( ln_pnd_fwb ) 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 ( ln_pnd_H12 ) 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 ( ln_pnd_H12 ) 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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90	(revision 8879)
@@ -0,0 +1,151 @@
+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, 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, ln_aEVP, 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,*) '         use adaptive EVP (aEVP)                           ln_aEVP    = ', ln_aEVP
+         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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90	(revision 8879)
@@ -0,0 +1,908 @@
+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, 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 aEVP from the nice work of Kimmritz et al. (2016 & 2017)
+      !!              by setting up ln_aEVP=T (i.e. changing alpha and beta parameters).
+      !!              This is an upgraded version of mEVP from Bouillon et al. 2013
+      !!              (i.e. more stable and better convergence)
+      !!
+      !! References : Hunke and Dukowicz, JPO97
+      !!              Bouillon et al., Ocean Modelling 2009
+      !!              Bouillon et al., Ocean Modelling 2013
+      !!              Kimmritz et al., Ocean Modelling 2016 & 2017
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! time step
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pstress1_i, pstress2_i, pstress12_i
+      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) ::   zalph1, z1_alph1, zalph2, z1_alph2                       ! alpha coef from Bouillon 2009 or Kimmritz 2017
+      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) ::   zbeta                           ! beta coef from Kimmritz 2017
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::   zdt_m                           ! (dt / ice-snow_mass) on 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)
+      IF( .NOT. ln_aEVP ) THEN
+         zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp
+         zalph2 = zalph1 * z1_ecc2
+
+         z1_alph1 = 1._wp / ( zalph1 + 1._wp )
+         z1_alph2 = 1._wp / ( zalph2 + 1._wp )
+      ENDIF
+         
+      ! 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)
+
+            ! dt/m at T points (for alpha and beta coefficients)
+            zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
+            
+            ! 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_multi( zmf, 'T', 1., zdt_m, '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, jpj    ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12
+            DO ji = 2, jpi ! 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 )
+
+               ! alpha & beta for aEVP
+               !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
+               !   alpha = beta = sqrt(4*gamma)
+               IF( ln_aEVP ) THEN
+                  zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
+                  z1_alph1 = 1._wp / ( zalph1 + 1._wp )
+                  zalph2   = zalph1
+                  z1_alph2 = z1_alph1
+               ENDIF
+               
+               ! 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
+
+               ! alpha & beta for aEVP
+               IF( ln_aEVP ) THEN
+                  zalph2   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
+                  z1_alph2 = 1._wp / ( zalph2 + 1._wp )
+                  zbeta(ji,jj) = zalph2
+               ENDIF
+               
+               ! 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
+
+         ! --- 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 vary as in Kimmritz 2016 & 2017
+         !  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 ) ) )
+                  !
+                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(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) * ( zbeta(ji,jj) + 1._wp ) + 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)
+                  ELSE               !--- ice velocity using EVP 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)
+                  ENDIF
+               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 ) ) )
+                  !
+                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(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) * ( zbeta(ji,jj) + 1._wp ) + 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)
+                  ELSE               !--- ice velocity using EVP 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)
+                  ENDIF
+               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 ) ) )
+                  !
+                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(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) * ( zbeta(ji,jj) + 1._wp ) + 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)
+                  ELSE               !--- ice velocity using EVP 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)
+                  ENDIF
+               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 ; 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  !
+                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(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) * ( zbeta(ji,jj) + 1._wp ) + 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)
+                  ELSE               !--- ice velocity using EVP 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)
+                  ENDIF
+               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           
+      
+      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 --- !
+      CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
+      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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90	(revision 8879)
@@ -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:
+      !!                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, ln_pnd_alb, a_ip_frac, h_ip, 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, h_s, h_i, alb_ice )    ! 
+         IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
+         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, phs=h_s, phi=h_i )
+         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, nice_jules
+      !!-------------------------------------------------------------------
+      !
+      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
+         WRITE(numout,*) '      Jules coupling (0=no, 1=emulated, 2=active)      nice_jules = ', nice_jules
+      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) .AND. (.NOT. ln_meto_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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90	(revision 8879)
@@ -0,0 +1,582 @@
+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, zfac
+      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 /= 2 )  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 (:,:,:)
+         t1_ice (:,:,:) = t_i (:,:,1,:)   ! initialisation of 1st layer temp for coupled simu
+         cnd_ice(:,:,:) = 0._wp           ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling)
+
+         ! Melt pond volume and fraction
+         IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN   ;   zfac = 1._wp
+         ELSE                                     ;   zfac = 0._wp   ;   ENDIF 
+         DO jl = 1, jpl
+            a_ip_frac(:,:,jl) = rn_apnd * zswitch(:,:) * zfac
+            h_ip     (:,:,jl) = rn_hpnd * zswitch(:,:) * zfac
+         END DO
+         a_ip(:,:,:) = a_ip_frac(:,:,:) * a_i (:,:,:) 
+         v_ip(:,:,:) = h_ip     (:,:,:) * a_ip(:,:,:)
+
+      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
+
+         tn_ice (:,:,:) = t_i (:,:,1,:)
+         t1_ice (:,:,:) = t_i (:,:,1,:)   ! initialisation of 1st layer temp for coupled simu
+         cnd_ice(:,:,:) = 0._wp           ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling)
+         
+         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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90	(revision 8879)
@@ -0,0 +1,723 @@
+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
+
+   INTEGER ::              nice_catbnd   ! choice of the type of ice category function
+   !                                       ! associated indices:
+   INTEGER, PARAMETER ::   np_cathfn = 1   ! categories defined by a function
+   INTEGER, PARAMETER ::   np_catusr = 2   ! categories defined by the user
+   !
+   ! ** namelist (namitd) **
+   LOGICAL  ::   ln_cat_hfn  ! ice categories are defined by function like rn_himean**(-0.05)
+   REAL(wp) ::   rn_himean   ! mean thickness of the domain
+   LOGICAL  ::   ln_cat_usr  ! ice categories are defined by rn_catbnd
+   REAL(wp), DIMENSION(0:100) ::   rn_catbnd   ! ice categories bounds
+   !
+   !!----------------------------------------------------------------------
+   !! 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 
+               IF ( ln_pnd_H12 )    a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin
+               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
+               !  
+               IF ( ln_pnd_H12 ) 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
+               !
+            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, ioptio   ! Local integer output status for namelist read
+      REAL(wp) ::   zhmax, znum, zden, zalpha   !   -      -
+      !
+      NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, 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,*) '      Ice categories are defined by a function of rn_himean**(-0.05)    ln_cat_hfn = ', ln_cat_hfn
+         WRITE(numout,*) '         mean ice thickness in the domain                               rn_himean  = ', rn_himean
+         WRITE(numout,*) '      Ice categories are defined by rn_catbnd                           ln_cat_usr = ', ln_cat_usr
+         WRITE(numout,*) '         ice categories boundaries (m)                                  rn_catbnd  = ', rn_catbnd 
+         WRITE(numout,*) '      minimum ice thickness                                             rn_himin   = ', rn_himin 
+      ENDIF
+      !
+      !-----------------------------------!
+      !  Thickness categories boundaries  !
+      !-----------------------------------!
+      !                             !== set the choice of ice categories ==!
+      ioptio = 0 
+      IF( ln_cat_hfn ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_cathfn    ;   ENDIF
+      IF( ln_cat_usr ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_catusr    ;   ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_itd_init: choose one and only one ice categories boundaries' )
+      !
+      SELECT CASE( nice_catbnd )
+      !                                !------------------------!
+      CASE( np_cathfn )                ! h^(-alpha) function
+         !                             !------------------------!
+         zalpha = 0.05_wp
+         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
+         !                             !------------------------!
+      CASE( np_catusr )                ! user defined
+         !                             !------------------------!
+         DO jl = 0, jpl
+            hi_max(jl) = rn_catbnd(jl)
+         END DO
+         !
+      END SELECT
+      !
+      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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90	(revision 8879)
@@ -0,0 +1,301 @@
+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
+         znam = 'cnd_ice'//'_htc'//zchar
+         z2d(:,:) = cnd_ice(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! cnd_ice
+         znam = 't1_ice'//'_htc'//zchar
+         z2d(:,:) = t1_ice(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! t1_ice
+      END DO
+
+      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
+
+      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
+      INTEGER  ::   id1            ! local integer
+      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(:,:)
+         znam = 'cnd_ice'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         cnd_ice(:,:,jl) = z2d(:,:)
+         znam = 't1_ice'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         t1_ice(:,:,jl) = z2d(:,:)
+      END DO
+
+      id1 = iom_varid( numrir, 'a_ip_htc01' , ldstop = .FALSE. )
+      IF( id1 > 0 ) THEN                       ! fields exist (melt ponds)
+         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
+      ELSE                                     ! start from rest
+         IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it'
+         a_ip(:,:,:) = 0._wp
+         v_ip(:,:,:) = 0._wp
+      ENDIF
+
+      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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90	(revision 8879)
@@ -0,0 +1,433 @@
+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 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:
+         !    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_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
+      !
+      IF( ln_icethd ) THEN
+         CALL ice_thd_init             ! set ice thermodynics parameters (clem: important to call it first for melt ponds)
+      ENDIF   
+      !                                ! 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
+      !
+      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 
+      wfx_pnd(:,:) = 0._wp
+
+      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)
+      cnd_ice(:,:,:) = 0._wp   ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling)
+      
+   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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icetab.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icetab.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icetab.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90	(revision 8879)
@@ -0,0 +1,599 @@
+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, &
+      &                 qml_ice, qcn_ice, qsr_ice_tr
+   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 icethd_pnd     ! sea-ice: melt ponds
+   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 ; dh_s_mlt(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_pnd                             ! Melt ponds formation
+                              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), a_ip_1d     (1:npti), a_ip     (:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )
+         !
+         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), 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), qml_ice_1d   (1:npti), qml_ice      (:,:,kl)  )
+         CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d   (1:npti), qcn_ice      (:,:,kl) )
+         CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_tr_1d(1:npti), qsr_ice_tr   (:,:,kl) )
+         !
+         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), wfx_pnd_1d (1:npti), wfx_pnd          )
+         !
+         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)
+         v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_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), a_ip_1d     (1:npti), a_ip     (:,:,kl) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )
+         !
+         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), wfx_pnd_1d (1:npti), wfx_pnd        )
+         !
+         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) )
+         ! effective conductivity (for Jules coupling)
+         CALL tab_1d_2d( npti, nptidx(1:npti), cnd_ice_1d(1:npti), cnd_ice(:,:,kl) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_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) )
+         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,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
+                       CALL ice_thd_pnd_init   ! set melt ponds parameters
+      !
+   END SUBROUTINE ice_thd_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy module          NO  ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_dh.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_dh.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_dh.F90	(revision 8879)
@@ -0,0 +1,705 @@
+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                 !
+      !------------------------------------------------------------------------------!
+      !
+      SELECT CASE ( nice_jules )
+
+         CASE ( np_jules_ACTIVE )
+
+            DO ji = 1, npti
+               zq_su(ji)        =   MAX( 0._wp, qml_ice_1d(ji) * rdt_ice )
+            END DO
+
+         CASE ( np_jules_EMULE )
+
+            DO ji = 1, npti
+               zdum             =   ( qns_ice_1d(ji) + qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) - fc_su(ji) ) 
+               qml_ice_1d(ji)   =   zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
+               zq_su(ji)        =   MAX( 0._wp, qml_ice_1d(ji) * rdt_ice )
+            END DO
+
+         CASE ( np_jules_OFF ) 
+
+            DO ji = 1, npti
+               zdum             =   ( qns_ice_1d(ji) + qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) - fc_su(ji) ) 
+               zdum             =   zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
+               zq_su(ji)        =   MAX( 0._wp, zdum             * rdt_ice )
+            END DO
+
+      END SELECT
+         
+      DO ji = 1, npti
+         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
+         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
+            dh_s_mlt(ji)       = dh_s_mlt(ji) - h_s_1d(ji)
+            ! 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
+         dh_s_mlt(ji)       = dh_s_mlt(ji) + zdeltah(ji,1)
+         ! 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
+            dh_s_mlt(ji)       = dh_s_mlt(ji) + zdeltah(ji,jk)
+            ! 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
+         dh_s_mlt(ji)       = dh_s_mlt(ji) + zdeltah(ji,1)
+         !    
+         ! 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 /= 2 )  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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_ent.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_ent.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_ent.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_pnd.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_pnd.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_pnd.F90	(revision 8879)
@@ -0,0 +1,290 @@
+MODULE icethd_pnd 
+   !!======================================================================
+   !!                     ***  MODULE  icethd_pnd   ***
+   !!   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 NEMO4
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                     ESIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_thd_pnd_init      : some initialization and namelist read
+   !!   ice_thd_pnd           : main calling routine
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE ice            ! sea-ice: variables
+   USE ice1D          ! sea-ice: thermodynamics variables
+   USE icetab         ! sea-ice: 1D <==> 2D transformation
+   !
+   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_thd_pnd_init    ! routine called by icestp.F90
+   PUBLIC   ice_thd_pnd         ! routine called by icestp.F90
+
+   INTEGER ::              nice_pnd   ! choice of the type of pond scheme
+   !                                               ! associated indices:
+   INTEGER, PARAMETER ::   np_pndNO  = 0   ! No pond scheme
+   INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant pond scheme
+   INTEGER, PARAMETER ::   np_pndH12 = 2   ! Evolutive pond scheme (Holland et al. 2012)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
+   !! $Id: icethd_pnd.F90 8420 2017-10-05 13:07:10Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_thd_pnd
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE ice_thd_pnd   ***
+      !!               
+      !! ** Purpose :   change melt pond fraction
+      !!                
+      !! ** Method  :   brut force
+      !!
+      !! ** Action  : - 
+      !!              - 
+      !!-------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('ice_thd_pnd')
+
+      SELECT CASE ( nice_pnd )
+
+      CASE (np_pndCST)
+         !                             !-------------------------------!
+         CALL pnd_CST                  ! Constant melt ponds           !
+         !                             !-------------------------------!
+      CASE (np_pndH12)
+         !                             !-------------------------------!
+         CALL pnd_H12                  ! Holland et al 2012 melt ponds !
+         !                             !-------------------------------!
+      END SELECT
+
+      IF( nn_timing == 1 )  CALL timing_stop('ice_thd_pnd')
+
+   END SUBROUTINE ice_thd_pnd 
+
+   SUBROUTINE pnd_CST 
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE pnd_CST  ***
+      !!
+      !! ** 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        ! loop indices
+      !!-------------------------------------------------------------------
+      DO ji = 1, npti
+         
+         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN
+            a_ip_frac_1d(ji) = rn_apnd
+            h_ip_1d(ji)      = rn_hpnd    
+            a_ip_1d(ji)      = a_ip_frac_1d(ji) * a_i_1d(ji)
+         ELSE
+            a_ip_frac_1d(ji) = 0._wp
+            h_ip_1d(ji)      = 0._wp    
+            a_ip_1d(ji)      = 0._wp
+         ENDIF
+         
+      END DO
+      
+   END SUBROUTINE pnd_CST
+
+   SUBROUTINE pnd_H12
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE pnd_H12  ***
+      !!
+      !! ** Purpose    : Compute melt pond evolution
+      !!
+      !! ** Method     : Empirical method. A fraction of meltwater is accumulated in ponds 
+      !!                 and sent to ocean when surface is freezing
+      !!
+      !!                 pond growth:      Vp = Vp + dVmelt
+      !!                    with dVmelt = R/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i
+      !!                 pond contraction: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)
+      !!                    with Tp = -2degC
+      !!
+      !! ** 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)
+      !!    
+      !!-------------------------------------------------------------------
+      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 ::   zpnd_aspect = 0.8_wp ! pond aspect ratio
+      REAL(wp), PARAMETER ::   zTp = -2._wp ! 
+
+      REAL(wp) ::   zfr_mlt            ! fraction of available meltwater retained for melt ponding
+      REAL(wp) ::   zdv_mlt          ! available meltwater for melt ponding
+      REAL(wp) ::   z1_Tp        ! reference temperature
+      REAL(wp) ::   z1_rhofw          ! inverse freshwater density
+      REAL(wp) ::   z1_zpnd_aspect    ! inverse pond aspect ratio
+      REAL(wp) ::   zvpnd            ! dummy pond volume
+      REAL(wp) ::   zfac, zdum
+
+      INTEGER  ::   ji        ! loop indices
+      !!-------------------------------------------------------------------
+      z1_rhofw       = 1. / rhofw 
+      z1_zpnd_aspect = 1. / zpnd_aspect
+      z1_Tp          = 1._wp / zTp 
+
+      DO ji = 1, npti
+         !                                                        !--------------------------------!
+         IF( h_i_1d(ji) < rn_himin) THEN                          ! Case ice thickness < rn_himin  !
+            !                                                     !--------------------------------!
+            !--- Remove ponds on thin ice and send water into the ocean
+            IF( ln_pnd_fwb ) THEN
+               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) + h_ip_1d(ji) * a_ip_1d(ji) * rhofw * r1_rdtice
+            ENDIF
+            a_ip_1d(ji)      = 0._wp
+            a_ip_frac_1d(ji) = 0._wp
+            h_ip_1d(ji)      = 0._wp
+            !                                                     !--------------------------------!
+         ELSE                                                     ! Case ice thickness >= rn_himin !
+            !                                                     !--------------------------------!
+            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! record pond volume at previous time step
+            zvpnd       = v_ip_1d(ji)
+
+            ! available meltwater for melt ponding [m, >0] and fraction
+            zdv_mlt = -( dh_i_surf(ji)*rhoic + dh_s_mlt(ji)*rhosn ) * z1_rhofw * a_i_1d(ji)
+            zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji)  !!clem CICE doc
+!!!            zfr_mlt = zrmin + zrmax * a_i_1d(ji)  !!clem Holland paper 
+
+            !--- Pond gowth
+            ! v_ip should never be negative, otherwise code crashes
+            ! MV: as far as I saw, UM5 can create very small negative v_ip values (not Prather)
+            v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt )
+
+            IF( ln_pnd_fwb .AND. zdv_mlt > 0._wp ) THEN
+               ! melt ponds mass flux (<0)
+               zfac = zfr_mlt * zdv_mlt * rhofw * r1_rdtice
+               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac
+
+               ! adjust ice/snow melting (>0) to take into account ponding
+               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )
+               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum)
+               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum)
+            ENDIF
+
+            !--- Pond contraction (due to refreezing)
+            v_ip_1d(ji)      = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp )
+
+            ! --- Set new pond area and depth assuming linear relation between h_ip and a_ip_frac
+            !        h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i
+            a_ip_1d(ji)      = SQRT( v_ip_1d(ji) * z1_zpnd_aspect * a_i_1d(ji) )
+            !NB: the SQRT has been a recurring source of crash when v_ip or a_i tuns to be even only slightly negative
+            a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji)
+            h_ip_1d(ji)      = zpnd_aspect * a_ip_frac_1d(ji)
+
+            !! clem: there is no clever way to conserve mass here...
+            
+!            IF( ln_pnd_fwb ) THEN
+!               ! melt ponds mass flux (>0 when ponds shrink)
+!               zfac = ( v_ip_1d(ji) - zvpnd ) * rhofw * r1_rdtice
+!               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac!!
+!
+!               ! adjust ice/snow
+!               zfac = ( v_ip_1d(ji) - zvpnd ) * rhofw / ( a_i_1d(ji)*h_s_1d(ji)*rhosn + a_i_1d(ji)*h_i_1d(ji)*rhoic )!
+!
+!               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + h_s_1d(ji) * zfac * a_i_1d(ji) * rhosn * r1_rdtice
+!               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     + h_i_1d(ji) * zfac * a_i_1d(ji) * rhoic * r1_rdtice
+!               
+!               !!h_s_1d(ji) = h_s_1d(ji) * ( 1._wp + zfac )
+!               !!h_i_1d(ji) = h_i_1d(ji) * ( 1._wp + zfac )!
+!
+!            ENDIF
+
+         ENDIF
+      END DO
+
+   END SUBROUTINE pnd_H12
+
+   SUBROUTINE ice_thd_pnd_init 
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_thd_pnd_init   ***
+      !!
+      !! ** Purpose : Physical constants and parameters linked to melt ponds
+      !!              over sea ice
+      !!
+      !! ** Method  :  Read the namthd_pnd  namelist and check the melt pond  
+      !!               parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namthd_pnd  
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios, ioptio                 ! Local integer output status for namelist read
+      NAMELIST/namthd_pnd/  ln_pnd_H12, ln_pnd_fwb, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb
+      !!-------------------------------------------------------------------
+
+      REWIND( numnam_ice_ref )              ! Namelist namthd_pnd  in reference namelist : Melt Ponds  
+      READ  ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namthd_pnd  in configuration namelist : Melt Ponds
+      READ  ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namthd_pnd )
+      
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_thd_pnd_init: ice parameters for melt ponds'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namicethd_pnd:'
+         WRITE(numout,*) '      Evolutive melt pond fraction and depth (Holland et al 2012)  ln_pnd_H12 = ', ln_pnd_H12
+         WRITE(numout,*) '         Melt ponds store fresh water or not                       ln_pnd_fwb = ', ln_pnd_fwb
+         WRITE(numout,*) '      Prescribed melt pond fraction and depth                      ln_pnd_Cst = ', ln_pnd_CST
+         WRITE(numout,*) '         Prescribed pond fraction                                  rn_apnd    = ', rn_apnd
+         WRITE(numout,*) '         Prescribed pond depth                                     rn_hpnd    = ', rn_hpnd
+         WRITE(numout,*) '      Melt ponds affect albedo or not                              ln_pnd_alb = ', ln_pnd_alb
+      ENDIF
+      !
+      !                             !== set the choice of ice pond scheme ==!
+      ioptio = 0
+                                                            nice_pnd = np_pndNO
+      IF( ln_pnd_CST ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF
+      IF( ln_pnd_H12 ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndH12    ;   ENDIF
+      IF( ioptio > 1 )   CALL ctl_stop( 'ice_thd_pnd_init: choose one and only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' )
+
+      SELECT CASE( nice_pnd )
+      CASE( np_pndNO )         
+         IF(ln_pnd_fwb) THEN ; ln_pnd_fwb = .FALSE. ; CALL ctl_warn( 'ln_pnd_fwb=false when no ponds' ) ; ENDIF
+         IF(ln_pnd_alb) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF
+      CASE( np_pndCST)
+         IF(ln_pnd_fwb) THEN ; ln_pnd_fwb = .FALSE. ; CALL ctl_warn( 'ln_pnd_fwb=false when ln_pnd_CST=true' ) ; ENDIF
+      END SELECT
+      !
+   END SUBROUTINE ice_thd_pnd_init
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Empty module          NO ESIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif 
+
+   !!======================================================================
+END MODULE icethd_pnd 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90	(revision 8879)
@@ -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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90	(revision 8879)
@@ -0,0 +1,1020 @@
+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_BL99      ! Heat diffusion follows Bitz and Lipscomb (1999)
+   LOGICAL  ::   ln_cndi_U64      ! thermal conductivity: Untersteiner (1964)
+   LOGICAL  ::   ln_cndi_P07      ! thermal conductivity: Pringle et al (2007)
+   REAL(wp) ::   rn_kappa_i       ! coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
+   REAL(wp), PUBLIC ::   rn_cnd_s ! thermal conductivity of the snow [W/m/K]
+
+   INTEGER  ::   nice_zdf         ! Choice of the type of vertical heat diffusion formulation
+   !                                           ! associated indices:
+   INTEGER, PARAMETER ::   np_BL99    = 1      ! Bitz and Lipscomb (1999)
+
+   INTEGER , PARAMETER ::   np_zdf_jules_OFF    = 0   !   compute all temperatures from qsr and qns
+   INTEGER , PARAMETER ::   np_zdf_jules_SND    = 1   !   compute conductive heat flux and surface temperature from qsr and qns
+   INTEGER , PARAMETER ::   np_zdf_jules_RCV    = 2   !   compute snow and inner ice temperatures from qcnd
+   
+   !!----------------------------------------------------------------------
+   !! 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 chooses between the appropriate routine for the 
+      !!           computation of vertical diffusion
+      !!
+      !!-------------------------------------------------------------------
+      !!
+   
+      SELECT CASE ( nice_zdf )      ! Choose the vertical heat diffusion solver
+      
+                                       !-------------      
+         CASE( np_BL99 )               ! BL99 solver
+                                       !-------------
+         
+            IF ( nice_jules == np_jules_OFF ) THEN   ! No Jules coupler     
+
+               CALL ice_thd_zdf_BL99 ( np_zdf_jules_OFF )
+                                       
+            ENDIF
+            
+            IF ( nice_jules == np_jules_EMULE ) THEN   ! Jules coupler is emulated
+            
+               CALL ice_thd_zdf_BL99 ( np_zdf_jules_SND )
+               CALL ice_thd_zdf_BL99 ( np_zdf_jules_RCV )
+                                                   
+            ENDIF
+
+            IF ( nice_jules == np_jules_ACTIVE ) THEN   ! Jules coupler is emulated
+            
+               CALL ice_thd_zdf_BL99 ( np_zdf_jules_RCV )
+                                                   
+            ENDIF
+            
+      END SELECT
+      
+   END SUBROUTINE ice_thd_zdf
+   
+   
+   
+   SUBROUTINE ice_thd_zdf_BL99(k_jules)
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE ice_thd_zdf_BL99  ***
+      !! ** Purpose :
+      !!           This routine determines the time evolution of snow and sea-ice 
+      !!           temperature profiles, using the original Bitz and Lipscomb (1999) algorithm
+      !!
+      !! ** 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, INTENT(in) ::   k_jules     ! Jules coupling (0=OFF, 1=RECEIVE, 2=SEND)
+      
+      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) ::   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)     ::   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       )     ::   ztsuold     ! Old surface temperature in 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
+
+      REAL(wp) ::   zfr1, zfr2, zfrqsr_tr_i   ! dummy factor
+      
+      ! 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
+
+      ! Store initial temperatures and non solar heat fluxes
+      IF ( k_jules == np_zdf_jules_OFF .OR. k_jules == np_zdf_jules_SND  ) THEN ! OFF or SND mode
+
+         ztsub  (1:npti)       =   t_su_1d(1:npti)                          ! surface temperature at iteration n-1
+         ztsuold(1:npti)       =   t_su_1d(1:npti)                          ! surface temperature initial value
+         zdqns_ice_b(1:npti)   =   dqns_ice_1d(1:npti)                      ! derivative of incoming nonsolar flux 
+         zqns_ice_b (1:npti)   =   qns_ice_1d(1:npti)                       ! store previous qns_ice_1d value
+
+         t_su_1d(1:npti)       =   MIN( t_su_1d(1:npti), rt0 - ztsu_err )   ! required to leave the choice between melting or not
+
+      ENDIF   
+
+      ztsold (1:npti,:) = t_s_1d(1:npti,:)   ! Old snow temperature
+      ztiold (1:npti,:) = t_i_1d(1:npti,:)   ! Old ice temperature
+
+      !-------------
+      ! 2) Radiation
+      !-------------
+      ! --- Transmission/absorption of solar radiation in the ice --- !
+!     zfr1 = ( 0.18 * ( 1.0 - 0.81 ) + 0.35 * 0.81 )            !   standard value
+!     zfr2 = ( 0.82 * ( 1.0 - 0.81 ) + 0.65 * 0.81 )            !   zfr2 such that zfr1 + zfr2 to equal 1
+
+!     DO ji = 1, npti
+
+!        zfac = MAX( 0._wp , 1._wp - ( h_i_1d(ji) * 10._wp ) )     
+
+!              zfrqsr_tr_i = zfr1 + zfac * zfr2                         !   below 10 cm, linearly increase zfrqsr_tr_i until 1 at zero thickness
+!              IF ( h_s_1d(ji) >= 0.0_wp )   zfrqsr_tr_i = 0._wp     !   snow fully opaque
+
+!              qsr_ice_tr_1d(ji) = zfrqsr_tr_i * qsr_ice_1d(ji)   !   transmitted solar radiation 
+
+!              zfsw(ji) = qsr_ice_1d(ji) - qsr_ice_tr_1d(ji)
+!              zftrice(ji) = qsr_ice_tr_1d(ji)
+!              i0(ji) = zfrqsr_tr_i
+
+!     END DO
+
+      zradtr_s(1:npti,0) = qsr_ice_tr_1d(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) + qsr_ice_tr_1d(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
+
+         !
+         !----------------------------------------!
+         !                                        !
+         !       JULES IF (OFF or SND MODE)       !
+         !                                        !
+         !----------------------------------------!
+         !
+         
+         IF ( k_jules == np_zdf_jules_OFF .OR. k_jules == np_zdf_jules_SND  ) THEN ! OFF or SND mode
+         
+            !
+            ! In OFF mode the original BL99 temperature computation is used
+            ! (with qsr_ice, qns_ice and dqns_ice as inputs)
+            !
+            ! In SND mode, the computation is required to compute the conduction fluxes
+            !
+         
+            !----------------------------
+            ! 6) surface flux computation
+            !----------------------------
+
+            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
+
+            DO ji = 1, npti
+               zfnet(ji) = qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) + qns_ice_1d(ji) ! net heat flux = net solar - transmitted solar + non solar
+            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 )
+         !
+         !----------------------------------------!
+         !                                        !
+         !       JULES IF (RCV MODE)              !
+         !                                        !
+         !----------------------------------------!
+         !
+
+         ELSE IF ( k_jules == np_zdf_jules_RCV  ) THEN ! RCV mode
+         
+            !
+            ! In RCV mode, we use a modified BL99 solver 
+            ! with conduction flux (qcn_ice) as forcing term
+            !
+            !----------------------------
+            ! 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
+
+               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)
+               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) + qcn_ice_1d(ji) ) 
+
+            !                               !---------------------!
+            ELSE                            ! cells without snow  !
+            !                               !---------------------!
+
+               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)  
+               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) + qcn_ice_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,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)    &
+               &                    + qcn_ice_1d(ji) )
+
+               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
+            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 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 )
+
+         ENDIF ! k_jules
+         
+      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
+      !-----------------------------
+      !
+      ! --- update conduction fluxes
+      !
+      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
+      
+      !
+      ! --- Diagnose the heat loss due to changing non-solar / conduction flux --- !
+      !
+      DO ji = 1, npti
+            IF ( k_jules == np_zdf_jules_OFF .OR. k_jules == np_zdf_jules_SND  ) THEN 
+                   ! OFF or SND mode
+               hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji) 
+            ELSE   ! RCV mode
+               hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( fc_su(ji) - qcn_ice_1d(ji) ) * a_i_1d(ji) 
+            ENDIF
+      END DO
+      
+      !
+      ! --- Diagnose the heat loss due to non-fully converged temperature solution (should not be above 10-4 W-m2) --- !
+      !
+
+      IF ( ( k_jules == np_zdf_jules_OFF ) .OR. ( k_jules == np_zdf_jules_RCV ) ) THEN ! OFF
+      
+         CALL ice_thd_enmelt       
+
+         !     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 ( ( k_jules == np_zdf_jules_OFF ) ) THEN
+               
+                  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)      + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji)
+                  ENDIF
+            
+            ELSE ! RCV CASE
+            
+               zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji)
+            
+            ENDIF
+            
+            ! total heat sink to be sent to the ocean
+            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err
+
+            ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2   
+            hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_rdtice * a_i_1d(ji)
+   
+         END DO 
+           
+         !
+         ! --- SIMIP diagnostics
+         !
+
+         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
+     
+      ENDIF
+      !
+      !---------------------------------------------------------------------------------------
+      ! 11) Jules coupling: reset inner snow and ice temperatures, update conduction fluxes
+      !---------------------------------------------------------------------------------------
+      ! effective conductivity and 1st layer temperature (Jules coupling)
+      DO ji = 1, npti
+         cnd_ice_1d(ji) = 2._wp * ( isnow(ji) * zkappa_s(ji,0) + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) )
+         t1_ice_1d (ji) =         ( isnow(ji) * t_s_1d  (ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d  (ji,1) )
+      END DO
+      !
+      IF ( k_jules == np_zdf_jules_SND ) THEN   ! --- Jules coupling in "SND" mode
+      
+         ! Restore temperatures to their initial values
+         t_s_1d(1:npti,:)        = ztsold (1:npti,:)
+         t_i_1d(1:npti,:)        = ztiold (1:npti,:)
+         qcn_ice_1d(1:npti)      = fc_su(1:npti)
+         
+      ENDIF
+      
+   END SUBROUTINE ice_thd_zdf_BL99
+
+
+
+   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, ioptio   ! Local integer output status for namelist read
+      !!
+      NAMELIST/namthd_zdf/ ln_zdf_BL99, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, rn_kappa_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,*) '      Bitz and Lipscomb (1999) formulation                    ln_zdf_BL99  = ', ln_zdf_BL99
+         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
+     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
+
+      !                             !== set the choice of ice vertical thermodynamic formulation ==!
+      ioptio = 0 
+      !      !--- BL99 thermo dynamics                               (linear liquidus + constant thermal properties)
+      IF( ln_zdf_BL99 ) THEN   ;   ioptio = ioptio + 1   ;   nice_zdf = np_BL99   ;   ENDIF
+      IF( ioptio /= 1 )    CALL ctl_stop( 'ice_thd_init: one and only one ice thermo option has to be defined ' )
+      !
+   END SUBROUTINE ice_thd_zdf_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option       Dummy Module             No ESIM sea-ice model
+   !!---------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE icethd_zdf
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90	(revision 8879)
@@ -0,0 +1,449 @@
+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) + 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, ln_pnd_alb, a_ip_frac, h_ip, 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_fwb )   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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90	(revision 8879)
@@ -0,0 +1,704 @@
+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 )
+
+      at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds
+      vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 )
+
+      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
+         !
+         !                           ! put rt0 where there is no ice
+         WHERE( at_i(:,:)<=epsi20 )
+            tm_su(:,:) = rt0
+            tm_si(:,:) = rt0
+            tm_i (:,:) = rt0
+         END WHERE
+
+         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 and ponds
+      !---------------------------------------------------------------
+      !                                            !--- 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
+      !                                           !--- ice thickness
+      h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:)
+
+      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)
+      END WHERE
+      !                                           !--- snow thickness
+      h_s(:,:,:) = v_s (:,:,:) * z1_a_i(:,:,:)
+      !                                           !--- ice age      
+      o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:)
+      !                                           !--- pond fraction and thickness      
+      a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:)
+      WHERE( a_ip_frac(:,:,:) > epsi20 )   ;   h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:)
+      ELSEWHERE                            ;   h_ip(:,:,:) = 0._wp
+      END WHERE
+      !
+      !                                           !---  salinity (with a minimum value imposed everywhere)     
+      IF( nn_icesal == 2 ) THEN
+         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 )
+      !
+   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 (:,:,:)
+      v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:)
+      !
+   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
+               IF( ln_pnd_fwb ) THEN 
+                  wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_ip(ji,jj,jl) * rhofw * r1_rdtice
+               ENDIF
+               !-----------------------------------------------------------------
+               ! 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)
+
+               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
+        
+      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/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90	(revision 8879)
@@ -0,0 +1,393 @@
+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
+      
+      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
+
+      !----------------------------------
+      ! 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 ( 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
+
+      !--------------------------------
+      ! 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 ) 
+      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 )
+      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/) )
+
+      CALL histwrite( kid, "si_amp", kt, at_ip         , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "si_vmp", kt, vt_ip         , 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, "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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90	(revision 8878)
+++ 	(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$
-   !! 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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90	(revision 8878)
+++ 	(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$
-   !! 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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 8878)
+++ 	(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$
-   !! 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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 8878)
+++ 	(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. 08 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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90	(revision 8878)
+++ 	(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$
-   !! 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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 8878)
+++ 	(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: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 8878)
+++ 	(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
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90	(revision 8879)
@@ -7,58 +7,5 @@
    !!            3.6  ! 2016-05  (C. Rousset)   Add LIM3 compatibility
    !!----------------------------------------------------------------------
-#if defined key_agrif && defined key_lim2
-   !!----------------------------------------------------------------------
-   !!   'key_agrif'                                              AGRIF zoom
-   !!----------------------------------------------------------------------
-   USE par_oce      ! ocean parameters
-   
-   IMPLICIT NONE
-   PRIVATE 
-
-   PUBLIC agrif_ice_alloc ! routine called by nemo_init in nemogcm.F90
-
-   INTEGER, PUBLIC :: u_ice_id, v_ice_id, adv_ice_id
-   REAL(wp), PUBLIC :: lim_nbstep = 0.    ! child time position in sea-ice model
-#if defined key_lim2_vp
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)     :: u_ice_nst, v_ice_nst   
-#else
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: u_ice_oe, u_ice_sn     !: boundaries arrays
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:  "          " 
-#endif
-   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:  "          "
-
-   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3.4 , NEMO Consortium (2012)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS 
-
-   INTEGER FUNCTION agrif_ice_alloc()
-      !!----------------------------------------------------------------------
-      !!                ***  FUNCTION agrif_ice_alloc  ***
-      !!----------------------------------------------------------------------
-#if defined key_lim2_vp
-      ALLOCATE( u_ice_nst(jpi,jpj), v_ice_nst(jpi,jpj) ,   &
-#else
-      ALLOCATE( u_ice_oe(4,jpj,2) , v_ice_oe(4,jpj,2) ,    &
-         &      u_ice_sn(jpi,4,2) , v_ice_sn(jpi,4,2) ,    &
-#endif
-         &      adv_ice_oe (4,jpj,7,2) , adv_ice_sn (jpi,4,7,2) ,   &
-         &      STAT = agrif_ice_alloc)
-
-#if ! defined key_lim2_vp
-      u_ice_oe(:,:,:) =  0.e0
-      v_ice_oe(:,:,:) =  0.e0
-      u_ice_sn(:,:,:) =  0.e0
-      v_ice_sn(:,:,:) =  0.e0
-#endif
-      adv_ice_oe (:,:,:,:) = 0.e0 
-      adv_ice_sn (:,:,:,:) = 0.e0 
-      !
-   END FUNCTION agrif_ice_alloc
-
-#elif defined key_agrif && defined key_lim3
+#if defined key_agrif && defined key_lim3
    !!----------------------------------------------------------------------
    !!   'key_agrif'                                              AGRIF zoom
Index: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 8878)
+++ 	(revision )
@@ -1,662 +1,0 @@
-MODULE agrif_lim2_interp
-   !!======================================================================
-   !!                       ***  MODULE agrif_lim2_update ***
-   !! Nesting module :  update surface ocean boundary condition over ice
-   !!                   from a child grif
-   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
-   !!======================================================================
-   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
-   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
-   !!----------------------------------------------------------------------
-#if defined key_agrif && defined key_lim2 
-   !!----------------------------------------------------------------------
-   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
-   !!   'key_agrif' :                                 AGRIF library
-   !!----------------------------------------------------------------------
-   !!   agrif_interp_lim2   : update sea-ice model on boundaries or total
-   !!                         sea-ice area
-   !!  agrif_rhg_lim2_load  : interpolcation of ice velocities using Agrif
-   !!  agrif_rhg_lim2       : sub-interpolation of ice velocities for both 
-   !!                         splitting time and sea-ice time step
-   !!  agrif_interp_u_ice   : atomic routine to interpolate u_ice 
-   !!  agrif_interp_u_ice   : atomic routine to interpolate v_ice 
-   !!  agrif_trp_lim2_load  : interpolcation of ice properties using Agrif
-   !!  agrif_trp_lim2       : sub-interpolation of ice properties for  
-   !!                         sea-ice time step
-   !!  agrif_interp_u_ice   : atomic routine to interpolate ice properties 
-   !!----------------------------------------------------------------------
-   USE par_oce
-   USE dom_oce
-   USE sbc_oce
-   USE ice_2
-   USE dom_ice_2
-   USE agrif_ice
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC agrif_rhg_lim2_load, agrif_rhg_lim2
-   PUBLIC agrif_trp_lim2_load, agrif_trp_lim2
-   PUBLIC interp_u_ice, interp_v_ice
-   PUBLIC interp_adv_ice
-
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr 
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.4 , NEMO Consortium (2012)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-# if defined key_lim2_vp
-   SUBROUTINE agrif_rhg_lim2_load
-      !!-----------------------------------------------------------------------
-      !!              *** ROUTINE agrif_rhg_lim2_load ***
-      !!
-      !!  ** Method  : need a special routine for dealing with exchanging data
-      !! between the child and parent grid during ice step
-      !!
-      !!-----------------------------------------------------------------------
-      !
-      IF (Agrif_Root()) RETURN
-
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = .FALSE.
-      u_ice_nst(:,:) = 0.
-      v_ice_nst(:,:) = 0.
-      CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. )
-      CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. )
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = .FALSE.
-      !
-   END SUBROUTINE agrif_rhg_lim2_load
-
-
-   SUBROUTINE agrif_rhg_lim2(pu_n,pv_n)
-      !!-----------------------------------------------------------------------
-      !!                 *** ROUTINE agrif_rhg_lim2 ***
-      !!
-      !!  ** Method  : we feel the boundaries with values stored above
-      !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,0:jpj+1), INTENT(inout) :: pu_n, pv_n
-      !!
-      REAL(wp) :: zrhox, zrhoy
-      INTEGER :: ji,jj
-      !!-----------------------------------------------------------------------
-      !
-      IF (Agrif_Root()) RETURN
-
-      zrhox = Agrif_Rhox()
-      zrhoy = Agrif_Rhoy()
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=2,jpj
-            pu_n(3,jj) = u_ice_nst(3,jj)/(zrhoy*e2f(2,jj-1))*tmu(3,jj)
-         END DO
-         DO jj=2,jpj
-            pv_n(3,jj) = v_ice_nst(3,jj)/(zrhox*e1f(2,jj-1))*tmu(3,jj)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=2,jpj
-            pu_n(nlci-1,jj) = u_ice_nst(nlci-1,jj)/(zrhoy*e2f(nlci-2,jj-1))*tmu(nlci-1,jj)
-         END DO
-         DO jj=2,jpj
-            pv_n(nlci-1,jj) = v_ice_nst(nlci-1,jj)/(zrhox*e1f(nlci-2,jj-1))*tmu(nlci-1,jj)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=2,jpi
-            pv_n(ji,3) = v_ice_nst(ji,3)/(zrhox*e1f(ji-1,2))*tmu(ji,3)
-         END DO
-         DO ji=2,jpi
-            pu_n(ji,3) = u_ice_nst(ji,3)/(zrhoy*e2f(ji-1,2))*tmu(ji,3)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=2,jpi
-            pv_n(ji,nlcj-1) = v_ice_nst(ji,nlcj-1)/(zrhox*e1f(ji-1,nlcj-2))*tmu(ji,nlcj-1)
-         END DO
-         DO ji=2,jpi
-            pu_n(ji,nlcj-1) = u_ice_nst(ji,nlcj-1)/(zrhoy*e2f(ji-1,nlcj-2))*tmu(ji,nlcj-1)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE agrif_rhg_lim2
-
-#else
-   SUBROUTINE agrif_rhg_lim2_load
-      !!-----------------------------------------------------------------------
-      !!              *** ROUTINE agrif_rhg_lim2_load ***
-      !!
-      !!  ** Method  : need a special routine for dealing with exchanging data
-      !!  between the child and parent grid during ice step
-      !!               we interpolate and store the boundary if needed, ie if
-      !!  we are in inside a new parent ice time step
-      !!-----------------------------------------------------------------------
-      INTEGER :: ji,jj
-      REAL(wp) :: zrhox, zrhoy
-      !!-----------------------------------------------------------------------
-      !
-      IF (Agrif_Root()) RETURN
-
-      IF( lim_nbstep == 1. ) THEN
-         !
-         ! switch old values by hand
-         u_ice_oe(:,:,1) =  u_ice_oe(:,:,2)
-         v_ice_oe(:,:,1) =  v_ice_oe(:,:,2)
-         u_ice_sn(:,:,1) =  u_ice_sn(:,:,2)
-         v_ice_sn(:,:,1) =  v_ice_sn(:,:,2)
-         ! interpolation of boundaries (called weight prevents AGRIF interpolation)
-         Agrif_SpecialValue=-9999.
-         Agrif_UseSpecialValue = .TRUE.
-         IF( .NOT. ALLOCATED(uice_agr) )THEN
-            ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj))
-         ENDIF
-         uice_agr = 0.
-         vice_agr = 0.
-         CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.)
-         CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.)
-         Agrif_SpecialValue=0.
-         Agrif_UseSpecialValue = .FALSE.
-         !  
-         zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()      
-         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
-         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
-         ! fill  boundaries
-         DO jj = 1, jpj
-            DO ji = 1, 2
-               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj) 
-               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj)
-            END DO
-         END DO
-         DO jj = 1, jpj
-            v_ice_oe(2,jj,2) = vice_agr(2     ,jj) 
-            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj)
-         END DO
-         DO ji = 1, jpi
-            u_ice_sn(ji,2,2) = uice_agr(ji,2     ) 
-            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1)
-         END DO
-         DO jj = 1, 2
-            DO ji = 1, jpi
-               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       ) 
-               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3)
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-   END SUBROUTINE agrif_rhg_lim2_load
-
-
-   SUBROUTINE agrif_rhg_lim2( kiter, kitermax, cd_type)
-      !!-----------------------------------------------------------------------
-      !!                 *** ROUTINE agrif_rhg_lim2  ***
-      !!
-      !!  ** Method  : simple call to atomic routines using stored values to
-      !!  fill the boundaries depending of the position of the point and 
-      !!  computing factor for time interpolation 
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kiter, kitermax
-      CHARACTER(len=1), INTENT( in ) :: cd_type
-      !!    
-      REAL(wp) :: zalpha, zbeta
-      !!-----------------------------------------------------------------------
-      !
-      IF (Agrif_Root()) RETURN
-      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
-      zbeta  = REAL(kiter,wp) / kitermax
-      zbeta = zalpha * zbeta
-      SELECT CASE(cd_type)
-      CASE('U')
-         CALL ParcoursU( zbeta )
-      CASE('V')
-         CALL ParcoursV( zbeta )
-      END SELECT
-      !
-   END SUBROUTINE agrif_rhg_lim2
-
-
-   SUBROUTINE ParcoursU( pbeta )
-      !!-----------------------------------------------------------------------
-      !!                    *** ROUTINE parcoursU ***
-      !!
-      !!  ** Method  : time and spatial interpolation for U-point using values
-      !!  interpolated from the coarse grid and inside dvalues     
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in) :: pbeta
-      !!
-      INTEGER :: ji, jj
-      !!-----------------------------------------------------------------------
-      !
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            DO ji=1,2
-               u_ice(ji,jj) = (1-pbeta) * u_ice_oe(ji,jj,1) + pbeta * u_ice_oe(ji,jj,2)
-            END DO
-         END DO
-         DO jj=1,jpj
-            u_ice(2,jj) = 0.25*(u_ice(1,jj)+2.*u_ice(2,jj)+u_ice(3,jj))
-            u_ice(2,jj) = u_ice(2,jj) * umask(2,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            DO ji=1,2
-               u_ice(nlci+ji-3,jj) = (1-pbeta) * u_ice_oe(ji+2,jj,1) + pbeta * u_ice_oe(ji+2,jj,2)
-            END DO
-         END DO
-         DO jj=1,jpj
-            u_ice(nlci-2,jj) = 0.25*(u_ice(nlci-3,jj)+2.*u_ice(nlci-2,jj)+u_ice(nlci-1,jj))
-            u_ice(nlci-2,jj) = u_ice(nlci-2,jj) * umask(nlci-2,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            u_ice(ji,2) = (1-pbeta) * u_ice_sn(ji,2,1) + pbeta * u_ice_sn(ji,2,2)
-            u_ice(ji,2) = u_ice(ji,2)*umask(ji,2,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            u_ice(ji,nlcj-1) = (1-pbeta) * u_ice_sn(ji,4,1) + pbeta * u_ice_sn(ji,4,2)
-            u_ice(ji,nlcj-1) = u_ice(ji,nlcj-1)*umask(ji,nlcj-1,1)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ParcoursU
-
-
-   SUBROUTINE ParcoursV( pbeta )
-      !!-----------------------------------------------------------------------
-      !!                    *** ROUTINE parcoursV ***
-      !! 
-      !!  ** Method  : time and spatial interpolation for V-point using values
-      !!  interpolated from the coarse grid and inside dvalues     
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(in) :: pbeta
-      !!
-      INTEGER :: ji, jj
-      !!-----------------------------------------------------------------------
-      !
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            v_ice(2,jj) = (1-pbeta) * v_ice_oe(2,jj,1) + pbeta * v_ice_oe(2,jj,2)
-            v_ice(2,jj) = v_ice(2,jj) * vmask(2,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            v_ice(nlci-1,jj) = (1-pbeta) * v_ice_oe(4,jj,1) + pbeta * v_ice_oe(4,jj,2)
-            v_ice(nlci-1,jj) = v_ice(nlci-1,jj)*vmask(nlci-1,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO jj=1,2
-            DO ji=1,jpi
-               v_ice(ji,jj) = (1-pbeta) * v_ice_sn(ji,jj,1) + pbeta * v_ice_sn(ji,jj,2)
-            END DO
-         END DO
-         DO ji=1,jpi
-            v_ice(ji,2)=0.25*(v_ice(ji,1)+2.*v_ice(ji,2)+v_ice(ji,3))
-            v_ice(ji,2)=v_ice(ji,2)*vmask(ji,2,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO jj=1,2
-            DO ji=1,jpi
-               v_ice(ji,nlcj+jj-3) = (1-pbeta) * v_ice_sn(ji,jj+2,1) + pbeta * v_ice_sn(ji,jj+2,2)
-            END DO
-         END DO
-         DO ji=1,jpi
-            v_ice(ji,nlcj-2)=0.25*(v_ice(ji,nlcj-3)+2.*v_ice(ji,nlcj-2)+v_ice(ji,nlcj-1))
-            v_ice(ji,nlcj-2) = v_ice(ji,nlcj-2) * vmask(ji,nlcj-2,1)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ParcoursV
-# endif
-   SUBROUTINE agrif_trp_lim2_load
-      !!-----------------------------------------------------------------------
-      !!                 *** ROUTINE agrif_trp_lim2_load ***
-      !!
-      !!  ** Method  : need a special routine for dealing with exchanging data
-      !!  between the child and parent grid during ice step
-      !!               we interpolate and store the boundary if needed, ie if
-      !!  we are in inside a new parent ice time step
-     !!-----------------------------------------------------------------------
-      INTEGER :: ji,jj,jn
-      !!-----------------------------------------------------------------------
-      !
-      IF (Agrif_Root()) RETURN
-      IF( lim_nbstep == 1. ) THEN
-         !
-         ! switch old values
-         adv_ice_oe(:,:,:,1) =  adv_ice_oe(:,:,:,2)
-         adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2)
-         ! interpolation of boundaries
-         IF(.NOT.ALLOCATED(tabice_agr))THEN
-            ALLOCATE(tabice_agr(jpi,jpj,7))   
-         ENDIF
-         tabice_agr(:,:,:) = 0.
-         Agrif_SpecialValue=-9999.
-         Agrif_UseSpecialValue = .TRUE.
-         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
-         Agrif_SpecialValue=0.
-         Agrif_UseSpecialValue = .FALSE.
-         !  
-         ! fill  boundaries
-         DO jn =1,7
-            DO jj = 1, jpj
-               DO ji=1,2
-                  adv_ice_oe(ji  ,jj,jn,2) = tabice_agr(ji       ,jj,jn) 
-                  adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn)
-               END DO
-            END DO
-         END DO
-
-         Do jn =1,7
-            Do jj =1,2
-               DO ji = 1, jpi
-                  adv_ice_sn(ji,jj  ,jn,2) = tabice_agr(ji,jj       ,jn) 
-                  adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn)
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-   END SUBROUTINE agrif_trp_lim2_load
-
-
-   SUBROUTINE agrif_trp_lim2
-      !!-----------------------------------------------------------------------
-      !!                  *** ROUTINE agrif_trp_lim2 ***
-      !!
-      !!  ** Method  : time coefficient and call to atomic routines
-      !!-----------------------------------------------------------------------
-      INTEGER :: ji,jj,jn
-      REAL(wp) :: zalpha
-      !!-----------------------------------------------------------------------      
-      !
-      IF (Agrif_Root()) RETURN
-
-      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
-      !
-      tabice_agr(:,:,:) = 0.e0
-      DO jn =1,7
-         DO jj =1,2
-            DO ji = 1, jpi
-               tabice_agr(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
-               tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
-            END DO
-         END DO
-      END DO
-
-      DO jn =1,7
-         DO jj = 1, jpj
-            DO ji=1,2
-               tabice_agr(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
-               tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
-            END DO
-         END DO
-      END DO
-      !
-      CALL parcoursT( tabice_agr(:,:, 1), frld  )
-      CALL parcoursT( tabice_agr(:,:, 2), hicif )
-      CALL parcoursT( tabice_agr(:,:, 3), hsnif )
-      CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) )
-      CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) )
-      CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) )
-      CALL parcoursT( tabice_agr(:,:, 7), qstoif )
-      !
-   END SUBROUTINE agrif_trp_lim2
-
-
-   SUBROUTINE parcoursT ( pinterp, pfinal )
-      !!-----------------------------------------------------------------------
-      !!                    *** ROUTINE parcoursT ***
-      !!
-      !!  ** Method  : fill boundaries for T points
-      !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)    :: pinterp
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pfinal
-      !!
-      REAL(wp) :: zbound, zvbord
-      REAL(wp), DIMENSION(jpi,jpj) ::  zui_u, zvi_v
-      INTEGER :: ji, jj
-      !!-----------------------------------------------------------------------
-      !
-      zui_u = 0.e0
-      zvi_v = 0.e0
-      ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions.
-      zbound=0.
-      zvbord = 1.0 + ( 1.0 - zbound )
-#if defined key_lim2_vp
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            zui_u(ji,jj) = ( u_ice(ji+1,jj  ) + u_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj  ) + tmu(ji+1,jj+1), zvbord ) )
-            zvi_v(ji,jj) = ( v_ice(ji  ,jj+1) + v_ice(ji+1,jj+1) ) / ( MAX( tmu(ji  ,jj+1) + tmu(ji+1,jj+1), zvbord ) )
-         END DO
-      END DO
-#else
-      zui_u(:,:) = u_ice(:,:)
-      zvi_v(:,:) = v_ice(:,:)
-#endif
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            !            IF (zui_u(2,jj).EQ.0.) THEN
-            !               pfinal (2,jj) = pfinal (1,jj) * tms(2,jj)
-            !            ELSE
-            pfinal(2,jj) = 0.25* pinterp(1,jj) + 0.5 *  pinterp(2,jj) + 0.25 *pfinal(3,jj)
-            !            ENDIF
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            !            IF (zvi_v(ji,2).EQ.0.) THEN
-            !               pfinal (ji,2) = pfinal (ji,1) * tms(ji,2)
-            !            ELSE
-            pfinal(ji,2) = 0.25* pinterp(ji,1) + 0.5 *  pinterp(ji,2) + 0.25 *pfinal(ji,3)
-            !            ENDIF 
-         END DO
-      ENDIF
-
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            !            IF (zui_u(nlci-2,jj).EQ.0.) THEN
-            !               pfinal(nlci-1,jj) = pfinal (nlci,jj) * tms(nlci-1,jj)
-            !            ELSE
-            pfinal(nlci-1,jj) = 0.25* pinterp(nlci,jj) + 0.5 *  pinterp(nlci-1,jj) + 0.25 *pfinal(nlci-2,jj)
-            !           ENDIF
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            !            IF (zvi_v(ji,nlcj-2).EQ.0.) THEN
-            !               pfinal (ji,nlcj-1) =  pfinal(ji,nlcj) * tms(ji,nlcj-1)
-            !            ELSE
-            pfinal(ji,nlcj-1) = 0.25* pinterp(ji,nlcj) + 0.5 *  pinterp(ji,nlcj-1) + 0.25 *pfinal(ji,nlcj-2)
-            !            ENDIF
-         END DO
-      ENDIF
-
-
-      pfinal (:,:) = pfinal (:,:) * tms(:,:)
-      ! 
-   END SUBROUTINE parcoursT
-
-
-   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before )
-      !!-----------------------------------------------------------------------
-      !!                     *** ROUTINE interp_u_ice ***
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji,jj
-      !!-----------------------------------------------------------------------
-      !
-#if defined key_lim2_vp
-      IF( before ) THEN
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               IF( tmu(ji,jj) == 0. ) THEN
-                  tabres(ji,jj) = -9999.
-               ELSE
-                  tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ELSE
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               uice_agr(ji,jj) = tabres(ji,jj)
-            END DO
-         END DO
-      ENDIF
-#else
-      IF( before ) THEN
-         DO jj= j1, j2
-            DO ji= i1, i2
-               IF( umask(ji,jj,1) == 0. ) THEN
-                  tabres(ji,jj) = -9999.
-               ELSE
-                  tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ELSE
-         DO jj= j1, j2
-            DO ji= i1, i2
-               uice_agr(ji,jj) = tabres(ji,jj)
-            END DO
-         END DO
-      ENDIF
-#endif
-   END SUBROUTINE interp_u_ice
-
-
-   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before )
-      !!-----------------------------------------------------------------------
-      !!                    *** ROUTINE interp_v_ice ***
-      !!-----------------------------------------------------------------------      
-      INTEGER, INTENT(in) :: i1, i2, j1, j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji, jj
-      !!-----------------------------------------------------------------------
-      !
-#if defined key_lim2_vp
-      IF( before ) THEN
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               IF( tmu(ji,jj) == 0. ) THEN
-                  tabres(ji,jj) = -9999.
-               ELSE
-                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ELSE
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               vice_agr(ji,jj) = tabres(ji,jj)
-            END DO
-         END DO
-      ENDIF   
-#else
-      IF( before ) THEN
-	      DO jj= j1 ,j2
-	         DO ji = i1, i2
-	            IF( vmask(ji,jj,1) == 0. ) THEN
-	               tabres(ji,jj) = -9999.
-	            ELSE
-	               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
-	            ENDIF
-	         END DO
-	      END DO
-      ELSE
-	      DO jj= j1 ,j2
-	         DO ji = i1, i2
-	            vice_agr(ji,jj) = tabres(ji,jj)
-	         END DO
-	      END DO
-      ENDIF
-#endif
-   END SUBROUTINE interp_v_ice
-
-
-   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, k1, k2, before )
-      !!-----------------------------------------------------------------------
-      !!                    *** ROUTINE interp_adv_ice ***                           
-      !!
-      !! ** Purpose : fill an array with  ice variables
-      !!              to be advected
-      !!              put -9999 where no ice for correct extrapolation             
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji, jj, jk
-      !!-----------------------------------------------------------------------
-      !
-      IF( before ) THEN
-         DO jj=j1,j2
-	    DO ji=i1,i2
-	       IF( tms(ji,jj) == 0. ) THEN
-	          tabres(ji,jj,:) = -9999 
-	       ELSE
-	          tabres(ji,jj, 1) = frld  (ji,jj)
-	          tabres(ji,jj, 2) = hicif (ji,jj)
-	          tabres(ji,jj, 3) = hsnif (ji,jj)
-	          tabres(ji,jj, 4) = tbif  (ji,jj,1)
-	          tabres(ji,jj, 5) = tbif  (ji,jj,2)
-	          tabres(ji,jj, 6) = tbif  (ji,jj,3)
-	          tabres(ji,jj, 7) = qstoif(ji,jj)
-	       ENDIF
-	    END DO
-         END DO
-      ELSE
-	 DO jj=j1,j2
-	    DO ji=i1,i2
-               DO jk=k1, k2
-	          tabice_agr(ji,jj,jk) = tabres(ji,jj,jk)
-               END DO
-	    END DO
-	 END DO
-      ENDIF
-      !
-   END SUBROUTINE interp_adv_ice
-
-#else
-CONTAINS
-   SUBROUTINE agrif_lim2_interp_empty
-      !!---------------------------------------------
-      !!   *** ROUTINE agrif_lim2_interp_empty ***
-      !!---------------------------------------------
-      WRITE(*,*)  'agrif_lim2_interp : You should not have seen this print! error?'
-   END SUBROUTINE agrif_lim2_interp_empty
-#endif
-END MODULE agrif_lim2_interp
Index: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 8878)
+++ 	(revision )
@@ -1,264 +1,0 @@
-#define TWO_WAY
-
-MODULE agrif_lim2_update
-   !!======================================================================
-   !!                       ***  MODULE agrif_lim2_update ***
-   !! Nesting module :  update surface ocean boundary condition over ice
-   !!                   from a child grif
-   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
-   !!======================================================================
-   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
-   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
-   !!----------------------------------------------------------------------
-#if defined key_agrif && defined key_lim2
-   !!----------------------------------------------------------------------
-   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
-   !!   'key_agrif' :                                 AGRIF library 
-   !!----------------------------------------------------------------------
-   !!   agrif_update_lim2  : update sea-ice model on boundaries or total
-   !!                        sea-ice area for velocities and ice properties
-   !!   update_adv_ice     : sea-ice properties
-   !!   update_u_ice       : zonal ice velocity
-   !!   update_v_ice       : meridional ice velocity
-   !!----------------------------------------------------------------------
-   USE ice_2
-   USE dom_ice_2
-   USE sbc_oce
-   USE dom_oce
-   USE agrif_oce
-   USE agrif_ice 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC agrif_update_lim2
-
-   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.4 , LOCEAN-IPSL (2012)
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE agrif_update_lim2 ( kt )
-      !!----------------------------------------------------------------------
-      !!                     *** ROUTINE agrif_update_lim2 ***
-      !! ** Method  :   Call the hydrostaticupdate pressure at the boundary or
-      !!                the entire domain 
-      !!
-      !! ** Action : - Update (u_ice,v_ice) and ice tracers
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt
-      !!
-      !!----------------------------------------------------------------------
-      !
-      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
-
-      Agrif_UseSpecialValueInUpdate = .TRUE.
-      Agrif_SpecialValueFineGrid = 0.
-# if defined TWO_WAY
-      IF( MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
-         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
-      ELSE
-         CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
-         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
-      ENDIF
-# endif
-      !
-   END SUBROUTINE agrif_update_lim2
-
-
-   SUBROUTINE update_adv_ice( tabres, i1, i2, j1, j2, before )
-      !!-----------------------------------------------------------------------
-      !!                        *** ROUTINE update_adv_ice ***
-      !! ** Method  : Compute the mass properties on the fine grid and recover
-      !!              the properties per mass on the coarse grid
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji, jj
-      REAL(wp) :: zrhox, zrhoy
-      REAL(wp) :: z1_area
-      !!-----------------------------------------------------------------------
-      !
-      IF( before ) THEN
-         zrhox = Agrif_Rhox()
-         zrhoy = Agrif_Rhoy()
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres(ji,jj, 1) = frld  (ji,jj  ) * area(ji,jj)
-               tabres(ji,jj, 2) = hicif (ji,jj  ) * area(ji,jj)
-               tabres(ji,jj, 3) = hsnif (ji,jj  ) * area(ji,jj)
-               tabres(ji,jj, 4) = tbif  (ji,jj,1) * area(ji,jj)
-               tabres(ji,jj, 5) = tbif  (ji,jj,2) * area(ji,jj)
-               tabres(ji,jj, 6) = tbif  (ji,jj,3) * area(ji,jj)
-               tabres(ji,jj, 7) = qstoif(ji,jj  ) * area(ji,jj)
-            END DO
-         END DO
-         tabres = zrhox * zrhoy * tabres
-      ELSE
-         DO jj=j1,j2
-            DO ji=i1,i2
-               z1_area = 1. / area(ji,jj) * tms(ji,jj)
-               frld  (ji,jj)   = tabres(ji,jj, 1) * z1_area
-               hicif (ji,jj)   = tabres(ji,jj, 2) * z1_area
-               hsnif (ji,jj)   = tabres(ji,jj, 3) * z1_area
-               tbif  (ji,jj,1) = tabres(ji,jj, 4) * z1_area
-               tbif  (ji,jj,2) = tabres(ji,jj, 5) * z1_area
-               tbif  (ji,jj,3) = tabres(ji,jj, 6) * z1_area
-               qstoif(ji,jj)   = tabres(ji,jj, 7) * z1_area
-            END DO
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE update_adv_ice
-
-
-# if defined key_lim2_vp
-   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
-      !!-----------------------------------------------------------------------
-      !!                        *** ROUTINE update_u_ice ***
-      !! ** Method  : Update the fluxes and recover the properties (B-grid)
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji, jj
-      REAL(wp) :: zrhoy
-      !!-----------------------------------------------------------------------
-      !
-      IF( before ) THEN
-         zrhoy = Agrif_Rhoy()
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
-            END DO
-         END DO
-         tabres = zrhoy * tabres
-      ELSE
-         DO jj= MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               u_ice(ji,jj) = tabres(ji,jj) / (e2f(ji-1,jj-1))
-               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE update_u_ice
-
-
-   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
-      !!-----------------------------------------------------------------------
-      !!                    *** ROUTINE update_v_ice ***
-      !! ** Method  : Update the fluxes and recover the properties (B-grid)
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji, jj
-      REAL(wp) :: zrhox
-      !!-----------------------------------------------------------------------
-      !
-      IF( before ) THEN
-         zrhox = Agrif_Rhox()
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
-            END DO
-         END DO
-         tabres = zrhox * tabres
-      ELSE
-         DO jj=j1,j2
-            DO ji=i1,i2
-               v_ice(ji,jj) = tabres(ji,jj) / (e1f(ji-1,jj-1))
-               v_ice(ji,jj) = v_ice(ji,jj) * tmu(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE update_v_ice
-# else
-   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
-      !!-----------------------------------------------------------------------
-      !!                        *** ROUTINE update_u_ice ***
-      !! ** Method  : Update the fluxes and recover the properties (C-grid)
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji, jj
-      REAL(wp) :: zrhoy
-      !!-----------------------------------------------------------------------
-      !
-      IF( before ) THEN
-         zrhoy = Agrif_Rhoy()
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
-            END DO
-         END DO
-         tabres = zrhoy * tabres
-      ELSE
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               u_ice(ji,jj) = tabres(ji,jj) / (e2u(ji,jj))
-               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      ! 
-   END SUBROUTINE update_u_ice
-
-
-   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
-      !!-----------------------------------------------------------------------
-      !!                    *** ROUTINE update_v_ice ***
-      !! ** Method  : Update the fluxes and recover the properties (C-grid)
-      !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
-      INTEGER :: ji, jj
-      REAL(wp) :: zrhox
-      !!-----------------------------------------------------------------------
-      !
-      IF( before ) THEN
-         zrhox = Agrif_Rhox()
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
-            END DO
-         END DO
-         tabres = zrhox * tabres
-      ELSE
-         DO jj=j1,j2
-            DO ji=i1,i2
-               v_ice(ji,jj) = tabres(ji,jj) / (e1v(ji,jj))
-               v_ice(ji,jj) = v_ice(ji,jj) * tmv(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE update_v_ice
-# endif
-
-#else
-CONTAINS
-   SUBROUTINE agrif_lim2_update_empty
-      !!---------------------------------------------
-      !!   *** ROUTINE agrif_lim2_update_empty ***
-      !!---------------------------------------------
-      WRITE(*,*)  'agrif_lim2_update : You should not have seen this print! error?'
-   END SUBROUTINE agrif_lim2_update_empty
-#endif
-END MODULE agrif_lim2_update
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90	(revision 8879)
@@ -52,5 +52,5 @@
       !!-----------------------------------------------------------------------
       !
-      IF( Agrif_Root() )  RETURN
+      IF( Agrif_Root() .OR. nn_ice==0 )  RETURN   ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice
       !
       SELECT CASE(cd_type)
@@ -90,5 +90,5 @@
       !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
       !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
-      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------
       INTEGER , INTENT(in) :: i1, i2, j1, j2
@@ -101,8 +101,8 @@
       IF( before ) THEN  ! parent grid
          ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2)
-         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2) = Agrif_SpecialValue
       ELSE               ! child grid
          zrhoy = Agrif_Rhoy()
-         u_ice(i1:i2,j1:j2) = ptab(:,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
+         u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
       ENDIF
       !
@@ -116,5 +116,5 @@
       !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
       !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
-      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------      
       INTEGER , INTENT(in) :: i1, i2, j1, j2
@@ -127,8 +127,8 @@
       IF( before ) THEN  ! parent grid
          ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2)
-         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2) = Agrif_SpecialValue
       ELSE               ! child grid
          zrhox = Agrif_Rhox()
-         v_ice(i1:i2,j1:j2) = ptab(:,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
+         v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
       ENDIF
       !
@@ -142,5 +142,5 @@
       !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
       !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
-      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
@@ -158,14 +158,15 @@
       ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy
       ! and it is ok since we conserve tracers (same as in the ocean).
-      ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) )
+      ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) )
      
       IF( before ) THEN  ! parent grid
          jm = 1
          DO jl = 1, jpl
-            ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm  ) = a_i_b (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+1) = v_i_b (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+2) = v_s_b (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+3) = sv_i_b(i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+4) = oa_i_b(i1:i2,j1:j2,jl)
+            jm = jm + 5
             DO jk = 1, nlay_s
                ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
@@ -177,140 +178,173 @@
          
          DO jk = k1, k2
-            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = -9999.
+            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue
          ENDDO
          
       ELSE               ! child grid
-!! ==> The easiest interpolation is the following commented lines
-         jm = 1
-         DO jl = 1, jpl
-            a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            DO jk = 1, nlay_s
-               e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
-            DO jk = 1, nlay_i
-               e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
-         ENDDO
-
-!! ==> this is a more complex interpolation since we mix solutions over a couple of grid points
-!!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
-!!        clem: for some reason (I don't know why), the following lines do not work 
-!!              with mpp (or in realistic configurations?). It makes the model crash
-!         ! record ztab
-!         jm = 1
-!         DO jl = 1, jpl
-!            ztab(:,:,jm) = a_i  (:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = v_i  (:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = v_s  (:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1
-!            DO jk = 1, nlay_s
-!               ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1
-!            ENDDO
-!            DO jk = 1, nlay_i
-!               ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1
-!            ENDDO
-!         ENDDO
-!         !
-!         ! borders of the domain
-!         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
-!         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
-!         !
-!         ! spatial smoothing
-!         zrhox = Agrif_Rhox()
-!         z1 =      ( zrhox - 1. ) * 0.5 
-!         z3 =      ( zrhox - 1. ) / ( zrhox + 1. )
-!         z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-!         z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-!         z2 = 1. - z1
-!         z4 = 1. - z3
-!         z5 = 1. - z6 - z7
-!         !
-!         ! Remove corners
-!         imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2
-!         IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3
-!         IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2
-!         IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3
-!         IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2
-!
-!         ! smoothed fields
-!         IF( eastern_side ) THEN
-!            ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:)
-!            DO jj = jmin, jmax
-!               rswitch = 0.
-!               IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1.
-!               ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  &
-!                  &                +      umask(nlci-2,jj,1)   *  &
-!                  &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  &
-!                  &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) )
-!               ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1)
-!            END DO
-!         ENDIF
-!         ! 
-!         IF( northern_side ) THEN
-!            ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:)
-!            DO ji = imin, imax
-!               rswitch = 0.
-!               IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1.
-!               ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  &
-!                  &                +      vmask(ji,nlcj-2,1)   *  &
-!                  &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) &
-!                  &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) )
-!               ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1)
-!            END DO
-!         END IF
-!         !
-!         IF( western_side) THEN
-!            ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
-!            DO jj = jmin, jmax
-!               rswitch = 0.
-!               IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
-!               ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  &
-!                  &           +      umask(2,jj,1)   *   &
-!                  &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
-!                  &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
-!               ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
-!            END DO
-!         ENDIF
-!         !
-!         IF( southern_side ) THEN
-!            ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
-!            DO ji = imin, imax
-!               rswitch = 0.
-!               IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
-!               ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  &
-!                  &           +      vmask(ji,2,1)   *  &
-!                  &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
-!                  &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
-!               ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
-!            END DO
-!         END IF
-!         !
-!         ! Treatment of corners
-!         IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south
-!         IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north
-!         IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south
-!         IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north
-!
-!         ! retrieve ice tracers
-!         jm = 1
-!         DO jl = 1, jpl
-!            a_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            v_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            v_s  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            DO jk = 1, nlay_s
-!               e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            ENDDO
-!            DO jk = 1, nlay_i
-!               e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            ENDDO
-!         ENDDO
-       
+
+         IF( nbghostcells > 1 ) THEN
+            !! ==> The easiest interpolation is the following lines
+
+            jm = 1
+            DO jl = 1, jpl
+               !
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
+                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
+                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
+                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
+                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
+                  ENDDO
+               ENDDO
+               jm = jm + 5
+               !
+               DO jk = 1, nlay_s
+                  e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+               DO jk = 1, nlay_i
+                  e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+            ENDDO
+            
+         ELSE
+            !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points
+            !!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
+            !!        clem: for some reason (I don't know why), the following lines do not work 
+            !!              with mpp (or in realistic configurations?). It makes the model crash
+            !      I think there is an issue with Agrif_SpecialValue here (not taken into account properly)
+            ! record ztab
+            jm = 1
+            DO jl = 1, jpl
+               ztab(:,:,jm  ) = a_i  (:,:,jl)
+               ztab(:,:,jm+1) = v_i  (:,:,jl)
+               ztab(:,:,jm+2) = v_s  (:,:,jl)
+               ztab(:,:,jm+3) = sv_i(:,:,jl)
+               ztab(:,:,jm+4) = oa_i(:,:,jl)
+               jm = jm + 5
+               DO jk = 1, nlay_s
+                  ztab(:,:,jm) = e_s(:,:,jk,jl)
+                  jm = jm + 1
+               ENDDO
+               DO jk = 1, nlay_i
+                  ztab(:,:,jm) = e_i(:,:,jk,jl)
+                  jm = jm + 1
+               ENDDO
+               !
+            ENDDO
+            !
+            ! borders of the domain
+            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
+            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
+            !
+            ! spatial smoothing
+            zrhox = Agrif_Rhox()
+            z1 =      ( zrhox - 1. ) * 0.5 
+            z3 =      ( zrhox - 1. ) / ( zrhox + 1. )
+            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+            z2 = 1. - z1
+            z4 = 1. - z3
+            z5 = 1. - z6 - z7
+            !
+            ! Remove corners
+            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2
+            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3
+            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2
+            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3
+            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2
+
+            ! smoothed fields
+            IF( eastern_side ) THEN
+               ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:)
+               DO jj = jmin, jmax
+                  rswitch = 0.
+                  IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1.
+                  ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  &
+                     &                +      umask(nlci-2,jj,1)   *  &
+                     &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  &
+                     &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) )
+                  ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1)
+               END DO
+            ENDIF
+            ! 
+            IF( northern_side ) THEN
+               ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:)
+               DO ji = imin, imax
+                  rswitch = 0.
+                  IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1.
+                  ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  &
+                     &                +      vmask(ji,nlcj-2,1)   *  &
+                     &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) &
+                     &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) )
+                  ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1)
+               END DO
+            END IF
+            !
+            IF( western_side) THEN
+               ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
+               DO jj = jmin, jmax
+                  rswitch = 0.
+                  IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
+                  ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  &
+                     &           +      umask(2,jj,1)   *   &
+                     &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
+                     &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
+                  ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
+               END DO
+            ENDIF
+            !
+            IF( southern_side ) THEN
+               ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
+               DO ji = imin, imax
+                  rswitch = 0.
+                  IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
+                  ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  &
+                     &           +      vmask(ji,2,1)   *  &
+                     &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
+                     &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
+                  ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
+               END DO
+            END IF
+            !
+            ! Treatment of corners
+            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south
+            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north
+            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south
+            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north
+            
+            ! retrieve ice tracers
+            jm = 1
+            DO jl = 1, jpl
+               !
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     a_i (ji,jj,jl) = ztab(ji,jj,jm  ) * tmask(ji,jj,1)
+                     v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1)
+                     v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1)
+                     sv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1)
+                     oa_i (ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1)
+                  ENDDO
+               ENDDO
+               jm = jm + 5
+               !
+               DO jk = 1, nlay_s
+                  e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+               DO jk = 1, nlay_i
+                  e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+            ENDDO
+          
+         ENDIF  ! nbghostcells=1
+         
          ! integrated values
          vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
@@ -319,8 +353,9 @@
          et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
          et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
-
+         
       ENDIF
+
+      DEALLOCATE( ztab )
       
-      DEALLOCATE( ztab )
       !
    END SUBROUTINE interp_tra_ice
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90	(revision 8879)
@@ -56,6 +56,8 @@
       IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement
                                                                                                                            ! i.e. update only at the parent time step
+      IF( nn_ice == 0 ) RETURN   ! clem2017: do not update if child domain does not have ice
+      !
+      Agrif_SpecialValueFineGrid = -9999.
       Agrif_UseSpecialValueInUpdate = .TRUE.
-      Agrif_SpecialValueFineGrid = -9999.
 # if defined TWO_WAY
       IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps
@@ -70,4 +72,5 @@
       ENDIF
 # endif
+      Agrif_SpecialValueFineGrid = 0.
       Agrif_UseSpecialValueInUpdate = .FALSE.
       !
@@ -88,5 +91,5 @@
       LOGICAL , INTENT(in) :: before
       !!
-      INTEGER  :: jk, jl, jm
+      INTEGER  :: ji, jj, jk, jl, jm
       !!-----------------------------------------------------------------------
       ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
@@ -94,37 +97,56 @@
          jm = 1
          DO jl = 1, jpl
-            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm  ) = a_i (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl)
+            jm = jm + 5
             DO jk = 1, nlay_s
-               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
             DO jk = 1, nlay_i
-               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
          ENDDO
-
+         !
          DO jk = k1, k2
-            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999.
+            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 
          ENDDO
-                  
+         !
       ELSE
+         !
          jm = 1
          DO jl = 1, jpl
-            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            !
+            DO jj = j1, j2
+               DO ji = i1, i2
+                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN
+                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
+                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
+                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
+                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
+                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
+                  ENDIF
+               ENDDO
+            ENDDO
+            jm = jm + 5
+            !
             DO jk = 1, nlay_s
-               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
+               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
+                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+               ENDWHERE
+               jm = jm + 1
+            ENDDO
+            !
             DO jk = 1, nlay_i
-               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
+               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
+                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+               ENDWHERE
+               jm = jm + 1
+            ENDDO
+            !
          ENDDO
-
+         !
          ! integrated values
          vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
@@ -154,7 +176,9 @@
          zrhoy = Agrif_Rhoy()
          ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
-         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid
       ELSE
-         u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
+         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
+            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
+         ENDWHERE
       ENDIF
       ! 
@@ -177,7 +201,9 @@
          zrhox = Agrif_Rhox()
          ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
-         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid
       ELSE
-         v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
+         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
+            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
+         ENDWHERE
       ENDIF
       !
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 8879)
@@ -35,5 +35,5 @@
    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
    PUBLIC   interpun, interpvn
-   PUBLIC   interptsn,  interpsshn
+   PUBLIC   interptsn, interpsshn
    PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
    PUBLIC   interpe3t, interpumsk, interpvmsk
@@ -100,277 +100,287 @@
       IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2
 
+      ! --- West --- !
       IF( nbondi == -1 .OR. nbondi == 2 ) THEN
          !
-         ! Smoothing
-         ! ---------
          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            ua_b(2,:) = 0._wp
+            ua_b(2:1+nbghostcells,:) = 0._wp
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+                  ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2:1+nbghostcells,jj,jk)
                END DO
             END DO
             DO jj = 1, jpj
-               ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)            
-            END DO
-         ENDIF
-         !
-         DO jk=1,jpkm1                 ! Smooth
-            DO jj=j1,j2
-               ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
-               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
-            END DO
-         END DO
-         !
-         zub(2,:) = 0._wp              ! Correct transport
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
-            END DO
-         END DO
-         DO jj=1,jpj
-            zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj)
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk)
-            END DO
-         END DO
-
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zvb(2,:) = 0._wp
+               ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj)
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk=1,jpkm1                 ! Smooth
+               DO jj=j1,j2
+                  ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
+                  ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
+               END DO
+            END DO
+            !
+            zub(2,:) = 0._wp              ! Correct transport
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk)
-               END DO
-            END DO
-            DO jj = 1, jpj
-               zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj)
-            END DO
+                  zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj)
+            END DO
+            
+            DO jk=1,jpkm1
+               DO jj=1,jpj
+                  ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk)
+               END DO
+            END DO
+            
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zvb(2,:) = 0._wp
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk)
+                  END DO
+               END DO
+               DO jj = 1, jpj
+                  zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj)
+               END DO
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
+         !
+         ! Mask domain edges:
+         !-------------------
+!         DO jk = 1, jpkm1
+!            DO jj = 1, jpj
+!               ua(1,jj,jk) = 0._wp
+!               va(1,jj,jk) = 0._wp
+!            END DO
+!         END DO
+         !
+      ENDIF
+
+      ! --- East --- !
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp
+            DO jk=1,jpkm1
+               DO jj=1,jpj
+                  ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk)  &
+                     &                                                                         * ua(nlci-nbghostcells-1:nlci-2,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj) 
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk = 1, jpkm1              ! Smooth
+               DO jj = j1, j2
+                  ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
+                     &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
+               END DO
+            END DO
+            
+            zub(nlci-2,:) = 0._wp        ! Correct transport
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk)
-               END DO
-            END DO
+                  zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
+               END DO
+            END DO
+            DO jj = 1, jpj
+               zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj)
+            END DO
+            
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk)
+               END DO
+            END DO
+            !
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zvb(nlci-1,:) = 0._wp
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk)
+                  END DO
+               END DO
+               DO jj=1,jpj
+                  zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj)
+               END DO
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
          ENDIF
          !
          ! Mask domain edges:
          !-------------------
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               ua(1,jj,jk) = 0._wp
-               va(1,jj,jk) = 0._wp
-            END DO
-         END DO         
-         !
-      ENDIF
-
-      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
-
-         ! Smoothing
-         ! ---------
+!         DO jk = 1, jpkm1
+!            DO jj = 1, jpj
+!               ua(nlci-1,jj,jk) = 0._wp
+!               va(nlci  ,jj,jk) = 0._wp
+!            END DO
+!         END DO
+         !
+      ENDIF
+
+      ! --- South --- !
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+
          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            ua_b(nlci-2,:) = 0._wp
+            va_b(:,2:nbghostcells+1) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk)
+               END DO
+            END DO
+            DO ji=1,jpi
+               va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1)
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk = 1, jpkm1              ! Smooth
+               DO ji = i1, i2
+                  va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
+                     &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
+               END DO
+            END DO
+            !
+            zvb(:,2) = 0._wp              ! Correct transport
             DO jk=1,jpkm1
-               DO jj=1,jpj
-                  ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
-               END DO
-            END DO
-            DO jj=1,jpj
-               ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)            
-            END DO
-         ENDIF
-
-         DO jk = 1, jpkm1              ! Smooth
-            DO jj = j1, j2
-               ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
-                  &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
-            END DO
-         END DO
-
-         zub(nlci-2,:) = 0._wp        ! Correct transport
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
-            END DO
-         END DO
-         DO jj = 1, jpj
-            zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj)
-         END DO
-
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk)
-            END DO
-         END DO
-         !
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zvb(nlci-1,:) = 0._wp
+               DO ji=1,jpi
+                  zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2)
+            END DO
             DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk)
-               END DO
-            END DO
-            DO jj=1,jpj
-               zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj)
-            END DO
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk)
-               END DO
-            END DO
+               DO ji = 1, jpi
+                  va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk)
+               END DO
+            END DO
+            
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zub(:,2) = 0._wp
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)
+                  END DO
+               END DO
+               DO ji = 1, jpi
+                  zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2)
+               END DO
+               
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
          ENDIF
          !
          ! Mask domain edges:
          !-------------------
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               ua(nlci-1,jj,jk) = 0._wp
-               va(nlci  ,jj,jk) = 0._wp
-            END DO
-         END DO 
-         !
-      ENDIF
-
-      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
-
-         ! Smoothing
-         ! ---------
+!         DO jk = 1, jpkm1
+!            DO ji = 1, jpi
+!               ua(ji,1,jk) = 0._wp
+!               va(ji,1,jk) = 0._wp
+!            END DO
+!         END DO
+         !
+      ENDIF
+
+      ! --- North --- !
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+         !
          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            va_b(:,2) = 0._wp
+            va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)
-               END DO
-            END DO
-            DO ji=1,jpi
-               va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)            
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Smooth
-            DO ji = i1, i2
-               va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
-                  &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
-            END DO
-         END DO
-         !
-         zvb(:,2) = 0._wp              ! Correct transport
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk)
-            END DO
-         END DO
-         DO ji = 1, jpi
-            zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2)
-         END DO
-         DO jk = 1, jpkm1
+                  va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk)  &
+                     &                                                                         * va(ji,nlcj-nbghostcells-1:nlcj-2,jk)
+               END DO
+            END DO
             DO ji = 1, jpi
-               va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk)
-            END DO
-         END DO
-
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zub(:,2) = 0._wp
+               va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2)
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk = 1, jpkm1              ! Smooth
+               DO ji = i1, i2
+                  va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
+                     &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
+               END DO
+            END DO
+            !
+            zvb(:,nlcj-2) = 0._wp         ! Correct transport
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)
+                  zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
                END DO
             END DO
             DO ji = 1, jpi
-               zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2)
-            END DO
-
+               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
+            END DO
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk)
-               END DO
-            END DO
-         ENDIF
-
+                  va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk)
+               END DO
+            END DO
+            !
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zub(:,nlcj-1) = 0._wp
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk)
+                  END DO
+               END DO
+               DO ji = 1, jpi
+                  zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1)
+               END DO
+               !
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
+         !
          ! Mask domain edges:
          !-------------------
-         DO jk = 1, jpkm1
-            DO ji = 1, jpi
-               ua(ji,1,jk) = 0._wp
-               va(ji,1,jk) = 0._wp
-            END DO
-         END DO 
-
-      ENDIF
-
-      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
-         !
-         ! Smoothing
-         ! ---------
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            va_b(:,nlcj-2) = 0._wp
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)
-               END DO
-            END DO
-            DO ji = 1, jpi
-               va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)            
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Smooth
-            DO ji = i1, i2
-               va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
-                  &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
-            END DO
-         END DO
-         !
-         zvb(:,nlcj-2) = 0._wp         ! Correct transport
-         DO jk = 1, jpkm1
-            DO ji = 1, jpi
-               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
-            END DO
-         END DO
-         DO ji = 1, jpi
-            zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
-         END DO
-         DO jk = 1, jpkm1
-            DO ji = 1, jpi
-               va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk)
-            END DO
-         END DO
-         !
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zub(:,nlcj-1) = 0._wp
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk)
-               END DO
-            END DO
-            DO ji = 1, jpi
-               zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1)
-            END DO
-            !
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Mask domain edges:
-         !-------------------
-         DO jk = 1, jpkm1
-            DO ji = 1, jpi
-               ua(ji,nlcj  ,jk) = 0._wp
-               va(ji,nlcj-1,jk) = 0._wp
-            END DO
-         END DO 
+!         DO jk = 1, jpkm1
+!            DO ji = 1, jpi
+!               ua(ji,nlcj  ,jk) = 0._wp
+!               va(ji,nlcj-1,jk) = 0._wp
+!            END DO
+!         END DO
          !
       ENDIF
@@ -392,11 +402,11 @@
       !
       IF( Agrif_Root() )   RETURN
-      !
+      !! clem ghost
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
          DO jj=1,jpj
-            va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
+            va_e(2:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(2:nbghostcells+1,jj)
             ! Specified fluxes:
-            ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
-            ! Characteristics method:
+            ua_e(2:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(2:nbghostcells+1,jj)
+            ! Characteristics method (only if ghostcells=1):
             !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
             !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
@@ -406,8 +416,8 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
          DO jj=1,jpj
-            va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
+            va_e(nlci-nbghostcells:nlci-1,jj)   = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci-1,jj)
             ! Specified fluxes:
-            ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
-            ! Characteristics method:
+            ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj)
+            ! Characteristics method (only if ghostcells=1):
             !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
             !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
@@ -417,8 +427,8 @@
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
          DO ji=1,jpi
-            ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
+            ua_e(ji,2:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,2:nbghostcells+1)
             ! Specified fluxes:
-            va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
-            ! Characteristics method:
+            va_e(ji,2:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,2:nbghostcells+1)
+            ! Characteristics method (only if ghostcells=1):
             !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
             !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
@@ -428,8 +438,8 @@
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
          DO ji=1,jpi
-            ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
+            ua_e(ji,nlcj-nbghostcells:nlcj-1)   = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj-1)
             ! Specified fluxes:
-            va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
-            ! Characteristics method:
+            va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2)
+            ! Characteristics method (only if ghostcells=1):
             !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
             !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
@@ -476,5 +486,5 @@
       !
       IF( ll_int_cons ) THEN  ! Conservative interpolation
-         ! orders matters here !!!!!!
+         ! order matters here !!!!!!
          CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
          CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )
@@ -504,27 +514,52 @@
       !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) ::   kt
-      !!
+      !
+      INTEGER  :: ji, jj, indx
       !!----------------------------------------------------------------------  
       !
       IF( Agrif_Root() )   RETURN
-      !
+      !! clem ghost
+      ! --- West --- !
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         ssha(2,:)=ssha(3,:)
-         sshn(2,:)=sshn(3,:)
-      ENDIF
-      !
+         indx = 1+nbghostcells
+         DO jj = 1, jpj
+            DO ji = 2, indx
+               ssha(ji,jj)=ssha(indx+1,jj)
+               sshn(ji,jj)=sshn(indx+1,jj)
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      ! --- East --- !
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         ssha(nlci-1,:)=ssha(nlci-2,:)
-         sshn(nlci-1,:)=sshn(nlci-2,:)
-      ENDIF
-      !
+         indx = nlci-nbghostcells
+         DO jj = 1, jpj
+            DO ji = indx, nlci-1
+               ssha(ji,jj)=ssha(indx-1,jj)
+               sshn(ji,jj)=sshn(indx-1,jj)
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      ! --- South --- !
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         ssha(:,2)=ssha(:,3)
-         sshn(:,2)=sshn(:,3)
-      ENDIF
-      !
+         indx = 1+nbghostcells
+         DO jj = 2, indx
+            DO ji = 1, jpi
+               ssha(ji,jj)=ssha(ji,indx+1)
+               sshn(ji,jj)=sshn(ji,indx+1)
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      ! --- North --- !
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         ssha(:,nlcj-1)=ssha(:,nlcj-2)
-         sshn(:,nlcj-1)=sshn(:,nlcj-2)
+         indx = nlcj-nbghostcells
+         DO jj = indx, nlcj-1
+            DO ji = 1, jpi
+               ssha(ji,jj)=ssha(ji,indx-1)
+               sshn(ji,jj)=sshn(ji,indx-1)
+            ENDDO
+         ENDDO
       ENDIF
       !
@@ -538,10 +573,10 @@
       INTEGER, INTENT(in) ::   jn
       !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-      !
+      INTEGER :: ji, jj
+      !!----------------------------------------------------------------------  
+      !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2)
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
          DO jj = 1, jpj
-            ssha_e(2,jj) = hbdy_w(jj)
+            ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj)
          END DO
       ENDIF
@@ -549,5 +584,5 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
          DO jj = 1, jpj
-            ssha_e(nlci-1,jj) = hbdy_e(jj)
+            ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj)
          END DO
       ENDIF
@@ -555,5 +590,5 @@
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
          DO ji = 1, jpi
-            ssha_e(ji,2) = hbdy_s(ji)
+            ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji)
          END DO
       ENDIF
@@ -561,5 +596,5 @@
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
          DO ji = 1, jpi
-            ssha_e(ji,nlcj-1) = hbdy_n(ji)
+            ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji)
          END DO
       ENDIF
@@ -601,6 +636,5 @@
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::   imin, imax, jmin, jmax
-      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
-      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7
       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------
@@ -610,129 +644,115 @@
       ELSE
          !
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !
-         zrhox = Agrif_Rhox()
-         ! 
-         zalpha1 = ( zrhox - 1. ) * 0.5
-         zalpha2 = 1. - zalpha1
-         ! 
-         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha4 = 1. - zalpha3
-         ! 
-         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-         zalpha5 = 1. - zalpha6 - zalpha7
-         !
-         imin = i1
-         imax = i2
-         jmin = j1
-         jmax = j2
-         ! 
-         ! Remove CORNERS
-         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
-         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
-         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
-         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
-         !
-         IF( eastern_side ) THEN
-            DO jn = 1, jpts
-               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(nlci-2,jj,jk) == 0._wp ) THEN
-                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                     ELSE
-                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                        IF( un(nlci-2,jj,jk) > 0._wp ) THEN
-                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 
-                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         IF( nbghostcells > 1 ) THEN  ! no smoothing
+            tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2)
+         ELSE                         ! smoothing
+            !
+            zrhox = Agrif_Rhox()
+            z1 = ( zrhox - 1. ) * 0.5
+            z3 = ( zrhox - 1. ) / ( zrhox + 1. )
+            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+            !
+            z2 = 1. - z1
+            z4 = 1. - z3
+            z5 = 1. - z6 - z7
+            !
+            imin = i1 ; imax = i2
+            jmin = j1 ; jmax = j2
+            ! 
+            ! Remove CORNERS
+            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+            !
+            IF( eastern_side ) THEN
+               DO jn = 1, jpts
+                  tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(nlci-2,jj,jk) == 0._wp ) THEN
+                           tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                        ELSE
+                           tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                           IF( un(nlci-2,jj,jk) > 0._wp ) THEN
+                              tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) & 
+                                                   + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(nlci,j1:j2,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         ! 
-         IF( northern_side ) THEN            
-            DO jn = 1, jpts
-               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO ji = imin,imax
-                     IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN
-                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                     ELSE
-                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                        IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN
-                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  &
-                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                  tsa(nlci,j1:j2,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            ! 
+            IF( northern_side ) THEN            
+               DO jn = 1, jpts
+                  tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO ji = imin,imax
+                        IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN
+                           tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                        ELSE
+                           tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                           IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN
+                              tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn)  &
+                                                   + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         !
-         IF( western_side ) THEN            
-            DO jn = 1, jpts
-               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(2,jj,jk) == 0._wp ) THEN
-                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
-                     ELSE
-                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
-                        IF( un(2,jj,jk) < 0._wp ) THEN
-                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                  tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            !
+            IF( western_side ) THEN            
+               DO jn = 1, jpts
+                  tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(2,jj,jk) == 0._wp ) THEN
+                           tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                        ELSE
+                           tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                           IF( un(2,jj,jk) < 0._wp ) THEN
+                              tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(1,j1:j2,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         !
-         IF( southern_side ) THEN           
-            DO jn = 1, jpts
-               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
-               DO jk = 1, jpk      
-                  DO ji=imin,imax
-                     IF( vmask(ji,2,jk) == 0._wp ) THEN
-                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
-                     ELSE
-                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
-                        IF( vn(ji,2,jk) < 0._wp ) THEN
-                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                  tsa(1,j1:j2,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            !
+            IF( southern_side ) THEN           
+               DO jn = 1, jpts
+                  tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn)
+                  DO jk = 1, jpk      
+                     DO ji=imin,imax
+                        IF( vmask(ji,2,jk) == 0._wp ) THEN
+                           tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                        ELSE
+                           tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                           IF( vn(ji,2,jk) < 0._wp ) THEN
+                              tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(i1:i2,1,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         !
-         ! Treatment of corners
-         ! 
-         ! East south
-         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
-         ENDIF
-         ! East north
-         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
-         ENDIF
-         ! West south
-         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tsa(2,2,:,:) = ptab(2,2,:,:)
-         ENDIF
-         ! West north
-         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
-         ENDIF
-         !
+                  tsa(i1:i2,1,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            !
+            ! Treatment of corners
+            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south
+            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north
+            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(2,2,:,:) = ptab(2,2,:,:)                      ! West south
+            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north
+            !
+         ENDIF
       ENDIF
       !
@@ -759,7 +779,8 @@
          southern_side = (nb == 2).AND.(ndir == 1)
          northern_side = (nb == 2).AND.(ndir == 2)
-         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
-         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
-         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+         !! clem ghost
+         IF(western_side)  hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1)
+         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1
+         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1
          IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
       ENDIF
@@ -854,36 +875,19 @@
          ELSEIF( bdy_tinterp == 2 ) THEN
             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-               &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
-
+               &               - zt0        * (       zt0 - 1._wp)**2._wp )
          ELSE
             ztcoeff = 1
          ENDIF
-         !   
-         IF(western_side) THEN
-            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(eastern_side) THEN
-            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(southern_side) THEN
-            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
-         IF(northern_side) THEN
-            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
+         !! clem ghost   
+         IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)  
+         IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1
+         IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
          !            
          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side) THEN
-               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
-            ENDIF
-            IF(eastern_side) THEN
-               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
-            ENDIF
-            IF(southern_side) THEN
-               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
-            ENDIF
-            IF(northern_side) THEN
-               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
-            ENDIF
+            IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1)
+            IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
+            IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1)
+            IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
          ENDIF
       ENDIF
@@ -927,35 +931,15 @@
             ztcoeff = 1
          ENDIF
-         !
-         IF(western_side) THEN
-            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(eastern_side) THEN
-            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(southern_side) THEN
-            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
-         ENDIF
-         IF(northern_side) THEN
-            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
+         !! clem ghost
+         IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)  
+         IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1
+         IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
          !            
          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side) THEN
-               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
-                     &                                  * vmask(i1,j1:j2,1)
-            ENDIF
-            IF(eastern_side) THEN
-               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
-                     &                                  * vmask(i1,j1:j2,1)
-            ENDIF
-            IF(southern_side) THEN
-               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
-                     &                                  * vmask(i1:i2,j1,1)
-            ENDIF
-            IF(northern_side) THEN
-               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
-                     &                                  * vmask(i1:i2,j1,1)
-            ENDIF
+            IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1)
+            IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1)
+            IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1)
+            IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1)
          ENDIF
       ENDIF
@@ -991,8 +975,8 @@
          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    &
             &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
-         ! 
-         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         !! clem ghost
+         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2)  
+         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1
          IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
       ENDIF
@@ -1030,7 +1014,7 @@
             &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
          !
-         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i2,j1:j2)  
+         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 
          IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
       ENDIF
@@ -1050,5 +1034,4 @@
       INTEGER :: ji, jj, jk
       LOGICAL :: western_side, eastern_side, northern_side, southern_side
-      REAL(wp) :: ztmpmsk      
       !!----------------------------------------------------------------------  
       !    
@@ -1060,15 +1043,10 @@
          southern_side = (nb == 2).AND.(ndir == 1)
          northern_side = (nb == 2).AND.(ndir == 2)
-
+         !
          DO jk = k1, k2
             DO jj = j1, j2
                DO ji = i1, i2
-                  ! Get velocity mask at boundary edge points:
-                  IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1)
-                  IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1)
-                  IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1)
-                  IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1)
                   !
-                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN
+                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN
                      IF (western_side) THEN
                         WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 8879)
@@ -34,9 +34,9 @@
       !!   *** ROUTINE Agrif_Sponge_Tra ***
       !!---------------------------------------------
-      REAL(wp) :: timecoeff
+      REAL(wp) :: zcoef
       !!---------------------------------------------
       !
 #if defined SPONGE
-      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       CALL Agrif_Sponge
@@ -45,5 +45,5 @@
       tabspongedone_tsn = .FALSE.
 
-      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge)
 
       Agrif_UseSpecialValue = .FALSE.
@@ -57,9 +57,9 @@
       !!   *** ROUTINE Agrif_Sponge_dyn ***
       !!---------------------------------------------
-      REAL(wp) :: timecoeff
+      REAL(wp) :: zcoef
       !!---------------------------------------------
 
 #if defined SPONGE
-      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       Agrif_SpecialValue=0.
@@ -68,9 +68,9 @@
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.         
-      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
+      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge)
 
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.
-      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
+      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge)
 
       Agrif_UseSpecialValue = .FALSE.
@@ -84,67 +84,62 @@
       !!   *** ROUTINE  Agrif_Sponge ***
       !!---------------------------------------------
-      INTEGER  :: ji,jj,jk
-      INTEGER  :: ispongearea, ilci, ilcj
-      LOGICAL  :: ll_spdone
-      REAL(wp) :: z1spongearea, zramp
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp
+      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
+      !
+      INTEGER  :: ji, jj, ind1, ind2
+      INTEGER  :: ispongearea
+      REAL(wp) :: z1_spongearea
+      !!---------------------------------------------
 
 #if defined SPONGE || defined SPONGE_TOP
-      ll_spdone=.TRUE.
       IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN
-         ! Define ramp from boundaries towards domain interior
-         ! at T-points
+         ! Define ramp from boundaries towards domain interior at T-points
          ! Store it in ztabramp
-         ll_spdone=.FALSE.
-
-         CALL wrk_alloc( jpi, jpj, ztabramp )
 
          ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
-         ilci = nlci - ispongearea
-         ilcj = nlcj - ispongearea 
-         z1spongearea = 1._wp / REAL( ispongearea - 2 )
-
+         z1_spongearea = 1._wp / REAL( ispongearea - 1 )
+         
          ztabramp(:,:) = 0._wp
 
+         ! --- West --- !
          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + (ispongearea-1)
             DO jj = 1, jpj
-               IF ( umask(2,jj,1) == 1._wp ) THEN
-                 DO ji = 2, ispongearea                  
-                    ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea
-                 END DO
-               ENDIF
+               DO ji = ind1, ind2                  
+                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
+               END DO
             ENDDO
          ENDIF
 
+         ! --- East --- !
          IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            ind1 = nlci - (1+nbghostcells) - (ispongearea-1)
+            ind2 = nlci - (1+nbghostcells)
             DO jj = 1, jpj
-               IF ( umask(nlci-2,jj,1) == 1._wp ) THEN
-                  DO ji = ilci+1,nlci-1
-                     zramp = (ji - (ilci+1) ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  ENDDO
-               ENDIF
+               DO ji = ind1, ind2
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) )
+               ENDDO
             ENDDO
          ENDIF
 
+         ! --- South --- !
          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            DO ji = 1, jpi
-               IF ( vmask(ji,2,1) == 1._wp ) THEN
-                  DO jj = 2, ispongearea
-                     zramp = ( ispongearea-jj ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  END DO
-               ENDIF
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + (ispongearea-1)
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
+               END DO
             ENDDO
          ENDIF
 
+         ! --- North --- !
          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            DO ji = 1, jpi
-               IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN
-                  DO jj = ilcj+1,nlcj-1
-                     zramp = (jj - (ilcj+1) ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  END DO
-               ENDIF
+            ind1 = nlcj - (1+nbghostcells) - (ispongearea-1)
+            ind2 = nlcj - (1+nbghostcells)
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) )
+               END DO
             ENDDO
          ENDIF
@@ -158,11 +153,11 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! vector opt.
-               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  ))
-               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1))
-            END DO
-         END DO
-
+               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
+               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) )
+            END DO
+         END DO
          CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( fsaht_spv, 'V', 1. )
+         
          spongedoneT = .TRUE.
       ENDIF
@@ -179,11 +174,9 @@
             END DO
          END DO
-
          CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( fsahm_spf, 'F', 1. )
+         
          spongedoneU = .TRUE.
       ENDIF
-      !
-      IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )
       !
 #endif
@@ -205,4 +198,5 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
+      !!---------------------------------------------    
       !
       IF( before ) THEN
@@ -327,5 +321,5 @@
 
          jmax = j2-1
-         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
+         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North
 
          DO jj = j1+1, jmax
@@ -404,5 +398,5 @@
 
          imax = i2-1
-         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3)
+         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East
 
          DO jj = j1+1, j2
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 8879)
@@ -50,134 +50,120 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER :: imin, imax, jmin, jmax
-      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
-      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-
+      INTEGER  ::   imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!-----------------------------------------------------------------------
+      !
       IF (before) THEN         
          ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
       ELSE
          !
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !
-         zrhox = Agrif_Rhox()
-         ! 
-         zalpha1 = ( zrhox - 1. ) * 0.5
-         zalpha2 = 1. - zalpha1
-         ! 
-         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha4 = 1. - zalpha3
-         ! 
-         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-         zalpha5 = 1. - zalpha6 - zalpha7
-         !
-         imin = i1
-         imax = i2
-         jmin = j1
-         jmax = j2
-         ! 
-         ! Remove CORNERS
-         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
-         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
-         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
-         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
-         !
-         IF( eastern_side) THEN
-            DO jn = 1, jptra
-               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                     ELSE
-                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 
-                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+         IF( nbghostcells > 1 ) THEN  ! no smoothing
+            tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2)
+         ELSE                         ! smoothing
+            !
+            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
+            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
+            !
+            zrhox = Agrif_Rhox()
+            z1 = ( zrhox - 1. ) * 0.5
+            z3 = ( zrhox - 1. ) / ( zrhox + 1. )
+            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+            !
+            z2 = 1. - z1
+            z4 = 1. - z3
+            z5 = 1. - z6 - z7
+            !
+            imin = i1 ; imax = i2
+            jmin = j1 ; jmax = j2
+            ! 
+            ! Remove CORNERS
+            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+            !
+            IF( eastern_side) THEN
+               DO jn = 1, jptra
+                  tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                           tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                        ELSE
+                           tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                           IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                              tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) & 
+                                                   + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
+                  END DO
+               ENDDO
+            ENDIF
+            ! 
+            IF( northern_side ) THEN            
+               DO jn = 1, jptra
+                  tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO ji = imin,imax
+                        IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                           tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                        ELSE
+                           tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                           IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                              tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn)  &
+                                                   + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                           ENDIF
+                        ENDIF
+                     END DO
+                  END DO
+               ENDDO
+            ENDIF
+            !
+            IF( western_side) THEN            
+               DO jn = 1, jptra
+                  tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(2,jj,jk) == 0.e0 ) THEN
+                           tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                        ELSE
+                           tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
+                           IF( un(2,jj,jk) < 0.e0 ) THEN
+                              tra(2,jj,jk,jn)=(z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
+                           ENDIF
+                        ENDIF
+                     END DO
                   END DO
                END DO
-            ENDDO
+            ENDIF
+            !
+            IF( southern_side ) THEN           
+               DO jn = 1, jptra
+                  tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn)
+                  DO jk=1,jpk      
+                     DO ji=imin,imax
+                        IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                           tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
+                        ELSE
+                           tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                           IF( vn(ji,2,jk) < 0.e0 ) THEN
+                              tra(ji,2,jk,jn)=(z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
+                           ENDIF
+                        ENDIF
+                     END DO
+                  END DO
+               ENDDO
+            ENDIF
+            !
+            ! Treatment of corners
+            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south
+            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north
+            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(2,2,:,:) = ptab(2,2,:,:)                      ! West south
+            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north
+            !
          ENDIF
-         ! 
-         IF( northern_side ) THEN            
-            DO jn = 1, jptra
-               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO ji = imin,imax
-                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                     ELSE
-                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  &
-                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         !
-         IF( western_side) THEN            
-            DO jn = 1, jptra
-               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(2,jj,jk) == 0.e0 ) THEN
-                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
-                     ELSE
-                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
-                        IF( un(2,jj,jk) < 0.e0 ) THEN
-                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         !
-         IF( southern_side ) THEN           
-            DO jn = 1, jptra
-               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
-               DO jk=1,jpk      
-                  DO ji=imin,imax
-                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
-                     ELSE
-                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
-                        IF( vn(ji,2,jk) < 0.e0 ) THEN
-                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         !
-         ! Treatment of corners
-         ! 
-         ! East south
-         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
-         ENDIF
-         ! East north
-         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
-         ENDIF
-         ! West south
-         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tra(2,2,:,:) = ptab(2,2,:,:)
-         ENDIF
-         ! West north
-         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
-         ENDIF
-         !
       ENDIF
       !
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 8879)
@@ -127,10 +127,17 @@
    !!
    IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
+   !!clem ghost
 
    ! 2. Type of interpolation
@@ -141,6 +148,8 @@
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(e1u_id,(/0,0/))
-   CALL Agrif_Set_bc(e2v_id,(/0,0/))
+   !!clem ghost (previously set to /0,0/)
+   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
+   !!clem ghost
 
    ! 5. Update type
@@ -337,43 +346,50 @@
    !!----------------------------------------------------------------------
    USE agrif_util
-   USE par_oce       !   ONLY : jpts
+   USE par_oce       !   ONLY : jpts and ghostcells
    USE oce
    USE agrif_oce
    !!
    IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
-
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
-
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
-
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
-
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
-
-   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
+
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
+
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
+
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
+
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
+
+   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
 
 # if defined key_zdftke
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
 # endif
+   !!clem ghost
 
    ! 2. Type of interpolation
@@ -407,28 +423,29 @@
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(tsn_id,(/0,1/))
-   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
-   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
-
-!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
-!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
-!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
-   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   !!clem ghost
+   CALL Agrif_Set_bc(tsn_id,(/0,ind1/))
+   CALL Agrif_Set_bc(un_interp_id,(/0,ind1/))
+   CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/))
+
+   ! clem: previously set to /-,0/
+   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9 
    CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
    CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
 
-   CALL Agrif_Set_bc(sshn_id,(/0,0/))
-   CALL Agrif_Set_bc(unb_id ,(/0,0/))
-   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
-   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
-   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
-
-   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
-   CALL Agrif_Set_bc(umsk_id,(/0,0/))
-   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
-
+   CALL Agrif_Set_bc(sshn_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(unb_id ,(/0,ind1-1/))
+   CALL Agrif_Set_bc(vnb_id ,(/0,ind1-1/))
+   CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1-1/))
+
+   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1-1/))   ! if west and rhox=3 and ghost=1: column 2 to 9
+   CALL Agrif_Set_bc(umsk_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(vmsk_id,(/0,ind1-1/))
+
+   ! clem: previously set to /0,1/
 # if defined key_zdftke
-   CALL Agrif_Set_bc(avm_id ,(/0,1/))
+   CALL Agrif_Set_bc(avm_id ,(/0,ind1/))
 # endif
+   !!clem ghost
 
    ! 5. Update type
@@ -463,99 +480,4 @@
    !
 END SUBROUTINE agrif_declare_var
-
-#  if defined key_lim2
-SUBROUTINE Agrif_InitValues_cont_lim2
-   !!----------------------------------------------------------------------
-   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
-   !!
-   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
-   !!----------------------------------------------------------------------
-   USE Agrif_Util
-   USE ice_2
-   USE agrif_ice
-   USE in_out_manager
-   USE agrif_lim2_update
-   USE agrif_lim2_interp
-   USE lib_mpp
-   !!
-   IMPLICIT NONE
-   !!----------------------------------------------------------------------
-
-   ! 1. Declaration of the type of variable which have to be interpolated
-   !---------------------------------------------------------------------
-   CALL agrif_declare_var_lim2
-
-   ! 2. First interpolations of potentially non zero fields
-   !-------------------------------------------------------
-   Agrif_SpecialValue=-9999.
-   Agrif_UseSpecialValue = .TRUE.
-   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
-   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
-   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
-   Agrif_SpecialValue=0.
-   Agrif_UseSpecialValue = .FALSE.
-
-   ! 3. Some controls
-   !-----------------
-
-#   if ! defined key_lim2_vp
-   lim_nbstep = 1.
-   CALL agrif_rhg_lim2_load
-   CALL agrif_trp_lim2_load
-   lim_nbstep = 0.
-#   endif
-   !RB mandatory but why ???
-   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
-   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
-   !         nbclineupdate = nn_fsbc
-   !       ENDIF
-   CALL Agrif_Update_lim2(0)
-   !
-END SUBROUTINE Agrif_InitValues_cont_lim2
-
-
-SUBROUTINE agrif_declare_var_lim2
-   !!----------------------------------------------------------------------
-   !!                 *** ROUTINE agrif_declare_var_lim2 ***
-   !!
-   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
-   !!----------------------------------------------------------------------
-   USE agrif_util
-   USE ice_2
-   !!
-   IMPLICIT NONE
-   !!----------------------------------------------------------------------
-
-   ! 1. Declaration of the type of variable which have to be interpolated
-   !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
-#   if defined key_lim2_vp
-   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
-   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
-#   else
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
-#   endif
-
-   ! 2. Type of interpolation
-   !-------------------------
-   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-   ! 3. Location of interpolation
-   !-----------------------------
-   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
-   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
-   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
-
-   ! 5. Update type
-   !---------------
-   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
-   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-   ! 
-END SUBROUTINE agrif_declare_var_lim2
-#  endif
 
 #if defined key_lim3
@@ -623,6 +545,9 @@
    USE Agrif_Util
    USE ice
-
-   IMPLICIT NONE
+   USE par_oce, ONLY : nbghostcells
+   !
+   IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
    !
@@ -634,7 +559,12 @@
    !                            2,2 = two ghost lines
    !-------------------------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
-   CALL agrif_declare_variable((/1,2/)    ,(/2,3/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
-   CALL agrif_declare_variable((/2,1/)    ,(/3,2/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
+   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
+   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
+   !!clem ghost
 
    ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
@@ -646,7 +576,9 @@
    ! 3. Set location of interpolations
    !----------------------------------
-   CALL Agrif_Set_bc(tra_ice_id,(/0,1/))
-   CALL Agrif_Set_bc(u_ice_id  ,(/0,1/))
-   CALL Agrif_Set_bc(v_ice_id  ,(/0,1/))
+   !!clem ghost
+   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
+   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
+   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
+   !!clem ghost
 
    ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
@@ -777,10 +709,16 @@
    !!
    IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
 
    ! 2. Type of interpolation
@@ -791,6 +729,7 @@
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(trn_id,(/0,1/))
-!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
+   !!clem ghost
+   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
+   !clem: previously set to /-,0/
    CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
 
@@ -868,7 +807,4 @@
    !
    IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
-# if defined key_lim2
-   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3)
-# endif
    !
 END SUBROUTINE agrif_nemo_init
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 8879)
@@ -38,7 +38,4 @@
    USE asmpar             ! Parameters for the assmilation interface
    USE zdfmxl             ! mixed layer depth
-#if defined key_lim2
-   USE ice_2
-#endif
 #if defined key_lim3
    USE ice
@@ -148,10 +145,10 @@
             CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
             CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
-#if defined key_lim2 || defined key_lim3
-            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN
-	            IF( ALLOCATED(frld) ) THEN
-                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   )
+#if defined key_lim3
+            IF( nn_ice == 2 ) THEN
+	            IF( ALLOCATED(at_i) ) THEN
+                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', at_i(:,:)   )
                ELSE
-		            CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
+		            CALL ctl_warn('Ice concentration not written to background as ice variable at_i not allocated on this timestep')
 	            ENDIF
             ENDIF
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 8879)
@@ -35,6 +35,6 @@
    USE in_out_manager   ! I/O manager
    USE lib_mpp          ! MPP library
-#if defined key_lim2
-   USE ice_2            ! LIM2
+#if defined key_lim3
+   USE ice,   ONLY: hm_i, at_i, at_i_b
 #endif
    USE sbc_oce          ! Surface boundary condition variables.
@@ -809,5 +809,5 @@
       INTEGER  ::   it
       REAL(wp) ::   zincwgt   ! IAU weight for current time step
-#if defined key_lim2
+#if defined key_lim3
       REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc  ! LIM
       REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres
@@ -831,20 +831,19 @@
             ENDIF
             !
-            ! Sea-ice : LIM-3 case (to add)
-            !
-#if defined key_lim2
-            ! Sea-ice : LIM-2 case
-            zofrld (:,:) = frld(:,:)
-            zohicif(:,:) = hicif(:,:)
-            !
-            frld  = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
-            pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
-            fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction
-            !
-            zseaicendg(:,:) = zofrld(:,:) - frld(:,:)   ! find out actual sea ice nudge applied
+            ! Sea-ice : LIM-3 case
+            !
+#if defined key_lim3
+            zofrld (:,:) = 1._wp - at_i(:,:)
+            zohicif(:,:) = hm_i(:,:)
+            !
+            at_i  (:,:) = 1. - MIN( MAX( 1.-at_i  (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
+            at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
+            fr_i(:,:) = at_i(:,:)        ! adjust ice fraction
+            !
+            zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied
             !
             ! Nudge sea ice depth to bring it up to a required minimum depth
-            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin ) 
-               zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt    
+            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 
+               zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt    
             ELSEWHERE
                zhicifinc(:,:) = 0.0_wp
@@ -852,6 +851,5 @@
             !
             ! nudge ice depth
-            hicif (:,:) = hicif (:,:) + zhicifinc(:,:)
-            phicif(:,:) = phicif(:,:) + zhicifinc(:,:)       
+            hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:)
             !
             ! seaice salinity balancing (to add)
@@ -882,27 +880,26 @@
             neuler = 0                    ! Force Euler forward step
             !
-            ! Sea-ice : LIM-3 case (to add)
-            !
-#if defined key_lim2
-            ! Sea-ice : LIM-2 case.
-            zofrld(:,:)=frld(:,:)
-            zohicif(:,:)=hicif(:,:)
+            ! Sea-ice : LIM-3 case
+            !
+#if defined key_lim3
+            zofrld (:,:) = 1._wp - at_i(:,:)
+            zohicif(:,:) = hm_i(:,:)
             ! 
             ! Initialize the now fields the background + increment
-            frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp)
-            pfrld(:,:) = frld(:,:) 
-            fr_i (:,:) = 1.0_wp - frld(:,:)                ! adjust ice fraction
-            zseaicendg(:,:) = zofrld(:,:) - frld(:,:)      ! find out actual sea ice nudge applied
+            at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp)
+            at_i_b(:,:) = at_i(:,:) 
+            fr_i(:,:) = at_i(:,:)        ! adjust ice fraction
+            !
+            zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied
             !
             ! Nudge sea ice depth to bring it up to a required minimum depth
-            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin ) 
-               zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt    
+            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 
+               zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt    
             ELSEWHERE
-               zhicifinc(:,:) = 0._wp
+               zhicifinc(:,:) = 0.0_wp
             END WHERE
             !
             ! nudge ice depth
-            hicif (:,:) = hicif (:,:) + zhicifinc(:,:)
-            phicif(:,:) = phicif(:,:)       
+            hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:)
             !
             ! seaice salinity balancing (to add)
@@ -926,5 +923,5 @@
          ENDIF
 
-!#if defined defined key_lim2 || defined key_cice
+!#if defined defined key_lim3 || defined key_cice
 !
 !            IF (ln_seaicebal ) THEN       
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 8879)
@@ -55,18 +55,11 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::  tem
       REAL(wp), POINTER, DIMENSION(:,:) ::  sal
-#if defined key_lim2
-      LOGICAL                           ::   ll_frld
-      LOGICAL                           ::   ll_hicif
-      LOGICAL                           ::   ll_hsnif
-      REAL(wp), POINTER, DIMENSION(:)   ::   frld
-      REAL(wp), POINTER, DIMENSION(:)   ::   hicif
-      REAL(wp), POINTER, DIMENSION(:)   ::   hsnif
-#elif defined key_lim3
+#if defined key_lim3
       LOGICAL                           ::   ll_a_i
-      LOGICAL                           ::   ll_ht_i
-      LOGICAL                           ::   ll_ht_s
+      LOGICAL                           ::   ll_h_i
+      LOGICAL                           ::   ll_h_s
       REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_s   !: now snow thickness
+      REAL(wp), POINTER, DIMENSION(:,:) ::   h_i    !: Now ice  thickness climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   h_s    !: now snow thickness
 #endif
 #if defined key_top
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 8879)
@@ -25,9 +25,7 @@
    USE iom             ! IOM library
    USE in_out_manager  ! I/O logical units
-#if defined key_lim2
-   USE ice_2
-#elif defined key_lim3
+#if defined key_lim3
    USE ice
-   USE limvar          ! redistribute ice input into categories
+   USE icevar          ! redistribute ice input into categories
 #endif
    USE sbcapr
@@ -50,5 +48,5 @@
 
 #if defined key_lim3
-   LOGICAL :: ll_bdylim3                  ! determine whether ice input is lim2 (F) or lim3 (T) type
+   LOGICAL :: ll_bdylim3                  ! determine whether ice input is 1cat (F) or Xcat (T) type
    INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure
 #endif
@@ -176,33 +174,5 @@
             ENDIF
 
-#if defined key_lim2
-            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
-               ilen1(:) = nblen(:)
-               IF( dta%ll_frld ) THEN
-                  igrd = 1 
-                  DO ib = 1, ilen1(igrd)
-                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                     dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)         
-                  END DO 
-               END IF
-               IF( dta%ll_hicif ) THEN
-                  igrd = 1 
-                  DO ib = 1, ilen1(igrd)
-                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                     dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)         
-                  END DO 
-               END IF
-               IF( dta%ll_hsnif ) THEN
-                  igrd = 1 
-                  DO ib = 1, ilen1(igrd)
-                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                     dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)         
-                  END DO 
-               END IF
-            ENDIF
-#elif defined key_lim3
+#if defined key_lim3
             IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
                ilen1(:) = nblen(:)
@@ -217,5 +187,5 @@
                   END DO
                ENDIF
-               IF( dta%ll_ht_i ) THEN
+               IF( dta%ll_h_i ) THEN
                   igrd = 1   
                   DO jl = 1, jpl
@@ -223,9 +193,9 @@
                         ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
                         ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                        dta_bdy(ib_bdy)%ht_i (ib,jl) =  ht_i(ii,ij,jl) * tmask(ii,ij,1) 
+                        dta_bdy(ib_bdy)%h_i (ib,jl) =  h_i(ii,ij,jl) * tmask(ii,ij,1) 
                      END DO
                   END DO
                ENDIF
-               IF( dta%ll_ht_s ) THEN
+               IF( dta%ll_h_s ) THEN
                   igrd = 1   
                   DO jl = 1, jpl
@@ -233,5 +203,5 @@
                         ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
                         ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                        dta_bdy(ib_bdy)%ht_s (ib,jl) =  ht_s(ii,ij,jl) * tmask(ii,ij,1) 
+                        dta_bdy(ib_bdy)%h_s (ib,jl) =  h_s(ii,ij,jl) * tmask(ii,ij,1) 
                      END DO
                   END DO
@@ -373,7 +343,7 @@
                ENDIF
 #if defined key_lim3
-               IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type)
-     	          CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
-                                  & dta_bdy(ib_bdy)%ht_i,     dta_bdy(ib_bdy)%ht_s,     dta_bdy(ib_bdy)%a_i     )
+               IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is 1cat)
+     	          CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
+                                  & dta_bdy(ib_bdy)%h_i,     dta_bdy(ib_bdy)%h_s,     dta_bdy(ib_bdy)%a_i     )
                ENDIF
 #endif
@@ -449,14 +419,10 @@
       TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! 
       TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
-#if defined key_lim2
-      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      !
-#elif defined key_lim3
-      TYPE(FLD_N) ::   bn_a_i, bn_ht_i, bn_ht_s      
+#if defined key_lim3
+      TYPE(FLD_N) ::   bn_a_i, bn_h_i, bn_h_s      
 #endif
       NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
-#if defined key_lim2
-      NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif
-#elif defined key_lim3
-      NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s
+#if defined key_lim3
+      NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s
 #endif
       NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy
@@ -475,5 +441,5 @@
                                ,nn_dyn3d_dta(ib_bdy)       &
                                ,nn_tra_dta(ib_bdy)         &
-#if ( defined key_lim2 || defined key_lim3 )
+#if defined key_lim3
                               ,nn_ice_lim_dta(ib_bdy)    &
 #endif
@@ -496,5 +462,5 @@
             nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
          ENDIF
-#if ( defined key_lim2 || defined key_lim3 )
+#if defined key_lim3
          IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1  ) THEN
             nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
@@ -637,40 +603,8 @@
             ENDIF
 
-#if defined key_lim2
+#if defined key_lim3
             ! sea ice
             IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN
-
-               IF( dta%ll_frld ) THEN
-                  jfld = jfld + 1
-                  blf_i(jfld) = bn_frld
-                  ibdy(jfld) = ib_bdy
-                  igrid(jfld) = 1
-                  ilen1(jfld) = nblen(igrid(jfld))
-                  ilen3(jfld) = 1
-               ENDIF
-
-               IF( dta%ll_hicif ) THEN
-                  jfld = jfld + 1
-                  blf_i(jfld) = bn_hicif
-                  ibdy(jfld) = ib_bdy
-                  igrid(jfld) = 1
-                  ilen1(jfld) = nblen(igrid(jfld))
-                  ilen3(jfld) = 1
-               ENDIF
-
-               IF( dta%ll_hsnif ) THEN
-                  jfld = jfld + 1
-                  blf_i(jfld) = bn_hsnif
-                  ibdy(jfld) = ib_bdy
-                  igrid(jfld) = 1
-                  ilen1(jfld) = nblen(igrid(jfld))
-                  ilen3(jfld) = 1
-               ENDIF
-
-            ENDIF
-#elif defined key_lim3
-            ! sea ice
-            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN
-               ! Test for types of ice input (lim2 or lim3) 
+               ! Test for types of ice input (1cat or Xcat) 
                ! Build file name to find dimensions 
                clname=TRIM( cn_dir )//TRIM(bn_a_i%clname)
@@ -689,7 +623,7 @@
 
       	       IF ( zndims == 4 ) THEN
-                 ll_bdylim3 = .TRUE.   ! lim3 input
+                 ll_bdylim3 = .TRUE.   ! Xcat input
                ELSE
-                 ll_bdylim3 = .FALSE.  ! lim2 input      
+                 ll_bdylim3 = .FALSE.  ! 1cat input      
                ENDIF
                ! End test
@@ -704,7 +638,7 @@
                ENDIF
 
-               IF( dta%ll_ht_i ) THEN
-                  jfld = jfld + 1
-                  blf_i(jfld) = bn_ht_i
+               IF( dta%ll_h_i ) THEN
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_h_i
                   ibdy(jfld) = ib_bdy
                   igrid(jfld) = 1
@@ -713,7 +647,7 @@
                ENDIF
 
-               IF( dta%ll_ht_s ) THEN
-                  jfld = jfld + 1
-                   blf_i(jfld) = bn_ht_s
+               IF( dta%ll_h_s ) THEN
+                  jfld = jfld + 1
+                   blf_i(jfld) = bn_h_s
                   ibdy(jfld) = ib_bdy
                   igrid(jfld) = 1
@@ -848,44 +782,29 @@
          ENDIF
 
-#if defined key_lim2
+#if defined key_lim3
          IF (cn_ice_lim(ib_bdy) /= 'none') THEN
             IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN
-               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) )
-               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) )
-               ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) )
+               ALLOCATE( dta_bdy(ib_bdy)%a_i(nblen(1),jpl) )
+               ALLOCATE( dta_bdy(ib_bdy)%h_i(nblen(1),jpl) )
+               ALLOCATE( dta_bdy(ib_bdy)%h_s(nblen(1),jpl) )
             ELSE
-               jfld = jfld + 1
-               dta_bdy(ib_bdy)%frld  => bf(jfld)%fnow(:,1,1)
-               jfld = jfld + 1
-               dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1)
-               jfld = jfld + 1
-               dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1)
-            ENDIF
-         ENDIF
-#elif defined key_lim3
-         IF (cn_ice_lim(ib_bdy) /= 'none') THEN
-            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN
-               ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) )
-               ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
-               ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) )
-            ELSE
-               IF ( ll_bdylim3 ) THEN ! case input is lim3 type
-                  jfld = jfld + 1
-                  dta_bdy(ib_bdy)%a_i  => bf(jfld)%fnow(:,1,:)
-                  jfld = jfld + 1
-                  dta_bdy(ib_bdy)%ht_i => bf(jfld)%fnow(:,1,:)
-                  jfld = jfld + 1
-                  dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:)
-               ELSE ! case input is lim2 type
+               IF ( ll_bdylim3 ) THEN ! case input is Xcat
+                  jfld = jfld + 1
+                  dta_bdy(ib_bdy)%a_i => bf(jfld)%fnow(:,1,:)
+                  jfld = jfld + 1
+                  dta_bdy(ib_bdy)%h_i => bf(jfld)%fnow(:,1,:)
+                  jfld = jfld + 1
+                  dta_bdy(ib_bdy)%h_s => bf(jfld)%fnow(:,1,:)
+               ELSE ! case input is 1cat
                   jfld_ai  = jfld + 1
                   jfld_hti = jfld + 2
                   jfld_hts = jfld + 3
                   jfld     = jfld + 3
-                  ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) )
-                  ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
-                  ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) )
-                  dta_bdy(ib_bdy)%a_i (:,:) = 0._wp
-                  dta_bdy(ib_bdy)%ht_i(:,:) = 0._wp
-                  dta_bdy(ib_bdy)%ht_s(:,:) = 0._wp
+                  ALLOCATE( dta_bdy(ib_bdy)%a_i(nblen(1),jpl) )
+                  ALLOCATE( dta_bdy(ib_bdy)%h_i(nblen(1),jpl) )
+                  ALLOCATE( dta_bdy(ib_bdy)%h_s(nblen(1),jpl) )
+                  dta_bdy(ib_bdy)%a_i(:,:) = 0._wp
+                  dta_bdy(ib_bdy)%h_i(:,:) = 0._wp
+                  dta_bdy(ib_bdy)%h_s(:,:) = 0._wp
                ENDIF
 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 8879)
@@ -0,0 +1,371 @@
+MODULE bdyice
+   !!======================================================================
+   !!                       ***  MODULE  bdyice  ***
+   !! Unstructured Open Boundary Cond. :  Open boundary conditions for sea-ice (LIM3)
+   !!======================================================================
+   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
+   !!             3.4  !  2011    (D. Storkey)  rewrite in preparation for OBC-BDY merge
+   !!              -   !  2012-01 (C. Rousset)  add lim3 and remove useless jk loop 
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                                 LIM-3 sea ice model
+   !!----------------------------------------------------------------------
+   !!   bdy_ice        : Application of open boundaries to ice
+   !!   bdy_ice_frs        : Application of Flow Relaxation Scheme
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE phycst          ! physical constant
+   USE eosbn2          ! equation of state
+   USE oce             ! ocean dynamics and tracers variables
+   USE ice             ! sea-ice: variables
+   USE icevar          ! sea-ice: operations
+   USE iceitd          ! sea-ice: rebining
+   USE icectl          ! sea-ice: control prints
+   USE par_oce         ! ocean parameters
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE bdy_oce         ! ocean open boundary conditions
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! write to numout file
+   USE lib_mpp         ! distributed memory computing
+   USE lib_fortran     ! to use key_nosignedzero
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_ice     ! routine called in sbcmod
+   PUBLIC   bdy_ice_dyn ! routine called in limrhg
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: bdyice.F90 8306 2017-07-10 10:18:03Z clem $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_ice( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_ice  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for ice (LIM3)
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! Main time step counter
+      !
+      INTEGER ::   ib_bdy   ! Loop index
+      !!----------------------------------------------------------------------
+      !
+      CALL ice_var_glo2eqv
+      !
+      DO ib_bdy=1, nb_bdy
+         !
+         SELECT CASE( cn_ice_lim(ib_bdy) )
+         CASE('none')
+            CYCLE
+         CASE('frs')
+            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' )
+         END SELECT
+         !
+      END DO
+      !
+      CALL ice_var_zapsmall
+      CALL ice_var_agg(1)
+      IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )
+      !
+   END SUBROUTINE bdy_ice
+
+
+   SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_ice_frs  ***
+      !!                    
+      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 
+      !!              of unstructured open boundaries.
+      !! 
+      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three-
+      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
+      !!------------------------------------------------------------------------------
+      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data
+      INTEGER,         INTENT(in) ::   kt      ! main time-step counter
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      !
+      INTEGER  ::   jpbound            ! 0 = incoming ice
+      !                                ! 1 = outgoing ice
+      INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices
+      INTEGER  ::   ji, jj, ii, ij     ! local scalar
+      REAL(wp) ::   zwgt, zwgt1        ! local scalar
+      REAL(wp) ::   ztmelts, zdh
+      !!------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_ice_frs')
+      !
+      jgrd = 1      ! Everything is at T-points here
+      !
+      DO jl = 1, jpl
+         DO jb = 1, idx%nblenrim(jgrd)
+            ji    = idx%nbi(jb,jgrd)
+            jj    = idx%nbj(jb,jgrd)
+            zwgt  = idx%nbw(jb,jgrd)
+            zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
+            a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction 
+            h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth 
+            h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth
+
+            ! -----------------
+            ! Pathological case
+            ! -----------------
+            ! In case a) snow load would be in excess or b) ice is coming into a warmer environment that would lead to 
+            ! very large transformation from snow to ice (see icethd_dh.F90)
+
+            ! Then, a) 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 )
+            ! Or, b) transfer all the snow into ice (if incoming ice is likely to melt as it comes into a warmer environment)
+            !zdh = MAX( 0._wp, h_s(ji,jj,jl) * rhosn / rhoic )
+
+            ! recompute h_i, h_s
+            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 / rhosn ) 
+
+         ENDDO
+         CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy )
+      ENDDO
+      ! retrieve at_i
+      at_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      DO jl = 1, jpl
+         DO jb = 1, idx%nblenrim(jgrd)
+            ji    = idx%nbi(jb,jgrd)
+            jj    = idx%nbj(jb,jgrd)
+
+            ! condition on ice thickness depends on the ice velocity
+            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values
+            jpbound = 0   ;   ii = ji   ;   ij = jj
+            !
+            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
+            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
+            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1
+            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1
+            !
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions
+            !                                                                 !      do not make state variables dependent on velocity
+            !
+            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice
+            !
+            ! concentration and thickness
+            a_i(ji,jj,jl) = a_i(ii,ij,jl) * rswitch
+            h_i(ji,jj,jl) = h_i(ii,ij,jl) * rswitch
+            h_s(ji,jj,jl) = h_s(ii,ij,jl) * rswitch
+            !
+            ! Ice and snow volumes
+            v_i(ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)
+            v_s(ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)
+            !
+            SELECT CASE( jpbound )
+            !
+            CASE( 0 )   ! velocity is inward
+               !
+               ! Ice salinity, age, temperature
+               s_i (ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin
+               oa_i(ji,jj,jl)   = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl)
+               t_su(ji,jj,jl)   = rswitch * rn_ice_tem(ib_bdy)  + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy)
+               DO jk = 1, nlay_s
+                  t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0
+               END DO
+               DO jk = 1, nlay_i
+                  t_i (ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 
+                  sz_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
+               END DO
+               !
+            CASE( 1 )   ! velocity is outward
+               !
+               ! Ice salinity, age, temperature
+               s_i (ji,jj,jl)   = rswitch * s_i (ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin
+               oa_i(ji,jj,jl)   = rswitch * oa_i(ii,ij,jl)
+               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rt0
+               DO jk = 1, nlay_s
+                  t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
+               END DO
+               DO jk = 1, nlay_i
+                  t_i (ji,jj,jk,jl) = rswitch * t_i (ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
+                  sz_i(ji,jj,jk,jl) = rswitch * sz_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin
+               END DO
+               !
+            END SELECT
+            !
+            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_icesal
+               s_i (ji,jj  ,jl) = rn_icesal
+               sz_i(ji,jj,:,jl) = rn_icesal
+            ENDIF
+            !
+            ! contents
+            sv_i(ji,jj,jl)  = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
+            DO jk = 1, nlay_s
+               ! Snow energy of melting
+               e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+               ! Multiply by volume, so that 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
+            DO jk = 1, nlay_i
+               ztmelts          = - tmut * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K                  
+               ! heat content per unit volume
+               e_i(ji,jj,jk,jl) = rswitch * rhoic * &
+                  (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
+                  +   lfus    * ( 1.0 - (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) * a_i(ji,jj,jl) * h_i(ji,jj,jl) * r1_nlay_i
+            END DO
+            !
+         END DO
+         !
+         CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( v_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( v_s(:,:,jl), 'T', 1., ib_bdy )
+         !
+         CALL lbc_bdy_lnk( sv_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk(  s_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy )
+         DO jk = 1, nlay_s
+            CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy )
+            CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy )
+         END DO
+         DO jk = 1, nlay_i
+            CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy )
+            CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )
+         END DO
+         !
+      END DO !jl
+      !
+      ! --- In case categories are out of bounds, do a remapping --- !
+      !     i.e. inputs have not the same ice thickness distribution 
+      !          (set by rn_himean) than the regional simulation
+      IF( jpl > 1 )   CALL ice_itd_reb( kt )
+      !      
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_ice_frs')
+      !
+   END SUBROUTINE bdy_ice_frs
+
+
+   SUBROUTINE bdy_ice_dyn( cd_type )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_ice_dyn  ***
+      !!                    
+      !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries.
+      !!              u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free
+      !!              if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities
+      !!
+      !! 2013-06 : C. Rousset
+      !!------------------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points
+      !
+      INTEGER  ::   jb, jgrd           ! dummy loop indices
+      INTEGER  ::   ji, jj             ! local scalar
+      INTEGER  ::   ib_bdy             ! Loop index
+      REAL(wp) ::   zmsk1, zmsk2, zflag
+      !!------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_dyn')
+      !
+      DO ib_bdy=1, nb_bdy
+         !
+         SELECT CASE( cn_ice_lim(ib_bdy) )
+         !
+         CASE('none')
+            CYCLE
+            !
+         CASE('frs')
+            !
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions 
+            !                                                  !      do not change ice velocity (it is only computed by rheology)
+            SELECT CASE ( cd_type )
+            !     
+            CASE ( 'U' )  
+               jgrd = 2      ! u velocity
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
+                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
+                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
+                  zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd)
+                  !
+                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries
+                     ! one of the two zmsk is always 0 (because of zflag)
+                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice
+                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice
+                     !  
+                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
+                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+                        &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
+                        &            u_oce(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
+                  ELSE                             ! everywhere else
+                     !u_ice(ji,jj) = u_oce(ji,jj)
+                     u_ice(ji,jj) = 0._wp
+                  ENDIF
+                  ! mask ice velocities
+                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice
+                  u_ice(ji,jj) = rswitch * u_ice(ji,jj)
+                  !
+               END DO
+               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )
+               !
+            CASE ( 'V' )
+               jgrd = 3      ! v velocity
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
+                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
+                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
+                  zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd)
+                  !
+                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries
+                     ! one of the two zmsk is always 0 (because of zflag)
+                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice
+                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice
+                     !  
+                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
+                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+                        &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
+                        &            v_oce(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
+                  ELSE                             ! everywhere else
+                     !v_ice(ji,jj) = v_oce(ji,jj)
+                     v_ice(ji,jj) = 0._wp
+                  ENDIF
+                  ! mask ice velocities
+                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice
+                  v_ice(ji,jj) = rswitch * v_ice(ji,jj)
+                  !
+               END DO
+               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )
+               !
+            END SELECT
+            !
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_ice_dyn : unrecognised option for open boundaries for ice fields' )
+         END SELECT
+         !
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_dyn')
+      !
+    END SUBROUTINE bdy_ice_dyn
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Default option                                                    Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_ice( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_ice: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_ice
+#endif
+
+   !!=================================================================================
+END MODULE bdyice
Index: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 8878)
+++ 	(revision )
@@ -1,402 +1,0 @@
-MODULE bdyice_lim
-   !!======================================================================
-   !!                       ***  MODULE  bdyice_lim  ***
-   !! Unstructured Open Boundary Cond. :  Open boundary conditions for sea-ice (LIM2 and LIM3)
-   !!======================================================================
-   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
-   !!             3.4  !  2011    (D. Storkey)  rewrite in preparation for OBC-BDY merge
-   !!              -   !  2012-01 (C. Rousset)  add lim3 and remove useless jk loop 
-   !!----------------------------------------------------------------------
-#if defined key_lim2 || defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim2'                                                 LIM-2 sea ice model
-   !!   'key_lim3'                                                 LIM-3 sea ice model
-   !!----------------------------------------------------------------------
-   !!   bdy_ice_lim        : Application of open boundaries to ice
-   !!   bdy_ice_frs        : Application of Flow Relaxation Scheme
-   !!----------------------------------------------------------------------
-   USE timing          ! Timing
-   USE phycst          ! physical constant
-   USE eosbn2          ! equation of state
-   USE oce             ! ocean dynamics and tracers variables
-#if defined key_lim2
-   USE par_ice_2
-   USE ice_2           ! LIM_2 ice variables
-   USE dom_ice_2       ! sea-ice domain
-#elif defined key_lim3
-   USE ice             ! LIM_3 ice variables
-   USE limvar
-   USE limctl
-#endif 
-   USE par_oce         ! ocean parameters
-   USE dom_oce         ! ocean space and time domain variables 
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE bdy_oce         ! ocean open boundary conditions
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE in_out_manager  ! write to numout file
-   USE lib_mpp         ! distributed memory computing
-   USE lib_fortran     ! to use key_nosignedzero
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   bdy_ice_lim     ! routine called in sbcmod
-   PUBLIC   bdy_ice_lim_dyn ! routine called in limrhg
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE bdy_ice_lim( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  SUBROUTINE bdy_ice_lim  ***
-      !!
-      !! ** Purpose : - Apply open boundary conditions for ice (LIM2 and LIM3)
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! Main time step counter
-      !
-      INTEGER ::   ib_bdy   ! Loop index
-      !!----------------------------------------------------------------------
-      !
-#if defined key_lim3
-      CALL lim_var_glo2eqv
-#endif
-      !
-      DO ib_bdy=1, nb_bdy
-         !
-         SELECT CASE( cn_ice_lim(ib_bdy) )
-         CASE('none')
-            CYCLE
-         CASE('frs')
-            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
-         CASE DEFAULT
-            CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' )
-         END SELECT
-         !
-      END DO
-      !
-#if defined key_lim3
-                        CALL lim_var_zapsmall
-                        CALL lim_var_agg(1)
-      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )
-#endif
-      !
-   END SUBROUTINE bdy_ice_lim
-
-
-   SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )
-      !!------------------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdy_ice_frs  ***
-      !!                    
-      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 
-      !!              of unstructured open boundaries.
-      !! 
-      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three-
-      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
-      !!------------------------------------------------------------------------------
-      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data
-      INTEGER,         INTENT(in) ::   kt      ! main time-step counter
-      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
-      !
-      INTEGER  ::   jpbound            ! 0 = incoming ice
-      !                                ! 1 = outgoing ice
-      INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices
-      INTEGER  ::   ji, jj, ii, ij     ! local scalar
-      REAL(wp) ::   zwgt, zwgt1        ! local scalar
-      REAL(wp) ::   ztmelts, zdh
-#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif
-     USE ice_2, vt_s => hsnm
-     USE ice_2, vt_i => hicm
-#endif
-      !!------------------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('bdy_ice_frs')
-      !
-      jgrd = 1      ! Everything is at T-points here
-      !
-#if defined key_lim2
-      DO jb = 1, idx%nblenrim(jgrd)
-         ji    = idx%nbi(jb,jgrd)
-         jj    = idx%nbj(jb,jgrd)
-         zwgt  = idx%nbw(jb,jgrd)
-         zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
-         frld (ji,jj) = ( frld (ji,jj) * zwgt1 + dta%frld (jb) * zwgt ) * tmask(ji,jj,1)     ! Leads fraction 
-         hicif(ji,jj) = ( hicif(ji,jj) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ji,jj,1)     ! Ice depth 
-         hsnif(ji,jj) = ( hsnif(ji,jj) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ji,jj,1)     ! Snow depth
-      END DO 
-
-      CALL lbc_bdy_lnk( frld,  'T', 1., ib_bdy )                                         ! lateral boundary conditions
-      CALL lbc_bdy_lnk( hicif, 'T', 1., ib_bdy )
-      CALL lbc_bdy_lnk( hsnif, 'T', 1., ib_bdy )
-
-      vt_i(:,:) = hicif(:,:) * frld(:,:)
-      vt_s(:,:) = hsnif(:,:) * frld(:,:)
-      !
-#elif defined key_lim3
-
-      DO jl = 1, jpl
-         DO jb = 1, idx%nblenrim(jgrd)
-            ji    = idx%nbi(jb,jgrd)
-            jj    = idx%nbj(jb,jgrd)
-            zwgt  = idx%nbw(jb,jgrd)
-            zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
-            a_i (ji,jj,jl) = ( a_i (ji,jj,jl) * zwgt1 + dta%a_i (jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction 
-            ht_i(ji,jj,jl) = ( ht_i(ji,jj,jl) * zwgt1 + dta%ht_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth 
-            ht_s(ji,jj,jl) = ( ht_s(ji,jj,jl) * zwgt1 + dta%ht_s(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth
-
-            ! -----------------
-            ! Pathological case
-            ! -----------------
-            ! In case a) snow load would be in excess or b) ice is coming into a warmer environment that would lead to 
-            ! very large transformation from snow to ice (see limthd_dh.F90)
-
-            ! Then, a) 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 )
-            ! Or, b) transfer all the snow into ice (if incoming ice is likely to melt as it comes into a warmer environment)
-            !zdh = MAX( 0._wp, ht_s(ji,jj,jl) * rhosn / rhoic )
-
-            ! recompute ht_i, ht_s
-            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 / rhosn ) 
-
-         ENDDO
-         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy )
-      ENDDO
-      ! retrieve at_i
-      at_i(:,:) = 0._wp
-      DO jl = 1, jpl
-         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
-      END DO
-
-      DO jl = 1, jpl
-         DO jb = 1, idx%nblenrim(jgrd)
-            ji    = idx%nbi(jb,jgrd)
-            jj    = idx%nbj(jb,jgrd)
-
-            ! condition on ice thickness depends on the ice velocity
-            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values
-            jpbound = 0   ;   ii = ji   ;   ij = jj
-            !
-            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
-            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
-            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1
-            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1
-            !
-            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions
-            !                                                                 !      do not make state variables dependent on velocity
-            !
-            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice
-            !
-            ! concentration and thickness
-            a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch
-            ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch
-            ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch
-            !
-            ! Ice and snow volumes
-            v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl)
-            v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl)
-            !
-            SELECT CASE( jpbound )
-            !
-            CASE( 0 )   ! velocity is inward
-               !
-               ! Ice salinity, age, temperature
-               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin
-               oa_i(ji,jj,jl)   = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl)
-               t_su(ji,jj,jl)   = rswitch * rn_ice_tem(ib_bdy)  + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy)
-               DO jk = 1, nlay_s
-                  t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0
-               END DO
-               DO jk = 1, nlay_i
-                  t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 
-                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
-               END DO
-               !
-            CASE( 1 )   ! velocity is outward
-               !
-               ! Ice salinity, age, temperature
-               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin
-               oa_i(ji,jj,jl)   = rswitch * oa_i(ii,ij,jl)
-               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rt0
-               DO jk = 1, nlay_s
-                  t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
-               END DO
-               DO jk = 1, nlay_i
-                  t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
-                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin
-               END DO
-               !
-            END SELECT
-            !
-            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_icesal
-               sm_i(ji,jj  ,jl) = rn_icesal
-               s_i (ji,jj,:,jl) = rn_icesal
-            ENDIF
-            !
-            ! contents
-            smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
-            DO jk = 1, nlay_s
-               ! Snow energy of melting
-               e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
-               ! Multiply by volume, so that 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
-            DO jk = 1, nlay_i
-               ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K                  
-               ! heat content per unit volume
-               e_i(ji,jj,jk,jl) = rswitch * rhoic * &
-                  (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
-                  +   lfus    * ( 1.0 - (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) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i
-            END DO
-            !
-         END DO
-         !
-         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk(  v_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk(  v_s(:,:,jl), 'T', 1., ib_bdy )
-         !
-         CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk(  oa_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk(  t_su(:,:,jl), 'T', 1., ib_bdy )
-         DO jk = 1, nlay_s
-            CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy )
-            CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy )
-         END DO
-         DO jk = 1, nlay_i
-            CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy )
-            CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )
-         END DO
-         !
-      END DO !jl
-      !
-#endif
-      !      
-      IF( nn_timing == 1 )   CALL timing_stop('bdy_ice_frs')
-      !
-   END SUBROUTINE bdy_ice_frs
-
-
-   SUBROUTINE bdy_ice_lim_dyn( cd_type )
-      !!------------------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdy_ice_lim_dyn  ***
-      !!                    
-      !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries.
-      !!              u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free
-      !!              if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities
-      !!
-      !! 2013-06 : C. Rousset
-      !!------------------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points
-      !
-      INTEGER  ::   jb, jgrd           ! dummy loop indices
-      INTEGER  ::   ji, jj             ! local scalar
-      INTEGER  ::   ib_bdy             ! Loop index
-      REAL(wp) ::   zmsk1, zmsk2, zflag
-      !!------------------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn')
-      !
-      DO ib_bdy=1, nb_bdy
-         !
-         SELECT CASE( cn_ice_lim(ib_bdy) )
-         !
-         CASE('none')
-            CYCLE
-            !
-         CASE('frs')
-            !
-            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions 
-            !                                                  !      do not change ice velocity (it is only computed by rheology)
-            SELECT CASE ( cd_type )
-            !     
-            CASE ( 'U' )  
-               jgrd = 2      ! u velocity
-               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
-                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
-                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
-                  zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd)
-                  !
-                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries
-                     ! one of the two zmsk is always 0 (because of zflag)
-                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice
-                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice
-                     !  
-                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
-                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
-                        &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
-                        &            u_oce(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
-                  ELSE                             ! everywhere else
-                     !u_ice(ji,jj) = u_oce(ji,jj)
-                     u_ice(ji,jj) = 0._wp
-                  ENDIF
-                  ! mask ice velocities
-                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice
-                  u_ice(ji,jj) = rswitch * u_ice(ji,jj)
-                  !
-               END DO
-               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )
-               !
-            CASE ( 'V' )
-               jgrd = 3      ! v velocity
-               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
-                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
-                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
-                  zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd)
-                  !
-                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries
-                     ! one of the two zmsk is always 0 (because of zflag)
-                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice
-                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice
-                     !  
-                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
-                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
-                        &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
-                        &            v_oce(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
-                  ELSE                             ! everywhere else
-                     !v_ice(ji,jj) = v_oce(ji,jj)
-                     v_ice(ji,jj) = 0._wp
-                  ENDIF
-                  ! mask ice velocities
-                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice
-                  v_ice(ji,jj) = rswitch * v_ice(ji,jj)
-                  !
-               END DO
-               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )
-               !
-            END SELECT
-            !
-         CASE DEFAULT
-            CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' )
-         END SELECT
-         !
-      END DO
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn')
-      !
-    END SUBROUTINE bdy_ice_lim_dyn
-
-#else
-   !!---------------------------------------------------------------------------------
-   !!   Default option                                                    Empty module
-   !!---------------------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE bdy_ice_lim( kt )      ! Empty routine
-      WRITE(*,*) 'bdy_ice_lim: You should not have seen this print! error?', kt
-   END SUBROUTINE bdy_ice_lim
-#endif
-
-   !!=================================================================================
-END MODULE bdyice_lim
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 8879)
@@ -351,40 +351,17 @@
         IF(lwp) WRITE(numout,*)
 
-#if defined key_lim2
+#if defined key_lim3
         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
         SELECT CASE( cn_ice_lim(ib_bdy) )                  
           CASE('none')
              IF(lwp) WRITE(numout,*) '      no open boundary condition'        
-             dta_bdy(ib_bdy)%ll_frld  = .false.
-             dta_bdy(ib_bdy)%ll_hicif = .false.
-             dta_bdy(ib_bdy)%ll_hsnif = .false.
+             dta_bdy(ib_bdy)%ll_a_i = .false.
+             dta_bdy(ib_bdy)%ll_h_i = .false.
+             dta_bdy(ib_bdy)%ll_h_s = .false.
           CASE('frs')
              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
-             dta_bdy(ib_bdy)%ll_frld  = .true.
-             dta_bdy(ib_bdy)%ll_hicif = .true.
-             dta_bdy(ib_bdy)%ll_hsnif = .true.
-          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' )
-        END SELECT
-        IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 
-           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   ! 
-              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'        
-              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file'
-              CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' )
-           END SELECT
-        ENDIF
-        IF(lwp) WRITE(numout,*)
-#elif defined key_lim3
-        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
-        SELECT CASE( cn_ice_lim(ib_bdy) )                  
-          CASE('none')
-             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
-             dta_bdy(ib_bdy)%ll_a_i  = .false.
-             dta_bdy(ib_bdy)%ll_ht_i = .false.
-             dta_bdy(ib_bdy)%ll_ht_s = .false.
-          CASE('frs')
-             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
-             dta_bdy(ib_bdy)%ll_a_i  = .true.
-             dta_bdy(ib_bdy)%ll_ht_i = .true.
-             dta_bdy(ib_bdy)%ll_ht_s = .true.
+             dta_bdy(ib_bdy)%ll_a_i = .true.
+             dta_bdy(ib_bdy)%ll_h_i = .true.
+             dta_bdy(ib_bdy)%ll_h_s = .true.
           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' )
         END SELECT
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8879)
@@ -15,5 +15,5 @@
    
    INTERFACE crs_lbc_lnk
-      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d
+      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d
    END INTERFACE
    
@@ -56,5 +56,5 @@
       !
       IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
-      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  )
+      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn        , pval=zval  )
       ENDIF
       !
@@ -62,33 +62,4 @@
       !
    END SUBROUTINE crs_lbc_lnk_3d
-   
-   
-   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions for coarsened grid
-      !!
-      !! ** Method  :   Swap domain indices from full to coarse domain
-      !!                before arguments are passed directly to lbc_lnk.
-      !!                Upon exiting, switch back to full domain indices.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type
-      REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied
-      !
-      LOGICAL ::   ll_grid_crs
-      !!----------------------------------------------------------------------
-      !
-      ll_grid_crs = ( jpi == jpi_crs )
-      !
-      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
-      !
-      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  )
-      !
-      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
-      !
-   END SUBROUTINE crs_lbc_lnk_3d_gather
-
    
    
@@ -121,6 +92,6 @@
       IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
       !
-      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
-      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  )
+      IF( PRESENT( cd_mpp ) ) THEN   ;   CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
+      ELSE                           ;   CALL lbc_lnk( pt2d, cd_type, psgn,         pval=zval  )
       ENDIF
       !
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 8879)
@@ -148,5 +148,5 @@
          rmxln_25h(:,:,:) = mxln(:,:,:)
 #endif
-#if defined key_lim3 || defined key_lim2
+#if defined key_lim3
          CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice')
 #endif 
@@ -207,5 +207,5 @@
       ENDIF
 
-#if defined key_lim3 || defined key_lim2
+#if defined key_lim3
       CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice')
 #endif
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 8879)
@@ -32,7 +32,4 @@
    USE dianam          ! build name of file
    USE lib_mpp         ! distributed memory computing library
-#if defined key_lim2
-   USE ice_2
-#endif
 #if defined key_lim3
    USE ice
@@ -747,5 +744,5 @@
            END DO !end of loop on the level
 
-#if defined key_lim2 || defined key_lim3
+#if defined key_lim3
 
            !ICE CASE    
@@ -769,21 +766,13 @@
               zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J)
 
-#if defined key_lim2   
-              transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*   & 
-                                   (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  & 
-                                  *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) +  & 
-                                    hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))
-              transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   & 
-                                    (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))
-#endif
 #if defined key_lim3
               DO jl=1,jpl
-                 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*     &
-                                   a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * &
-                                  ( ht_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) +  &
-                                    ht_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) )
+                 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*       &
+                                    a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) *  &
+                                  ( h_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) +  &
+                                    h_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) )
                                    
                  transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   &
-                                   a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl)
+                                    a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl)
               END DO
 #endif
@@ -960,5 +949,5 @@
            ENDDO ! loop over jk 
  
-#if defined key_lim2 || defined key_lim3 
+#if defined key_lim3 
  
            !ICE CASE     
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8879)
@@ -51,8 +51,6 @@
    USE ioipsl
 
-#if defined key_lim2
-   USE limwri_2 
-#elif defined key_lim3
-   USE limwri 
+#if defined key_lim3
+   USE icewri 
 #endif
    USE lib_mpp         ! MPP library
@@ -707,11 +705,4 @@
 #endif
 
-         IF( ln_cpl .AND. nn_ice == 2 ) THEN
-            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
-               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice
-               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         ENDIF
-
          CALL histend( nid_T, snc4chunks=snc4set )
 
@@ -861,9 +852,4 @@
 #endif
 
-      IF( ln_cpl .AND. nn_ice == 2 ) THEN
-         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature
-         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo
-      ENDIF
-
       CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
       CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
@@ -1009,8 +995,8 @@
       ENDIF
 
-#if defined key_lim2
-      CALL lim_wri_state_2( kt, id_i, nh_i )
-#elif defined key_lim3
-      CALL lim_wri_state( kt, id_i, nh_i )
+#if defined key_lim3
+      IF( nn_ice == 2 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid
+         CALL ice_wri_state( kt, id_i, nh_i )
+      ENDIF
 #else
       CALL histend( id_i, snc4chunks=snc4set )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 8879)
@@ -184,8 +184,12 @@
       END DO
 
-      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
-      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
-      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
-
+!!gm  ERROR !!!!
+!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos)
+!
+!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
+      STOP ' iscpl_cons:   please modify this module !'
+!!gm end
       ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
       ! allocation and initialisation of the list of problematic point
@@ -283,8 +287,12 @@
       pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
 
-      ! compute sum over the halo and set it to 0.
-      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
-      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
-      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
+!!gm  ERROR !!!!
+!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos)
+!
+!      ! compute sum over the halo and set it to 0.
+!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
+!!gm end
 
       ! deallocate variables
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 8879)
@@ -54,4 +54,7 @@
 
    REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3]
+   ! MV MP 2016
+   REAL(wp), PUBLIC ::   rhofw    = 1000._wp         !: volumic mass of freshwater in melt ponds [kg/m3]
+   ! END MV MP 2016
    REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice
    REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu]
@@ -88,4 +91,5 @@
    REAL(wp), PUBLIC ::   r1_rhoic                    !: 1 / rhoic
    REAL(wp), PUBLIC ::   r1_rhosn                    !: 1 / rhosn
+   REAL(wp), PUBLIC ::   r1_cpic                     !: 1 / cpic
 #endif
    !!----------------------------------------------------------------------
@@ -156,4 +160,5 @@
       r1_rhoic = 1._wp / rhoic
       r1_rhosn = 1._wp / rhosn
+      r1_cpic  = 1._wp / cpic
 #endif
       IF(lwp) THEN
@@ -176,4 +181,5 @@
          WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3'
          WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3'
+         WRITE(numout,*) '          density of freshwater (in melt ponds)     = ', rhofw   , ' kg/m^3'
          WRITE(numout,*) '          emissivity of snow or ice                 = ', emic  
          WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu'
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 8879)
@@ -82,11 +82,13 @@
             END DO  
          END DO  
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0._wp      ! east
-            IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0._wp      ! west
-            IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0._wp      ! north
-            IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0._wp      ! south
-         ENDIF
       END DO
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+         IF( nbondi == -1 .OR. nbondi == 2 )   hdivn( 2:nbghostcells+1,:        ,:) = 0._wp      ! west
+         IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east
+         IF( nbondj == -1 .OR. nbondj == 2 )   hdivn( :,2:nbghostcells+1        ,:) = 0._wp      ! south
+         IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north
+      ENDIF
+#endif
       !
       IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field)
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 8879)
@@ -17,4 +17,5 @@
    USE phycst         ! physical constants
    USE sbc_oce        ! surface boundary condition: ocean
+   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b
    USE sbcapr         ! surface boundary condition: atmospheric pressure
    USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
@@ -89,5 +90,5 @@
       IF(      ln_apr_dyn                                                &   ! atmos. pressure
          .OR.  ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. ln_tide) )   &   ! tide potential (no time slitting)
-         .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice
+         .OR.  ln_ice_embd ) THEN                                            ! embedded sea-ice
          !
          DO jj = 2, jpjm1
@@ -123,5 +124,5 @@
          ENDIF
          !
-         IF( nn_ice_embd == 2 ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==!
+         IF( ln_ice_embd ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==!
             CALL wrk_alloc( jpi,jpj,   zpice )
             !                                            
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8879)
@@ -686,20 +686,20 @@
             IF((nbondi == -1).OR.(nbondi == 2)) THEN
                DO jj=1,jpj
-                  zwx(2,jj) = ubdy_w(jj) * e2u(2,jj)
+                  zwx(2:nbghostcells+1,jj) = ubdy_w(jj) * e2u(2:nbghostcells+1,jj)
                END DO
             ENDIF
             IF((nbondi ==  1).OR.(nbondi == 2)) THEN
                DO jj=1,jpj
-                  zwx(nlci-2,jj) = ubdy_e(jj) * e2u(nlci-2,jj)
+                  zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * e2u(nlci-nbghostcells-1:nlci-2,jj)
                END DO
             ENDIF
             IF((nbondj == -1).OR.(nbondj == 2)) THEN
                DO ji=1,jpi
-                  zwy(ji,2) = vbdy_s(ji) * e1v(ji,2)
+                  zwy(ji,2:nbghostcells+1) = vbdy_s(ji) * e1v(ji,2:nbghostcells+1)
                END DO
             ENDIF
             IF((nbondj ==  1).OR.(nbondj == 2)) THEN
                DO ji=1,jpi
-                  zwy(ji,nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-2)
+                  zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-nbghostcells-1:nlcj-2)
                END DO
             ENDIF
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 8879)
@@ -90,5 +90,5 @@
    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e
    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e
-#if defined key_lim2 || defined key_lim3 || defined key_cice
+#if defined key_lim3 || defined key_cice
    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ui_e, vi_e
 #endif
@@ -170,5 +170,5 @@
       ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   &
          &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   &
-#if defined key_lim2 || defined key_lim3 || defined key_cice
+#if defined key_lim3 || defined key_cice
          &      ui_e(0:jpi+1,0:jpj+1) ,                            &
          &      vi_e(0:jpi+1,0:jpj+1) ,                            &
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90	(revision 8879)
@@ -21,11 +21,6 @@
    USE icb_oce                             ! define iceberg arrays
    USE sbc_oce                             ! ocean surface boundary conditions
-#if defined key_lim2
-   USE ice_2,         ONLY: u_ice, v_ice   ! LIM-2 ice velocities  (CAUTION in C-grid do not use key_vp option)
-   USE ice_2,         ONLY: hicif          ! LIM-2 ice thickness
-#elif defined key_lim3
-   USE ice,           ONLY: u_ice, v_ice   ! LIM-3 variables  (always in C-grid)
-                                           ! gm  LIM3 case the mean ice thickness (i.e. averaged over categories)
-                                           ! gm            has to be computed somewhere in the ice and accessed here
+#if defined key_lim3
+   USE ice,    ONLY: u_ice, v_ice, hm_i    ! LIM-3 variables
 #endif
 
@@ -85,13 +80,9 @@
       CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 )
       CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 )
-#if defined key_lim2
-      hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hicif(:,:)  
-      CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 )  
-#endif
-
-#if defined key_lim2 || defined key_lim3
+#if defined key_lim3
+      hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hm_i (:,:)  
       ui_e(:,:) = 0._wp ;   ui_e(1:jpi, 1:jpj) = u_ice(:,:)
       vi_e(:,:) = 0._wp ;   vi_e(1:jpi, 1:jpj) = v_ice(:,:)
-
+      CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 )
       CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 )
       CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 )
@@ -157,12 +148,8 @@
       pva  = pva * zmod
 
-#if defined key_lim2 || defined key_lim3
+#if defined key_lim3
       pui = icb_utl_bilin_h( ui_e, pi, pj, 'U' )              ! sea-ice velocities
       pvi = icb_utl_bilin_h( vi_e, pi, pj, 'V' )
-# if defined key_lim3
-      phi = 0._wp                                             ! LIM-3 case (to do)
-# else
       phi = icb_utl_bilin_h(hicth, pi, pj, 'T' )              ! ice thickness
-# endif
 #else
       pui = 0._wp
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 8879)
@@ -88,6 +88,9 @@
    INTEGER ::   nitrst                !: time step at which restart file should be written
    LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
+   LOGICAL ::   lrst_ice              !: logical to control the ice restart write 
    INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
+   INTEGER ::   numrir                !: logical unit for ice   restart (read)
    INTEGER ::   numrow                !: logical unit for ocean restart (write)
+   INTEGER ::   numriw                !: logical unit for ice   restart (write)
    INTEGER ::   nrst_lst              !: number of restart to output next
 
@@ -126,5 +129,5 @@
    INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
    INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
-   INTEGER ::   numsol          =   -1      !: logical unit for solver statistics
+   INTEGER ::   numrun          =   -1      !: logical unit for run statistics
    INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
    INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 8879)
@@ -34,6 +34,4 @@
 #if defined key_lim3
    USE ice    , ONLY :   jpl
-#elif defined key_lim2
-   USE par_ice_2
 #endif
    USE domngb          ! ocean space and time domain
@@ -193,6 +191,8 @@
       CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
 # endif
-#if defined key_lim3 || defined key_lim2
+#if defined key_lim3
       CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
+      ! SIMIP diagnostics (4 main arctic straits)
+      CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )
 #endif
       CALL iom_set_axis_attr( "icbcla", class_num )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_generic.h90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_generic.h90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_generic.h90	(revision 8879)
@@ -0,0 +1,120 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      REAL(wp) ::   zland
+      LOGICAL  ::   ll_Iperio, ll_Jperio, ll_nfd
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ll_Iperio = nperio==1 .OR. nperio==4 .OR. nperio==6
+      ll_Jperio = jperio==7
+      ll_nfd    = nperio==3 .OR. nperio==4 .OR. nperio==5 .OR. nperio==6
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( PRESENT( cd_mpp ) ) THEN     !==  halos filled with inner values  ==!
+         !
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+         !
+      ELSE                             !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                   ! number of arrays to be treated
+            !
+            !                                ! East-West boundaries
+            IF( ll_Iperio ) THEN                   !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN( 1 ,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(jpi,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( ll_Jperio ) THEN                   !* cyclic
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSEIF( ll_nfd ) THEN                  !* north fold
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+               CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)  )                       ! north fold treatment         
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,jpj,:,:,jf) = zland    ! north
+            ENDIF
+            !
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_multi_generic.h90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_multi_generic.h90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_multi_generic.h90	(revision 8879)
@@ -0,0 +1,74 @@
+#if defined DIM_2d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j)
+#   define PTR_TYPE              TYPE(PTR_2D)
+#   define PTR_ptab              pt2d
+#endif
+#if defined DIM_3d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k)
+#   define PTR_TYPE              TYPE(PTR_3D)
+#   define PTR_ptab              pt3d
+#endif
+#if defined DIM_4d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k,l)
+#   define PTR_TYPE              TYPE(PTR_4D)
+#   define PTR_ptab              pt4d
+#endif
+   SUBROUTINE ROUTINE_MULTI( pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   &
+      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   &
+      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied
+      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::   pt2  ,  pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9
+      CHARACTER(len=1)                     , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points
+      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::   cdna2,  cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9
+      REAL(wp)                             , INTENT(in   ) ::   psgn1   ! sign used across the north fold
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   psgn2,  psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9   
+      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries)
+      !!
+      INTEGER                         ::   kfld        ! number of elements that will be attributed
+      PTR_TYPE         , DIMENSION(9) ::   ptab_ptr    ! pointer array
+      CHARACTER(len=1) , DIMENSION(9) ::   cdna_ptr    ! nature of ptab_ptr grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_ptr    ! sign used across the north fold boundary
+      !!---------------------------------------------------------------------
+      !
+      kfld = 0          ! initial array of pointer size
+      !
+      !                 ! Load the first array
+      CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      !                 ! Look if more arrays are added
+      IF( PRESENT(psgn2) )   CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn3) )   CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn4) )   CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn5) )   CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn6) )   CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn7) )   CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn8) )   CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      CALL lbc_lnk_ptr( ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
+      !
+   END SUBROUTINE ROUTINE_MULTI
+
+
+   SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !!---------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
+      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
+      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
+      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
+      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
+      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
+      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
+      !!---------------------------------------------------------------------
+      !
+      kfld                    =  kfld + 1
+      ptab_ptr(kfld)%PTR_ptab => ptab
+      cdna_ptr(kfld)          =  cdna
+      psgn_ptr(kfld)          =  psgn
+      !
+   END SUBROUTINE ROUTINE_LOAD
+#undef ARRAY_TYPE
+#undef PTR_TYPE
+#undef PTR_ptab
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_generic.h90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_generic.h90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_generic.h90	(revision 8879)
@@ -0,0 +1,171 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
+      INTEGER  ::   ijt, iju, ipjm1
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
+      END SELECT
+      ipjm1 = ipj-1
+
+      !
+      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf) 
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3,:,:,jf) 
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf) 
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(1,ipj-1,:,:,jf)
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(1,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               ARRAY_IN(:, 1 ,:,:,jf) = 0._wp
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            CASE ( 'F' )                               ! F-point
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90	(revision 8879)
@@ -0,0 +1,333 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_2D),INTENT(inout)::ptab2(f)
+#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt2d(i,j)
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_3D),INTENT(inout)::ptab2(f)
+#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt3d(i,j,k)
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D),INTENT(inout)::ptab2(f)
+#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j)
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k)
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l)
+#   endif
+#   define ARRAY_TYPE(i,j,k,l,f)     REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   define ARRAY2_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
+      !
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   lateral boundary condition : North fold treatment
+      !!                without allgather exchanges. 
+      !!
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
+      ARRAY2_TYPE(:,:,:,:,:)                            ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
+      !!----------------------------------------------------------------------
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      ijpjm1 = ijpj-1
+      !
+      !
+      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+               CASE ( 'T' , 'W' )                         ! T-, W-point
+                  IF ( nimpp /= 1 ) THEN   ;   startloop = 1
+                  ELSE                     ;   startloop = 2
+               ENDIF
+                  !
+               DO ji = startloop, nlci
+                 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
+               END DO
+               IF(nimpp .eq. 1) THEN
+                 ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-2,:,:,jf)
+               ENDIF
+   
+               IF( nimpp >= jpiglo/2+1 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = nlci + 1
+               ENDIF
+               IF(startloop <= nlci) THEN
+               DO ji = startloop, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  jia = ji + nimpp - 1
+                  ijta = jpiglo - jia + 2
+                  IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
+                             ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,ijpjm1,:,:,jf)
+                  ELSE
+                             ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)
+                  ENDIF
+               END DO
+               ENDIF
+               !
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
+               END DO
+               IF (nimpp .eq. 1) THEN
+                        ARRAY_IN(   1  ,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf)
+               ENDIF
+               !
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF( nimpp >= jpiglo/2 ) THEN
+                  startloop = 1
+                  ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN
+                  startloop = jpiglo/2 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF( startloop <= endloop ) THEN
+               DO ji = startloop, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                  jia = ji + nimpp - 1
+                  ijua = jpiglo - jia + 1
+                  IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
+                           ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,ijpjm1,:,:,jf)
+                  ELSE
+                           ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
+                  ENDIF
+               END DO
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               IF( nimpp /= 1 ) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+               DO ji = startloop, nlci
+                 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                        ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
+                        ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-3,:,:,jf)
+               END DO
+               IF (nimpp .eq. 1) THEN
+                        ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-3,:,:,jf)
+               ENDIF
+            CASE ( 'F' )                                     ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
+                        ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-3,:,:,jf)
+               END DO
+               IF (nimpp .eq. 1) THEN
+                        ARRAY_IN(   1  ,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-3,:,:,jf)
+                        ARRAY_IN(   1  ,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-3,:,:,jf)
+                        ARRAY_IN(nlci,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf) 
+               ENDIF
+               !
+            CASE ( 'I' )                                     ! ice U-V point (I-point)
+               IF( nimpp /= 1 ) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 3
+                  ARRAY_IN(2,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(3,ijpjm1,:,:,jf)
+               ENDIF
+               DO ji = startloop, nlci
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+                  ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'W' )                               ! T-, W-point
+               DO ji = 1, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-1,:,:,jf)
+               END DO
+               !
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,:,:,jf)
+               END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-1,:,:,jf)
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               DO ji = 1, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
+               END DO
+                  !
+               IF( nimpp >= jpiglo/2+1 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = nlci + 1
+               ENDIF
+               IF( startloop <= nlci ) THEN
+               DO ji = startloop, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                          ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)
+               END DO
+               ENDIF
+               !
+            CASE ( 'F' )                               ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                        ARRAY_IN(ji,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
+               END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-2,:,:,jf)
+               ENDIF
+               !
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF( nimpp >= jpiglo/2+1 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF( startloop <= endloop ) THEN
+                  DO ji = startloop, endloop
+                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                      ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
+                  END DO
+               ENDIF
+               !
+            CASE ( 'I' )                                  ! ice U-V point (I-point)
+                  IF( nimpp /= 1 ) THEN
+                     startloop = 1
+                  ELSE
+                     startloop = 2
+                  ENDIF
+                  IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                     endloop = nlci
+                  ELSE
+                     endloop = nlci - 1
+                  ENDIF
+                  DO ji = startloop , endloop
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     ARRAY_IN(ji,ijpj,:,:,jf) = 0.5 * (ARRAY_IN(ji,ijpjm1,:,:,jf) + SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf))
+                  END DO
+                  !
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf))
+            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+                  ARRAY_IN(:, 1  ,:,:,jf) = 0._wp
+                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
+            CASE ( 'F' )                                   ! F-point
+                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
+            CASE ( 'I' )                                   ! ice U-V point
+                  ARRAY_IN(:, 1  ,:,:,jf) = 0._wp
+                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO            ! End jf loop
+   END SUBROUTINE ROUTINE_NFD
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef ARRAY2_TYPE
+#undef ARRAY2_IN
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 8879)
@@ -2,12 +2,15 @@
    !!======================================================================
    !!                       ***  MODULE  lbclnk  ***
-   !! Ocean        : lateral boundary conditions
+   !! NEMO        : lateral boundary conditions
    !!=====================================================================
    !! History :  OPA  ! 1997-06  (G. Madec)  Original code
    !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
    !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
-   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
+   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
    !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi  
+   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size)
+   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather)
+   !!             -   ! 2017-05  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
    !!----------------------------------------------------------------------
 #if defined key_mpp_mpi
@@ -15,21 +18,22 @@
    !!   'key_mpp_mpi'             MPI massively parallel processing library
    !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
-   !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
-   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
-   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
-   !!----------------------------------------------------------------------
+   !!           define the generic interfaces of lib_mpp routines
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean dynamics and tracers   
    USE lib_mpp        ! distributed memory computing library
-
+   USE lbcnfd         ! north fold
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr
+   END INTERFACE
    INTERFACE lbc_lnk_multi
-      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple
-   END INTERFACE
-   !
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
-   END INTERFACE
-   !
-   INTERFACE lbc_sum
-      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
    END INTERFACE
    !
@@ -46,10 +50,9 @@
    END INTERFACE
 
-   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
-   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
-   PUBLIC   lbc_sum
-   PUBLIC   lbc_lnk_e     !
+   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC   lbc_lnk_icb   !
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
 
    !!----------------------------------------------------------------------
@@ -58,9 +61,13 @@
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
+CONTAINS
+
 #else
    !!----------------------------------------------------------------------
    !!   Default option                              shared memory computing
    !!----------------------------------------------------------------------
-   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d 
+   !!                routines setting the appropriate values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
    !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
    !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
@@ -70,8 +77,8 @@
    !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers   
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O manager
-   USE lbcnfd          ! north fold
+   USE oce            ! ocean dynamics and tracers   
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+   USE lbcnfd         ! north fold
 
    IMPLICIT NONE
@@ -79,19 +86,17 @@
 
    INTERFACE lbc_lnk
-      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
-   END INTERFACE
-   !
-   INTERFACE lbc_sum
-      MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d
-   END INTERFACE
-
+      MODULE PROCEDURE   lbc_lnk_2d      , lbc_lnk_3d      , lbc_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   lbc_lnk_2d_ptr  , lbc_lnk_3d_ptr  , lbc_lnk_4d_ptr
+   END INTERFACE
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
+   END INTERFACE
+   !
    INTERFACE lbc_lnk_e
       MODULE PROCEDURE lbc_lnk_2d_e
    END INTERFACE
    !
-   INTERFACE lbc_lnk_multi
-      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple
-   END INTERFACE
-
    INTERFACE lbc_bdy_lnk
       MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
@@ -102,15 +107,9 @@
    END INTERFACE
    
-   TYPE arrayptr
-      REAL , DIMENSION (:,:),  POINTER :: pt2d
-   END TYPE arrayptr
-   PUBLIC   arrayptr
-
    PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
-   PUBLIC   lbc_sum       ! ocean/ice  lateral boundary conditions (sum of the overlap region)
-   PUBLIC   lbc_lnk_e     !
-   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
+   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC   lbc_lnk_icb   !
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
    
    !!----------------------------------------------------------------------
@@ -122,26 +121,9 @@
 
 # if defined key_c1d
-   !!----------------------------------------------------------------------
+   !!======================================================================
    !!   'key_c1d'                                          1D configuration
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case)
-      !!
-      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
-      !!----------------------------------------------------------------------
-      !
-      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
-      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
-      !
-   END SUBROUTINE lbc_lnk_3d_gather
-
+   !!======================================================================
+   !!     central point value replicated over the 8 surrounding points
+   !!----------------------------------------------------------------------
 
    SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
@@ -153,9 +135,9 @@
       !! ** Method  :   1D case, the central water column is set everywhere
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold 
+      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
       !
       INTEGER  ::   jk     ! dummy loop index
@@ -163,5 +145,5 @@
       !!----------------------------------------------------------------------
       !
-      DO jk = 1, jpk
+      DO jk = 1, SIZE( pt3d, 3 )
          ztab = pt3d(2,2,jk)
          pt3d(:,:,jk) = ztab
@@ -179,7 +161,7 @@
       !! ** Method  :   1D case, the central water column is set everywhere
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold 
       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
@@ -193,490 +175,166 @@
    END SUBROUTINE lbc_lnk_2d
    
-   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
-      !!
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
-      !
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
-      !
-      DO ii = 1, num_fields
-        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
-      END DO     
-      !
-   END SUBROUTINE lbc_lnk_2d_multiple
-
-   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
-      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      !!---------------------------------------------------------------------
-
-      !!The first array
-      CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 
-
-      !! Look if more arrays to process
-      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB )
-      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 
-      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 
-      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 
-      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 
-      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 
-      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 
-      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 
-
-   END SUBROUTINE lbc_lnk_2d_9
-
-
-
-
-
 #else
-   !!----------------------------------------------------------------------
+   !!======================================================================
    !!   Default option                           3D shared memory computing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
-      !!----------------------------------------------------------------------
-      !
-      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
-      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
-      !
-   END SUBROUTINE lbc_lnk_3d_gather
-
-
-   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-
-      IF( PRESENT( cd_mpp ) ) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-         !                                     !  East-West boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
-            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
-            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
-            !
-         CASE DEFAULT                             !**  East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d( 1 ,:,:) = zland
-               pt3d(jpi,:,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(jpi,:,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt3d(:, 1 ,:) = pt3d(:,3,:)
-               pt3d(:,jpj,:) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt3d(:, 1 ,:) = zland
-            END SELECT
-            !                                          ! North fold
-            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1 ,:) = zland
-               pt3d(:,jpj,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-      ENDIF
-      !
-   END SUBROUTINE lbc_lnk_3d
-
-
-   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE      
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
-            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
-            pt2d(jpi,:) = pt2d(  2  ,:)
-            !
-         CASE DEFAULT                             !** East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
-               pt2d( 1 ,:) = zland
-               pt2d(jpi,:) = zland
-            CASE ( 'F' )                              ! F-point
-               pt2d(jpi,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt2d(:, 1 ) = pt2d(:,3)
-               pt2d(:,jpj) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt2d(:, 1 ) = psgn * pt2d(:,2)
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt2d(:, 1 ) = zland
-            END SELECT
-            !                                          ! North fold
-            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt2d(:, 1 ) = zland
-               pt2d(:,jpj) = zland
-            CASE ( 'F' )                               ! F-point
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-      ENDIF
-      !    
-   END SUBROUTINE lbc_lnk_2d
-   
-   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
-      !!
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
-      !
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
-      !
-      DO ii = 1, num_fields
-        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
-      END DO     
-      !
-   END SUBROUTINE lbc_lnk_2d_multiple
-
-   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
-      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      !!---------------------------------------------------------------------
-
-      !!The first array
-      CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 
-
-      !! Look if more arrays to process
-      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB )
-      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 
-      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 
-      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 
-      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 
-      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 
-      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 
-      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 
-
-   END SUBROUTINE lbc_lnk_2d_9
-
-   SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_sum_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!
-      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean 
-      !!                coupling if conservation option activated. As no ice shelf are present along
-      !!                this line, nothing is done along the north fold.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
-            pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:)
-            pt2d(  2  ,:) = pt2d(  2  ,:) + pt2d(jpi,:)
-            pt2d( 1 ,:) = 0.0_wp               ! all points
-            pt2d(jpi,:) = 0.0_wp
-            !
-         CASE DEFAULT                             !** East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
-               pt2d( 1 ,:) = zland
-               pt2d(jpi,:) = zland
-            CASE ( 'F' )                              ! F-point
-               pt2d(jpi,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         ! Nothing to do for the north fold, there is no ice shelf along this line.
-         !
-      END IF
-
-   END SUBROUTINE
-
-   SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_sum_3d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
-      !!
-      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean 
-      !!                coupling if conservation option activated. As no ice shelf are present along
-      !!                this line, nothing is done along the north fold.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-
-      IF( PRESENT( cd_mpp ) ) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-         !                                     !  East-West boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
-            pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:)
-            pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:) 
-            pt3d( 1 ,:,:) = 0.0_wp            ! all points
-            pt3d(jpi,:,:) = 0.0_wp
-            !
-         CASE DEFAULT                             !**  East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d( 1 ,:,:) = zland
-               pt3d(jpi,:,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(jpi,:,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         ! Nothing to do for the north fold, there is no ice shelf along this line.
-         !
-      END IF
-   END SUBROUTINE
-
-
+   !!======================================================================
+   !!          routines setting land point, or east-west cyclic,
+   !!             or north-south cyclic, or north fold values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           lbc_lnk_2d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_2d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           lbc_lnk_3d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_3d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           lbc_lnk_4d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_4d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+   
 #endif
 
+   !!======================================================================
+   !!   identical routines in both C1D and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_bdy_lnk_(2,3)d  ***
+   !!
+   !!   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
+   !!   to maintain the same interface with regards to the mpp case
+   !!----------------------------------------------------------------------
+   
    SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!              to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign 
-      INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
-      !!----------------------------------------------------------------------
-      !
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
       CALL lbc_lnk_3d( pt3d, cd_type, psgn)
-      !
    END SUBROUTINE lbc_bdy_lnk_3d
 
 
    SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!              to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign 
-      INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
-      !!----------------------------------------------------------------------
-      !
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
       CALL lbc_lnk_2d( pt2d, cd_type, psgn)
-      !
    END SUBROUTINE lbc_bdy_lnk_2d
 
 
-   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!                special dummy routine to allow for use of halo indexing in mpp case
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign 
-      INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp)
-      INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp)
-      !!----------------------------------------------------------------------
-      !
+!!gm  This routine should be remove with an optional halos size added in orgument of generic routines
+
+   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, ki, kj )
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp)
+      !!----------------------------------------------------------------------
       CALL lbc_lnk_2d( pt2d, cd_type, psgn )
-      !    
    END SUBROUTINE lbc_lnk_2d_e
+!!gm end
 
 #endif
 
    !!======================================================================
+   !!   identical routines in both distributed and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Dummy Argument :
+   !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D)
+   !!                   cd_nat     ! nature of pt2d array grid-points
+   !!                   psgn       ! sign used across the north fold boundary
+   !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers
+   !!                   cdna_ptr   ! nature of ptab array grid-points
+   !!                   psgn_ptr   ! sign used across the north fold boundary
+   !!                   kfld       ! number of elements that has been attributed
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  ***   lbc_lnk_(2,3,4)d_multi   ***
+   !!                     ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_multi_... routines
+   !!
+   !!----------------------------------------------------------------------
+
+#  define DIM_2d
+#     define ROUTINE_MULTI          lbc_lnk_2d_multi
+#     define ROUTINE_LOAD           load_ptr_2d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_2d
+
+
+#  define DIM_3d
+#     define ROUTINE_MULTI          lbc_lnk_3d_multi
+#     define ROUTINE_LOAD           load_ptr_3d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_3d
+
+
+#  define DIM_4d
+#     define ROUTINE_MULTI          lbc_lnk_4d_multi
+#     define ROUTINE_LOAD           load_ptr_4d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_4d
+
+   !!======================================================================
 END MODULE lbclnk
 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 8879)
@@ -5,5 +5,6 @@
    !!======================================================================
    !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
-   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 
+   !!            3.5  ! 2013-07  (I. Epicoco, S. Mocavero - CMCC) MPP optimization
+   !!            4.0  ! 2017-04  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
    !!----------------------------------------------------------------------
 
@@ -12,6 +13,8 @@
    !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
    !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
-   !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP
-   !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP
+   !!   lbc_nfd_nogather       : generic interface for lbc_nfd_nogather_3d and 
+   !!                            lbc_nfd_nogather_2d routines (designed for use
+   !!                            with ln_nnogather to avoid global width arrays
+   !!                            mpi all gather operations)
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain 
@@ -22,13 +25,28 @@
 
    INTERFACE lbc_nfd
-      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
+      MODULE PROCEDURE   lbc_nfd_2d    , lbc_nfd_3d    , lbc_nfd_4d
+      MODULE PROCEDURE   lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr
    END INTERFACE
    !
-   INTERFACE mpp_lbc_nfd
-      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
+   INTERFACE lbc_nfd_nogather
+!                        ! Currently only 4d array version is needed
+!     MODULE PROCEDURE   lbc_nfd_nogather_2d    , lbc_nfd_nogather_3d
+      MODULE PROCEDURE   lbc_nfd_nogather_4d
+!     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr
+!     MODULE PROCEDURE   lbc_nfd_nogather_4d_ptr
    END INTERFACE
 
-   PUBLIC   lbc_nfd       ! north fold conditions
-   PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case)
+   TYPE, PUBLIC ::   PTR_2D   !: array of 2D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:)    , POINTER ::   pt2d
+   END TYPE PTR_2D
+   TYPE, PUBLIC ::   PTR_3D   !: array of 3D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:)  , POINTER ::   pt3d
+   END TYPE PTR_3D
+   TYPE, PUBLIC ::   PTR_4D   !: array of 4D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:,:), POINTER ::   pt4d
+   END TYPE PTR_4D
+
+   PUBLIC   lbc_nfd            ! north fold conditions
+   PUBLIC   lbc_nfd_nogather   ! north fold conditions (no allgather case)
 
    INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
@@ -43,130 +61,104 @@
 CONTAINS
 
-   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!              without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      ijpjm1 = ijpj-1
-
-      DO jk = 1, jpk
-         !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk)
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 
-               DO ji = jpiglo/2, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
-               END DO
-               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
-               END DO
-               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk)
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 
-            END SELECT
-            !
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
-               END DO
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
-            CASE ( 'V' )                               ! V-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
-               DO ji = jpiglo/2+1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            END SELECT
-            !
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1  ,jk) = 0.e0
-               pt3d(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,ijpj,jk) = 0.e0
-            END SELECT
-            !
-         END SELECT     !  npolj
-         !
-      END DO
-      !
-   END SUBROUTINE lbc_nfd_3d
-
-
-   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_nfd_(2,3,4)d  ***
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Purpose :   lateral boundary condition 
+   !!                North fold treatment without processor exchanges. 
+   !!
+   !! ** Method  :   
+   !!
+   !! ** Action  :   ptab with updated values along the north fold
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_2d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           lbc_nfd_3d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_3d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_4d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_4d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+   !
+   !  lbc_nfd_nogather routines
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+!#  define DIM_2d
+!#     define ROUTINE_NFD           lbc_nfd_nogather_2d
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+!#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+!#  define DIM_3d
+!#     define ROUTINE_NFD           lbc_nfd_nogather_3d
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+!#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_nogather_4d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+
+
+!!gm   CAUTION HERE  optional pr2dj  not implemented in generic case
+!!gm                 furthermore, in the _org routine it is OK only for T-point pivot !!
+
+
+   SUBROUTINE lbc_nfd_2d_org( pt2d, cd_nat, psgn, pr2dj )
       !!----------------------------------------------------------------------
       !!                  ***  routine lbc_nfd_2d  ***
@@ -179,10 +171,7 @@
       !! ** Action  :   pt2d with updated values along the north fold
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_nat   ! nature of pt2d grid-point
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
       INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
       !
@@ -210,5 +199,5 @@
       CASE ( 3, 4 )                       ! *  North fold  T-point pivot
          !
-         SELECT CASE ( cd_type )
+         SELECT CASE ( cd_nat )
          !
          CASE ( 'T' , 'W' )                               ! T- , W-points
@@ -265,25 +254,9 @@
                END DO
             END DO
-         CASE ( 'J' )                                     ! first ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                     ! second ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
          END SELECT
          !
       CASE ( 5, 6 )                        ! *  North fold  F-point pivot
          !
-         SELECT CASE ( cd_type )
+         SELECT CASE ( cd_nat )
          CASE ( 'T' , 'W' )                               ! T-, W-point
             DO jl = 0, ipr2dj
@@ -325,5 +298,5 @@
             END DO
          CASE ( 'I' )                                  ! ice U-V point (I-point)
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp
             DO jl = 0, ipr2dj
                DO ji = 2 , jpiglo-1
@@ -332,639 +305,22 @@
                END DO
             END DO
-         CASE ( 'J' )                                  ! first ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                  ! second ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)
-               END DO
-            END DO
          END SELECT
          !
       CASE DEFAULT                           ! *  closed : the code probably never go through
          !
-         SELECT CASE ( cd_type)
+         SELECT CASE ( cd_nat)
          CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:, 1:1-ipr2dj     ) = 0._wp
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          CASE ( 'F' )                                   ! F-point
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          CASE ( 'I' )                                   ! ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'J' )                                   ! first ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'K' )                                   ! second ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:, 1:1-ipr2dj     ) = 0._wp
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          END SELECT
          !
       END SELECT
       !
-   END SUBROUTINE lbc_nfd_2d
-
-
-   SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!              without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept    if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl     ! 3D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      ijpjm1 = ijpj-1
-
-         !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               IF (nimpp .ne. 1) THEN
-                 startloop = 1
-               ELSE
-                 startloop = 2
-               ENDIF
-
-               DO jk = 1, jpk
-                  DO ji = startloop, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                 startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                 startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                 startloop = nlci + 1
-               ENDIF
-               IF(startloop .le. nlci) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, nlci
-                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                       jia = ji + nimpp - 1
-                       ijta = jpiglo - jia + 2
-                       IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
-                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)
-                       ELSE
-                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
-                       ENDIF
-                    END DO
-                 END DO
-               ENDIF
-
-
-            CASE ( 'U' )                               ! U-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk)
-                  ENDIF
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               IF(nimpp .ge. (jpiglo/2)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
-                  startloop = jpiglo/2 - nimpp + 1
-               ELSE
-                  startloop = endloop + 1
-               ENDIF
-               IF (startloop .le. endloop) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, endloop
-                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                      jia = ji + nimpp - 1
-                      ijua = jpiglo - jia + 1
-                      IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)
-                      ELSE
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
-                      ENDIF
-                    END DO
-                 END DO
-               ENDIF
-
-            CASE ( 'V' )                               ! V-point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = startloop, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk)
-                  ENDIF
-               END DO
-            CASE ( 'F' )                               ! F-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk)
-                  ENDIF
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk)
-                  ENDIF
-               END DO
-            END SELECT
-            !
-
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'U' )                               ! U-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)
-                  END DO
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk)
-                  ENDIF
-               END DO
-
-            CASE ( 'V' )                               ! V-point
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                  END DO
-               END DO
-
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                  startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                  startloop = nlci + 1
-               ENDIF
-               IF(startloop .le. nlci) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, nlci
-                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
-                    END DO
-                 END DO
-               ENDIF
-
-            CASE ( 'F' )                               ! F-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                  END DO
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                  startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                  startloop = endloop + 1
-               ENDIF
-               IF (startloop .le. endloop) THEN
-                  DO jk = 1, jpk
-                     DO ji = startloop, endloop
-                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
-                     END DO
-                  END DO
-               ENDIF
-
-            END SELECT
-
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3dl(:, 1  ,jk) = 0.e0
-               pt3dl(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3dl(:,ijpj,jk) = 0.e0
-            END SELECT
-            !
-         END SELECT     !  npolj
-         !
-      !
-   END SUBROUTINE mpp_lbc_nfd_3d
-
-
-   SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lbc_nfd_2d  ***
-      !!
-      !! ** Purpose :   2D lateral boundary condition : North fold treatment
-      !!       without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt2d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl     ! 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      !
-      ijpjm1 = ijpj-1
-
-
-      SELECT CASE ( npolj )
-      !
-      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-         !
-         SELECT CASE ( cd_type )
-         !
-         CASE ( 'T' , 'W' )                               ! T- , W-points
-            IF (nimpp .ne. 1) THEN
-              startloop = 1
-            ELSE
-              startloop = 2
-            ENDIF
-            DO ji = startloop, nlci
-              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2)
-            ENDIF
-
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = nlci + 1
-            ENDIF
-            DO ji = startloop, nlci
-               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-               jia = ji + nimpp - 1
-               ijta = jpiglo - jia + 2
-               IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
-                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)
-               ELSE
-                  pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
-               ENDIF
-            END DO
-
-         CASE ( 'U' )                                     ! U-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
-            END DO
-
-            IF (nimpp .eq. 1) THEN
-              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2)
-              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1)
-            ENDIF
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2)
-            ENDIF
-
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            IF(nimpp .ge. (jpiglo/2)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
-               startloop = jpiglo/2 - nimpp + 1
-            ELSE
-               startloop = endloop + 1
-            ENDIF
-            DO ji = startloop, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               jia = ji + nimpp - 1
-               ijua = jpiglo - jia + 1
-               IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
-                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)
-               ELSE
-                  pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
-               ENDIF
-            END DO
-
-         CASE ( 'V' )                                     ! V-point
-            IF (nimpp .ne. 1) THEN
-              startloop = 1
-            ELSE
-              startloop = 2
-            ENDIF
-            DO ji = startloop, nlci
-              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)
-              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3) 
-            ENDIF
-
-         CASE ( 'F' )                                     ! F-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3)
-              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2)
-            ENDIF
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3)
-              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 
-            ENDIF
-
-         CASE ( 'I' )                                     ! ice U-V point (I-point)
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'J' )                                     ! first ice U-V point
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'K' )                                     ! second ice U-V point
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         END SELECT
-         !
-      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-         !
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'W' )                               ! T-, W-point
-            DO ji = 1, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
-            END DO
-
-         CASE ( 'U' )                                     ! U-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)
-            ENDIF
-
-         CASE ( 'V' )                                     ! V-point
-            DO ji = 1, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
-            END DO
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = nlci + 1
-            ENDIF
-            DO ji = startloop, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
-            END DO
-
-         CASE ( 'F' )                               ! F-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
-            END DO
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)
-            ENDIF
-
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = endloop + 1
-            ENDIF
-
-            DO ji = startloop, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'I' )                                  ! ice U-V point (I-point)
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop , endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
-               END DO
-
-         CASE ( 'J' )                                  ! first ice U-V point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop , endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1)
-               END DO
-
-         CASE ( 'K' )                                  ! second ice U-V point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop, endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)
-               END DO
-
-         END SELECT
-         !
-      CASE DEFAULT                           ! *  closed : the code probably never go through
-         !
-         SELECT CASE ( cd_type)
-         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'F' )                                   ! F-point
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'I' )                                   ! ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'J' )                                   ! first ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'K' )                                   ! second ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         END SELECT
-         !
-      END SELECT
-      !
-   END SUBROUTINE mpp_lbc_nfd_2d
+   END SUBROUTINE lbc_nfd_2d_org
 
    !!======================================================================
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 8879)
@@ -8,5 +8,5 @@
    !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
    !!                 !  1998  (J.M. Molines) Open boundary conditions
-   !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
+   !!   NEMO     1.0  !  2003  (J.M. Molines, G. Madec)  F90, free form
    !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
    !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
@@ -19,10 +19,10 @@
    !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl
    !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
-   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d', 
-   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update
-   !!                          the mppobc routine to optimize the BDY and OBC communications
-   !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables 
+   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm.
+   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables 
    !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
-   !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 
+   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max
+   !!            4.0  !  2017  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
+   !!             -   !  2017  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
    !!----------------------------------------------------------------------
 
@@ -41,9 +41,8 @@
    !!   mynode        : indentify the processor unit
    !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
-   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
    !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
    !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
    !!   mpprecv       :
-   !!   mppsend       :   SUBROUTINE mpp_ini_znl
+   !!   mppsend       :
    !!   mppscatter    :
    !!   mppgather     :
@@ -56,5 +55,5 @@
    !!   mppstop       :
    !!   mpp_ini_north : initialisation of north fold
-   !!   mpp_lbc_north : north fold processors gathering
+!!gm   !!   mpp_lbc_north : north fold processors gathering
    !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
    !!   mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs
@@ -67,13 +66,29 @@
    IMPLICIT NONE
    PRIVATE
-   
+
+   INTERFACE mpp_nfd
+      MODULE PROCEDURE   mpp_nfd_2d      , mpp_nfd_3d      , mpp_nfd_4d
+      MODULE PROCEDURE   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+   END INTERFACE
+
+   ! Interface associated to the mpp_lnk_... routines is defined in lbclnk
+   PUBLIC   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
+   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr
+   PUBLIC   mpp_lnk_2d_e
+   !
+!!gm  this should be useless
+   PUBLIC   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
+   PUBLIC   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+!!gm end
+   !
    PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
    PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
-   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   PUBLIC   mpp_ini_north, mpp_lbc_north_e
+!!gm   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
    PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
    PUBLIC   mpp_max_multiple
-   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
-   PUBLIC   mpp_lnk_2d_9 , mpp_lnk_2d_multiple 
-   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
+!!gm   PUBLIC   mpp_lnk_2d_9 
+!!gm   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
    PUBLIC   mppscatter, mppgather
    PUBLIC   mpp_ini_ice, mpp_ini_znl
@@ -81,11 +96,5 @@
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
    PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
-   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
    PUBLIC   mpprank
-
-   TYPE arrayptr
-      REAL , DIMENSION (:,:),  POINTER :: pt2d
-   END TYPE arrayptr
-   PUBLIC   arrayptr
    
    !! * Interfaces
@@ -101,9 +110,9 @@
    INTERFACE mpp_sum
       MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
-                       mppsum_realdd, mppsum_a_realdd
+         &             mppsum_realdd, mppsum_a_realdd
    END INTERFACE
-   INTERFACE mpp_lbc_north
-      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d
-   END INTERFACE
+!!gm   INTERFACE mpp_lbc_north
+!!gm      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d
+!!gm   END INTERFACE
    INTERFACE mpp_minloc
       MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
@@ -112,5 +121,4 @@
       MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
    END INTERFACE
-
    INTERFACE mpp_max_multiple
       MODULE PROCEDURE mppmax_real_multiple
@@ -137,38 +145,38 @@
 
    ! variables used in case of sea-ice
-   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd)
-   INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology)
-   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
-   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
-   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
+   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in icethd)
+   INTEGER         ::   ngrp_iworld     !  group ID for the world processors (for rheology)
+   INTEGER         ::   ngrp_ice        !  group ID for the ice processors (for rheology)
+   INTEGER         ::   ndim_rank_ice   !  number of 'ice' processors
+   INTEGER         ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_ice     ! dimension ndim_rank_ice
 
    ! variables used for zonal integration
    INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
-   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
-   INTEGER ::   ngrp_znl        ! group ID for the znl processors
-   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row
+   INTEGER         ::   ngrp_znl        !  group ID for the znl processors
+   INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
 
    ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
-   INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors
-   INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors
-   INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold)
-   INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
-   INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
-   INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line
-   INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
-   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   nrank_north   ! dimension ndim_rank_north
+   INTEGER, PUBLIC ::   ngrp_world        !: group ID for the world processors
+   INTEGER, PUBLIC ::   ngrp_opa          !: group ID for the opa processors
+   INTEGER, PUBLIC ::   ngrp_north        !: group ID for the northern processors (to be fold)
+   INTEGER, PUBLIC ::   ncomm_north       !: communicator made by the processors belonging to ngrp_north
+   INTEGER, PUBLIC ::   ndim_rank_north   !: number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER, PUBLIC ::   njmppmax          !: value of njmpp for the processors of the northern line
+   INTEGER, PUBLIC ::   north_root        !: number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north
 
    ! Type of send : standard, buffered, immediate
-   CHARACTER(len=1), PUBLIC ::   cn_mpi_send   ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
-   LOGICAL, PUBLIC          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
-   INTEGER, PUBLIC          ::   nn_buffer     ! size of the buffer in case of mpi_bsend
-
-   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
-
-   LOGICAL, PUBLIC                                  ::   ln_nnogather       ! namelist control of northfold comms
-   LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms
-   INTEGER, PUBLIC                                  ::   ityp
+   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I')
+   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend
+
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend
+
+   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
+   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -178,6 +186,5 @@
 CONTAINS
 
-
-   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm )
       !!----------------------------------------------------------------------
       !!                  ***  routine mynode  ***
@@ -204,18 +211,17 @@
       WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
       !
-
       REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
       READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
-
+      !
       REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
       READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
-
+      !
       !                              ! control print
       WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
-
+      !
 #if defined key_agrif
       IF( .NOT. Agrif_Root() ) THEN
@@ -225,12 +231,10 @@
       ENDIF
 #endif
-
-      IF(jpnij < 1)THEN
-         ! If jpnij is not specified in namelist then we calculate it - this
-         ! means there will be no land cutting out.
-         jpnij = jpni * jpnj
-      END IF
-
-      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+      !
+      IF( jpnij < 1 ) THEN         ! If jpnij is not specified in namelist then we calculate it
+         jpnij = jpni * jpnj       ! this means there will be no land cutting out.
+      ENDIF
+
+      IF( jpni < 1 .OR. jpnj < 1  ) THEN
          WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;   ii = ii + 1
       ELSE
@@ -238,5 +242,5 @@
          WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
          WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1
-      END IF
+      ENDIF
 
       WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
@@ -268,5 +272,6 @@
             kstop = kstop + 1
          END SELECT
-      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+         !
+      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN
          WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
          WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
@@ -309,5 +314,5 @@
 
 #if defined key_agrif
-      IF (Agrif_Root()) THEN
+      IF( Agrif_Root() ) THEN
          CALL Agrif_MPI_Init(mpi_comm_opa)
       ELSE
@@ -329,913 +334,169 @@
    END FUNCTION mynode
 
-
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING ptab is defined only between nld and nle
-         DO jk = 1, jpk
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)
-               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
-               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
-               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
-               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment
-         !
-         !                                   ! East-West boundaries
-         !                                        !* Cyclic east-west
-         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE                                     !* closed
-            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-         ENDIF
-                                          ! North-south cyclic
-         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude
-            ptab(:,1 , :) = ptab(:, jpjm1,:)
-            ptab(:,jpj,:) = ptab(:,     2,:)
-         ELSE   !                                   ! North-South boundaries (closed)
-            IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-                                         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
-         ENDIF
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = zt3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
-      !
-   END SUBROUTINE mpp_lnk_3d
-
-
-   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_multiple  ***
-      !!
-      !! ** Purpose :   Message passing management for multiple 2d arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
-      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
-         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      !First Array
-      DO ii = 1 , num_fields
-         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-            !
-            ! WARNING pt2d is defined only between nld and nle
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
-               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
-               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej) 
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
-               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
-               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
-            END DO
-            !
-         ELSE                              ! standard close or cyclic treatment
-            !
-            !                                   ! East-West boundaries
-            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
-               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
-            ELSE                                     ! closed
-               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
-                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
-            ENDIF
-                                                ! Noth-South boundaries
-            IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-               pt2d_array(ii)%pt2d(:, 1   ) =   pt2d_array(ii)%pt2d(:, jpjm1 )
-               pt2d_array(ii)%pt2d(:, jpj ) =   pt2d_array(ii)%pt2d(:, 2 )          
-            ELSE   !             
-               !                                   ! North-South boundaries (closed)
-               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
-                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
-            !
-            ENDIF
-          ENDIF
-      END DO
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      DO ii = 1 , num_fields
-         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
-               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
-            END DO
-         END SELECT
-      END DO
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-
-      DO ii = 1 , num_fields
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
-            END DO
-         CASE ( 0 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
-               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
-            END DO
-         END SELECT
-      END DO
-      
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      !First Array
-      DO ii = 1 , num_fields
-         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-            ijhom = nlcj-nrecj
-            DO jl = 1, jprecj
-               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
-               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
-            END DO
-         ENDIF
-      END DO
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-
-      DO ii = 1 , num_fields
-         !First Array
-         SELECT CASE ( nbondj )
-         CASE ( -1 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
-            END DO
-         CASE ( 0 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
-               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
-            END DO
-         END SELECT
-      END DO
-      
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-         !First Array
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   
-             DO ii = 1 , num_fields  
-                       CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
-             END DO
-         CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-        !
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_2d_multiple
-
-   
-   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields )
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
-      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
-      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
-      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
-      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
-      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
-      INTEGER                            , INTENT (inout) :: num_fields 
-      !!---------------------------------------------------------------------
-      num_fields = num_fields + 1
-      pt2d_array(num_fields)%pt2d => pt2d
-      type_array(num_fields)      =  cd_type
-      psgn_array(num_fields)      =  psgn
-   END SUBROUTINE load_array
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           mpp_lnk_2d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_2d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           mpp_lnk_3d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_3d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           mpp_lnk_4d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_4d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_nfd_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_nfd_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           mpp_nfd_2d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_2d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           mpp_nfd_3d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_3d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           mpp_nfd_4d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_4d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_bdy_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kb_bdy :   BDY boundary set
+   !!                kfld   :   optional, number of pt3d arrays
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_BDY           mpp_lnk_bdy_2d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     define MULTI
+#     define ROUTINE_BDY           mpp_lnk_bdy_2d_ptr
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_BDY           mpp_lnk_bdy_3d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     define MULTI
+#     define ROUTINE_BDY           mpp_lnk_bdy_3d_ptr
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+!!#  define DIM_4d
+!!#     define ROUTINE_BDY           mpp_lnk_bdy_4d
+!!#     include "mpp_bdy_generic.h90"
+!!#     undef ROUTINE_BDY
+!!#     define MULTI
+!!#     define ROUTINE_BDY           mpp_lnk_bdy_4d_ptr
+!!#     include "mpp_bdy_generic.h90"
+!!#     undef ROUTINE_BDY
+!!#     undef MULTI
+!!#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!
+   !!   load_array  &   mpp_lnk_2d_9    à generaliser a 3D et 4D
    
    
-   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA    
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI   
-      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
-      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
-      INTEGER :: num_fields
-      !!---------------------------------------------------------------------
-      !
-      num_fields = 0
-      !
-      ! Load the first array
-      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields )
-      !
-      ! Look if more arrays are added
-      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
-      !
-      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval )
-      !
-   END SUBROUTINE mpp_lnk_2d_9
-
-
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING pt2d is defined only between nld and nle
-         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)
-            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
-            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
-         END DO
-         DO ji = nlci+1, jpi                 ! added column(s) (full)
-            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
-            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
-            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment
-         !
-         !                                   ! East-West boundaries
-         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
-            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
-         ELSE                                     ! closed
-            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
-                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-                                            ! North-South boudaries
-         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-            pt2d(:,  1 ) = pt2d(:,jpjm1)
-            pt2d(:, jpj) = pt2d(:,    2)
-         ELSE    
-         !                                   ! North-South boundaries (closed)
-            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
-                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-         ENDIF     
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            zt2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,jl,2)
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_2d
-
-
-   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for two 3D arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   ml_stat   ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
-         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
-      !
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
-         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
-         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
-         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
-      ELSE                                        !* closed
-         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
-         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
-                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
-                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-      ENDIF
-                                            ! North-South boundaries
-      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-         ptab1(:,     1       ,:) = ptab1(: ,  jpjm1 , :)
-         ptab1(:,   jpj       ,:) = ptab1(: ,      2 , :)
-         ptab2(:,     1       ,:) = ptab2(: ,  jpjm1 , :)
-         ptab2(:,   jpj       ,:) = ptab2(: ,      2 , :)
-      ELSE     
-      !                                      ! North-South boundaries closed
-      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
-      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
-                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
-                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-      ENDIF     
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
-            zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
-            zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
-            zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk *2
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
-            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
-            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
-            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj - nrecj
-         DO jl = 1, jprecj
-            zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
-            zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
-            zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
-            zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk * 2
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
-            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab1(:,jl      ,:) = zt4sn(:,jl,:,1,2)
-            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
-            ptab2(:,jl      ,:) = zt4sn(:,jl,:,2,2)
-            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab1(:,jl,:) = zt4sn(:,jl,:,1,2)
-            ptab2(:,jl,:) = zt4sn(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )
-            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
-            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
-         CASE DEFAULT
-            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
-            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we )
-      !
-   END SUBROUTINE mpp_lnk_3d_gather
+   !!    mpp_lnk_2d_e     utilisé dans ICB 
+
+
+   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!!
+   
+   
+   !!----------------------------------------------------------------------
 
 
@@ -1284,38 +545,32 @@
 
 
-      ! 1. standard boundary treatment
+      ! 1. standard boundary treatment   (CAUTION: the order matters Here !!!! )
       ! ------------------------------
-      ! Order matters Here !!!!
-      !
-                                           ! North-South cyclic
-      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1)
+      !                                !== North-South boundaries
+      !                                      !* cyclic
+      IF( nbondj == 2 .AND. jperio == 7 ) THEN
+         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1 )
          pt2d(:, jpj   :jpj+jprj) = pt2d ( :, 2         :2+jprj)
-      ELSE
-        
-      !                                      !* North-South boundaries (closed)
-      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point
-                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north
-      ENDIF
-                                
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
+      ELSE                                   !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0._wp     ! south except at F-point
+                                      pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0._wp     ! north
+      ENDIF
+      !                                !== East-West boundaries
+      !                                      !* Cyclic east-west
       IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
-         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
-         !
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
-      ENDIF
-      !
-
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)              ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)              ! west
+      ELSE                                   !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp  ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp  ! north
+      ENDIF
+      !
       ! north fold treatment
-      ! -----------------------
+      ! --------------------
       IF( npolj /= 0 ) THEN
          !
          SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
+!!gm ERROR        CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+!!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                  , cd_type, psgn             )
          END SELECT
          !
@@ -1375,5 +630,4 @@
       END SELECT
 
-
       ! 3. North and south directions
       ! -----------------------------
@@ -1430,347 +684,4 @@
    END SUBROUTINE mpp_lnk_2d_e
 
-   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_sum_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement (sum the overlap region)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-      
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-      iihom = nlci-jpreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp
-            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp 
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      iihom = nlci-nreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
-            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
-         ijhom = nlcj-jprecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp
-            zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      ijhom = nlcj-nrecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2)
-            ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
-      !
-   END SUBROUTINE mpp_lnk_sum_3d
-
-   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_sum_2d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci - jpreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp
-            zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      iihom = nlci-nreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
-            pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
-         ijhom = nlcj - jprecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp
-            zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      ijhom = nlcj-nrecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
-            pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_sum_2d
 
    SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
@@ -1874,59 +785,69 @@
    END SUBROUTINE mppscatter
 
-
+   !!----------------------------------------------------------------------
+   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
    SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_a_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in   )                  ::   kdim   ! size of array
       INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   !
-      !
-      INTEGER :: ierror, localcomm   ! temporary integer
+      INTEGER :: ierror, ilocalcomm   ! temporary integer
       INTEGER, DIMENSION(kdim) ::   iwork
       !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror )
-      !
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, ilocalcomm, ierror )
       ktab(:) = iwork(:)
-      !
    END SUBROUTINE mppmax_a_int
-
-
+   !!
    SUBROUTINE mppmax_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER, INTENT(inout)           ::   ktab   ! ???
       INTEGER, INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !
-      INTEGER ::   ierror, iwork, localcomm   ! temporary integer
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror )
-      !
+      INTEGER ::   ierror, iwork, ilocalcomm   ! temporary integer
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, ilocalcomm, ierror )
       ktab = iwork
-      !
    END SUBROUTINE mppmax_int
-
-
+   !!
+   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab
+      INTEGER                  , INTENT(in   ) ::   kdim
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom
+      INTEGER :: ierror, ilocalcomm
+      REAL(wp), DIMENSION(kdim) ::  zwork
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror )
+      ptab(:) = zwork(:)
+   END SUBROUTINE mppmax_a_real
+   !!
+   SUBROUTINE mppmax_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab   ! ???
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      INTEGER  ::   ierror, ilocalcomm
+      REAL(wp) ::   zwork
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom!
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, ilocalcomm, ierror )
+      ptab = zwork
+   END SUBROUTINE mppmax_real
+
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
    SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_a_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER , INTENT( in  )                  ::   kdim   ! size of array
@@ -1934,298 +855,156 @@
       INTEGER , INTENT( in  ), OPTIONAL        ::   kcom   ! input array
       !!
-      INTEGER ::   ierror, localcomm   ! temporary integer
+      INTEGER ::   ierror, ilocalcomm   ! temporary integer
       INTEGER, DIMENSION(kdim) ::   iwork
       !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror )
-      !
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, ilocalcomm, ierror )
       ktab(:) = iwork(:)
-      !
    END SUBROUTINE mppmin_a_int
-
-
+   !!
    SUBROUTINE mppmin_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER, INTENT(inout) ::   ktab      ! ???
       INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
       !!
-      INTEGER ::  ierror, iwork, localcomm
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
-      !
+      INTEGER ::  ierror, iwork, ilocalcomm
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, ilocalcomm, ierror )
       ktab = iwork
-      !
    END SUBROUTINE mppmin_int
-
-
-   SUBROUTINE mppsum_a_int( ktab, kdim )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_int  ***
-      !!
-      !! ** Purpose :   Global integer sum, 1D array case
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   )                   ::   kdim   ! ???
-      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ???
-      !
-      INTEGER :: ierror
-      INTEGER, DIMENSION (kdim) ::  iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppsum_a_int
-
-
-   SUBROUTINE mppsum_int( ktab )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppsum_int  ***
-      !!
-      !! ** Purpose :   Global integer sum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab
-      !!
-      INTEGER :: ierror, iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppsum_int
-
-
-   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmax_a_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
+   !!
+   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in   )                  ::   kdim
       REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::  zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmax_a_real
-
-
-   SUBROUTINE mppmax_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmax_real
-
-   SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom  )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   )           ::   NUM
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) , POINTER , DIMENSION(:) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc(NUM , zwork)
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      CALL wrk_dealloc(NUM , zwork)
-      !
-   END SUBROUTINE mppmax_real_multiple
-
-
-   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmin_a_real  ***
-      !!
-      !! ** Purpose :   Minimum of REAL, array case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
-      INTEGER :: ierror, localcomm
+      INTEGER :: ierror, ilocalcomm
       REAL(wp), DIMENSION(kdim) ::   zwork
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, ilocalcomm, ierror )
       ptab(:) = zwork(:)
-      !
    END SUBROUTINE mppmin_a_real
-
-
+   !!
    SUBROUTINE mppmin_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_real  ***
-      !!
-      !! ** Purpose :   minimum of REAL, scalar case
-      !!
       !!-----------------------------------------------------------------------
       REAL(wp), INTENT(inout)           ::   ptab        !
       INTEGER , INTENT(in   ), OPTIONAL :: kcom
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zwork
-      INTEGER :: localcomm
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmin_real
-
-
-   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_real  ***
-      !!
-      !! ** Purpose :   global sum, REAL ARRAY argument case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
-      REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
-      INTEGER , INTENT( in ), OPTIONAL           :: kcom
-      !!
-      INTEGER                   ::   ierror    ! temporary integer
-      INTEGER                   ::   localcomm
-      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppsum_a_real
-
-
-   SUBROUTINE mppsum_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_real  ***
-      !!
-      !! ** Purpose :   global sum, SCALAR argument case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! input scalar
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom
-      !!
-      INTEGER  ::   ierror, localcomm
+      INTEGER  ::   ierror, ilocalcomm
       REAL(wp) ::   zwork
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, ilocalcomm, ierror )
       ptab = zwork
-      !
+   END SUBROUTINE mppmin_real
+
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
+   !!   
+   !!   Global sum of 1D array or a variable (integer, real or complex)
+   !!----------------------------------------------------------------------
+   !!
+   SUBROUTINE mppsum_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   )                   ::   kdim   ! ???
+      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ???
+      INTEGER :: ierror
+      INTEGER, DIMENSION (kdim) ::  iwork
+      !!----------------------------------------------------------------------
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      ktab(:) = iwork(:)
+   END SUBROUTINE mppsum_a_int
+   !!
+   SUBROUTINE mppsum_int( ktab )
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout) ::   ktab
+      INTEGER :: ierror, iwork
+      !!----------------------------------------------------------------------
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      ktab = iwork
+   END SUBROUTINE mppsum_int
+   !!
+   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
+      !!-----------------------------------------------------------------------
+      INTEGER                  , INTENT(in   ) ::   kdim   ! size of ptab
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab   ! input array
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom   ! specific communicator
+      INTEGER  ::   ierror, ilocalcomm    ! local integer
+      REAL(wp) ::   zwork(kdim)           ! local workspace
+      !!-----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, ilocalcomm, ierror )
+      ptab(:) = zwork(:)
+   END SUBROUTINE mppsum_a_real
+   !!
+   SUBROUTINE mppsum_real( ptab, kcom )
+      !!-----------------------------------------------------------------------
+      REAL(wp)          , INTENT(inout)           ::   ptab   ! input scalar
+      INTEGER , OPTIONAL, INTENT(in   ) ::   kcom
+      INTEGER  ::   ierror, ilocalcomm
+      REAL(wp) ::   zwork
+      !!-----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, ilocalcomm, ierror )
+      ptab = zwork
    END SUBROUTINE mppsum_real
-
-
+   !!
    SUBROUTINE mppsum_realdd( ytab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_realdd ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                SCALAR argument case for double-double precision
-      !!
       !!-----------------------------------------------------------------------
-      COMPLEX(wp), INTENT(inout)           ::   ytab    ! input scalar
-      INTEGER    , INTENT(in   ), OPTIONAL ::   kcom
-      !
-      INTEGER     ::   ierror
-      INTEGER     ::   localcomm
+      COMPLEX(wp)          , INTENT(inout) ::   ytab    ! input scalar
+      INTEGER    , OPTIONAL, INTENT(in   ) ::   kcom
+      INTEGER     ::   ierror, ilocalcomm
       COMPLEX(wp) ::   zwork
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      ! reduce local sums into global sum
-      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL MPI_ALLREDUCE( ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror )
       ytab = zwork
-      !
    END SUBROUTINE mppsum_realdd
-
-
+   !!
    SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
       !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_realdd  ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                COMPLEX ARRAY case for double-double precision
-      !!
-      !!-----------------------------------------------------------------------
       INTEGER                     , INTENT(in   ) ::   kdim   ! size of ytab
       COMPLEX(wp), DIMENSION(kdim), INTENT(inout) ::   ytab   ! input array
       INTEGER    , OPTIONAL       , INTENT(in   ) ::   kcom
-      !
-      INTEGER:: ierror, localcomm    ! local integer
+      INTEGER:: ierror, ilocalcomm    ! local integer
       COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror )
       ytab(:) = zwork(:)
-      !
    END SUBROUTINE mppsum_a_realdd
+   
+
+   SUBROUTINE mppmax_real_multiple( pt1d, kdim, kcom  )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_real  ***
+      !!
+      !! ** Purpose :   Maximum across processor of each element of a 1D arrays
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   pt1d   ! 1D arrays
+      INTEGER                  , INTENT(in   ) ::   kdim
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom   ! local communicator
+      !!
+      INTEGER  ::   ierror, ilocalcomm
+      REAL(wp), DIMENSION(kdim) ::  zwork
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      !
+      CALL mpi_allreduce( pt1d, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror )
+      pt1d(:) = zwork(:)
+      !
+   END SUBROUTINE mppmax_real_multiple
 
 
@@ -2243,5 +1022,5 @@
       REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
       REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
+      INTEGER                      , INTENT(  out) ::   ki, kj  ! index of minimum in global frame
       !
       INTEGER :: ierror
@@ -2251,6 +1030,6 @@
       !!-----------------------------------------------------------------------
       !
-      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1._wp )
+      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2279,9 +1058,9 @@
       !!
       !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
-      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                  , INTENT(  out) ::   pmin         ! Global minimum of ptab
+      INTEGER                   , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
+      !
       INTEGER  ::   ierror
       REAL(wp) ::   zmin     ! local minimum
@@ -2290,6 +1069,6 @@
       !!-----------------------------------------------------------------------
       !
-      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1._wp )
+      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2297,6 +1076,6 @@
       kk = ilocs(3)
       !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj+100000000.*kk
+      zain(1,:) = zmin
+      zain(2,:) = ki + 10000.*kj + 100000000.*kk
       !
       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
@@ -2331,6 +1110,6 @@
       !!-----------------------------------------------------------------------
       !
-      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1._wp )
+      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2359,17 +1138,17 @@
       !!
       !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
-      !!
-      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                   , INTENT(  out) ::   pmax         ! Global maximum of ptab
+      INTEGER                    , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
+      !
+      INTEGER  ::   ierror   ! local integer
+      REAL(wp) ::   zmax     ! local maximum
       REAL(wp), DIMENSION(2,1) ::   zain, zaout
       INTEGER , DIMENSION(3)   ::   ilocs
-      INTEGER :: ierror
       !!-----------------------------------------------------------------------
       !
-      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1._wp )
+      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2377,6 +1156,6 @@
       kk = ilocs(3)
       !
-      zain(1,:)=zmax
-      zain(2,:)=ki+10000.*kj+100000000.*kk
+      zain(1,:) = zmax
+      zain(2,:) = ki + 10000.*kj + 100000000.*kk
       !
       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
@@ -2438,5 +1217,4 @@
 
    SUBROUTINE mpp_comm_free( kcom )
-      !!----------------------------------------------------------------------
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kcom
@@ -2696,462 +1474,4 @@
 
 
-   SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_3d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      !                                                              !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr, jk
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
-
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )
-      ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) ) 
-
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      znorthloc(:,:,:) = 0
-      DO jk = 1, jpk
-         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
-            ij = jj - nlcj + ijpj
-            znorthloc(:,ij,jk) = pt3d(:,jj,jk)
-         END DO
-      END DO
-      !
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * jpk * ijpj
-
-      IF ( l_north_nogather ) THEN
-         !
-        ztabr(:,:,:) = 0
-        ztabl(:,:,:) = 0
-
-        DO jk = 1, jpk
-           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-              ij = jj - nlcj + ijpj
-              DO ji = nfsloop, nfeloop
-                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk)
-              END DO
-           END DO
-        END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille, iproc)
-              DO jk = 1, jpk
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)
-                    END DO
-                 END DO
-              END DO
-           ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jk = 1, jpk
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk)
-                    END DO
-                 END DO
-              END DO
-           ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF    
-            END DO
-         ENDIF
-         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
-         DO jk = 1, jpk
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-               ij = jj - nlcj + ijpj
-               DO ji= 1, nlci
-                  pt3d(ji,jj,jk) = ztabl(ji,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-
-      ELSE
-         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
-            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:,:) = 0.e0
-         DO jr = 1, ndim_rank_north         ! recover the global north array
-            iproc = nrank_north(jr) + 1
-            ildi  = nldit (iproc)
-            ilei  = nleit (iproc)
-            iilb  = nimppt(iproc)
-            DO jk = 1, jpk
-               DO jj = 1, ijpj
-                  DO ji = ildi, ilei
-                    ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
-                  END DO
-               END DO
-            END DO
-         END DO
-         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jk = 1, jpk
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-               ij = jj - nlcj + ijpj
-               DO ji= 1, nlci
-                  pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-      ! The ztab array has been either:
-      !  a. Fully populated by the mpi_allgather operation or
-      !  b. Had the active points for this domain and northern neighbours populated
-      !     by peer to peer exchanges
-      ! Either way the array may be folded by lbc_nfd and the result for the span of
-      ! this domain will be identical.
-      !
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr ) 
-      !
-   END SUBROUTINE mpp_lbc_north_3d
-
-
-   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the b.c. is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztabl, ztabr
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) )
-      ALLOCATE( ztabl(jpi,4), ztabr(jpi*jpmaxngh, 4) ) 
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
-         ij = jj - nlcj + ijpj
-         znorthloc(:,ij) = pt2d(:,jj)
-      END DO
-
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-      IF ( l_north_nogather ) THEN
-         !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
-         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
-         !
-         ztabr(:,:) = 0
-         ztabl(:,:) = 0
-
-         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-            ij = jj - nlcj + ijpj
-              DO ji = nfsloop, nfeloop
-               ztabl(ji,ij) = pt2d(ji,jj)
-            END DO
-         END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille, iproc)
-              DO jj = 1, ijpj
-                 DO ji = ildi, ilei
-                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj)
-                 END DO
-              END DO
-            ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jj = 1, ijpj
-                 DO ji = ildi, ilei
-                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)
-                 END DO
-              END DO
-            ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF
-            END DO
-         ENDIF
-         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-            ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
-               pt2d(ji,jj) = ztabl(ji,ij)
-            END DO
-         END DO
-         !
-      ELSE
-         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
-            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:) = 0.e0
-         DO jr = 1, ndim_rank_north            ! recover the global north array
-            iproc = nrank_north(jr) + 1
-            ildi = nldit (iproc)
-            ilei = nleit (iproc)
-            iilb = nimppt(iproc)
-            DO jj = 1, ijpj
-               DO ji = ildi, ilei
-                  ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
-               END DO
-            END DO
-         END DO
-         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-            ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
-               pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
-            END DO
-         END DO
-         !
-      ENDIF
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr ) 
-      !
-   END SUBROUTINE mpp_lbc_north_2d
-
-   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1
-      !!              (for multiple 2d arrays )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr, jk
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields),   &
-            &   znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions
-      ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) )
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      
-      DO jk = 1, num_fields
-         DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable)
-            ij = jj - nlcj + ijpj
-            znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj)
-         END DO
-      END DO
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-                                                                  
-      IF ( l_north_nogather ) THEN
-         !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
-         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
-         !
-         ztabr(:,:,:) = 0
-         ztabl(:,:,:) = 0
-
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-               ij = jj - nlcj + ijpj
-               DO ji = nfsloop, nfeloop
-                  ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj)
-               END DO
-            END DO
-         END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-               CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times
-              DO jk = 1 , num_fields
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)       ! Modified to 3D
-                    END DO
-                 END DO
-              END DO
-            ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jk = 1, num_fields
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                          ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj)       ! Modified to 3D
-                    END DO
-                 END DO
-              END DO
-            ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF
-            END DO
-         ENDIF
-         !
-         DO ji = 1, num_fields     ! Loop to manage 3D variables
-            CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition
-         END DO
-         !
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-               ij = jj - nlcj + ijpj
-               DO ji = 1, nlci
-                  pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk)       ! Modified to 3D
-               END DO
-            END DO
-         END DO
-         
-         !
-      ELSE
-         !
-         CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        &
-            &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:,:) = 0.e0
-         DO jk = 1, num_fields
-            DO jr = 1, ndim_rank_north            ! recover the global north array
-               iproc = nrank_north(jr) + 1
-               ildi = nldit (iproc)
-               ilei = nleit (iproc)
-               iilb = nimppt(iproc)
-               DO jj = 1, ijpj
-                  DO ji = ildi, ilei
-                     ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
-                  END DO
-               END DO
-            END DO
-         END DO
-         
-         DO ji = 1, num_fields
-            CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition
-         END DO
-         !
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-               ij = jj - nlcj + ijpj
-               DO ji = 1, nlci
-                  pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-         !
-      ENDIF
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr )
-      !
-   END SUBROUTINE mpp_lbc_north_2d_multiple
-
    SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
       !!---------------------------------------------------------------------
@@ -3171,40 +1491,36 @@
       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
       CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
-      !                                                                                         !   = T ,  U , V , F or W -points
-      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
-      !!                                                                                        ! north fold, =  1. otherwise
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! sign used across the north fold
+      !
       INTEGER ::   ji, jj, jr
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ij, iproc
-      !
       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
-
       !!----------------------------------------------------------------------
       !
       ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) )
-
       !
       ijpj=4
-      ztab_e(:,:) = 0.e0
-
-      ij=0
+      ztab_e(:,:) = 0._wp
+
+      ij = 0
       ! put in znorthloc_e the last 4 jlines of pt2d
       DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
          ij = ij + 1
          DO ji = 1, jpi
-            znorthloc_e(ji,ij)=pt2d(ji,jj)
+            znorthloc_e(ji,ij) = pt2d(ji,jj)
          END DO
       END DO
       !
       itaille = jpi * ( ijpj + 2 * jpr2dj )
-      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
          &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
       !
       DO jr = 1, ndim_rank_north            ! recover the global north array
          iproc = nrank_north(jr) + 1
-         ildi = nldit (iproc)
-         ilei = nleit (iproc)
-         iilb = nimppt(iproc)
+         ildi  = nldit (iproc)
+         ilei  = nleit (iproc)
+         iilb  = nimppt(iproc)
          DO jj = 1, ijpj+2*jpr2dj
             DO ji = ildi, ilei
@@ -3214,8 +1530,7 @@
       END DO
 
-
       ! 2. North-Fold boundary conditions
       ! ----------------------------------
-      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
+!!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
 
       ij = jpr2dj
@@ -3231,434 +1546,4 @@
       !
    END SUBROUTINE mpp_lbc_north_e
-
-
-   SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_3d  ***
-      !!
-      !! ** Purpose :   Message passing management
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      !
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! local integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland                      ! local scalar
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      zland = 0._wp
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                        !* Cyclic east-west
-      IF( nbondi == 2) THEN
-         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE
-            IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
-            ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
-         ENDIF
-      ELSEIF(nbondi == -1) THEN
-         IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-         ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
-      ENDIF                                     !* closed
-
-      IF (nbondj == 2 .OR. nbondj == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(:,1:jprecj,:) = zland       ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-        ptab(:,nlcj-jprecj+1:jpj,:) = zland       ! north
-      ENDIF
-      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(      jl,:,:) = zt3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(      jl,:,:) = zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = zt3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
-      !
-   END SUBROUTINE mpp_lnk_bdy_3d
-
-
-   SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_2d  ***
-      !!
-      !! ** Purpose :   Message passing management
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      !
-      INTEGER  ::   ji, jj, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! local integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-      !!----------------------------------------------------------------------
-
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-
-      zland = 0._wp
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                      !* Cyclic east-west
-      IF( nbondi == 2 ) THEN
-         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-            ptab( 1 ,:) = ptab(jpim1,:)
-            ptab(jpi,:) = ptab(  2  ,:)
-         ELSE
-            IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point
-                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-      ELSEIF(nbondi == -1) THEN
-         IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-      ENDIF
-      !                                      !* closed
-      IF( nbondj == 2 .OR. nbondj == -1 ) THEN
-         IF( .NOT.cd_type == 'F' )    ptab(:,     1       :jprecj) = zland    ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-                                      ptab(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-      ENDIF
-      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = ptab(jpreci+jl,:)
-            zt2we(:,jl,1) = ptab(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = zt2we(:,jl,2)
-            ptab(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = ptab(:,ijhom +jl)
-            zt2ns(:,jl,1) = ptab(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ) = zt2sn(:,jl,2)
-            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl) = zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we  )
-      !
-   END SUBROUTINE mpp_lnk_bdy_2d
 
 
@@ -3722,5 +1607,6 @@
    END SUBROUTINE mpi_init_opa
 
-   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype)
+
+   SUBROUTINE DDPDD_MPI( ydda, yddb, ilen, itype )
       !!---------------------------------------------------------------------
       !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
@@ -3729,13 +1615,14 @@
       !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)                         :: ilen, itype
-      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda
-      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb
+      INTEGER                     , INTENT(in)    ::   ilen, itype
+      COMPLEX(wp), DIMENSION(ilen), INTENT(in)    ::   ydda
+      COMPLEX(wp), DIMENSION(ilen), INTENT(inout) ::   yddb
       !
       REAL(wp) :: zerr, zt1, zt2    ! local work variables
-      INTEGER :: ji, ztmp           ! local scalar
-
+      INTEGER  :: ji, ztmp           ! local scalar
+      !!---------------------------------------------------------------------
+      !
       ztmp = itype   ! avoid compilation warning
-
+      !
       DO ji=1,ilen
       ! Compute ydda + yddb using Knuth's trick.
@@ -3748,5 +1635,5 @@
          yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
       END DO
-
+      !
    END SUBROUTINE DDPDD_MPI
 
@@ -3818,8 +1705,7 @@
       END DO
 
-
       ! 2. North-Fold boundary conditions
       ! ----------------------------------
-      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj )
+!!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj )
 
       ij = ipr2dj
@@ -3857,21 +1743,18 @@
       !!                    nono   : number for local neighboring processors
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! sign used across the north fold
       INTEGER                                             , INTENT(in   ) ::   jpri
       INTEGER                                             , INTENT(in   ) ::   jprj
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      !                                                                                 ! = T , U , V , F , W and I points
-      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
-      !!                                                                                ! north boundary, =  1. otherwise
+      !
       INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ipreci, iprecj             ! temporary integers
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ipreci, iprecj             !   -       -
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
       !!
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) ::   r2dns, r2dsn
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) ::   r2dwe, r2dew
       !!----------------------------------------------------------------------
 
@@ -3891,6 +1774,6 @@
          !
       ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp    ! north
       ENDIF
       !
@@ -3901,6 +1784,6 @@
          !
          SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  )
+!!gm ERROR         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+!!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  )
          END SELECT
          !
@@ -4012,5 +1895,5 @@
          END DO
       END SELECT
-
+      !
    END SUBROUTINE mpp_lnk_2d_icb
    
@@ -4036,4 +1919,7 @@
       MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
    END INTERFACE
+   INTERFACE mpp_max_multiple
+      MODULE PROCEDURE mppmax_real_multiple
+   END INTERFACE
 
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
@@ -4207,4 +2093,12 @@
       WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
    END SUBROUTINE mpp_comm_free
+   
+   SUBROUTINE mppmax_real_multiple( ptab, kdim , kcom  )
+      REAL, DIMENSION(:) ::   ptab   ! 
+      INTEGER            ::   kdim   ! 
+      INTEGER, OPTIONAL  ::   kcom   ! 
+      WRITE(*,*) 'mppmax_real_multiple: You should not have seen this print! error?', ptab(1), kdim
+   END SUBROUTINE mppmax_real_multiple
+
 #endif
 
@@ -4241,5 +2135,5 @@
                                CALL FLUSH(numout    )
       IF( numstp     /= -1 )   CALL FLUSH(numstp    )
-      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
+      IF( numrun     /= -1 )   CALL FLUSH(numrun    )
       IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
       !
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_bdy_generic.h90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_bdy_generic.h90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_bdy_generic.h90	(revision 8879)
@@ -0,0 +1,298 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define IBD_IN(k)                kb_bdy(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define IBD_IN(k)                kb_bdy
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_BDY( ptab, cd_nat, psgn, kfld, kb_bdy )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_BDY( ptab, cd_nat, psgn      , kb_bdy )
+#endif
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_3d  ***
+      !!
+      !! ** Purpose :   Message passing management
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER                     , INTENT(in   ) ::   IBD_IN(:)   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jk, jl, jh, jf     ! dummy loop indices
+      INTEGER  ::   ipk, ipl, ipf              ! 3dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland                      ! local scalar
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !      
+      ALLOCATE( zt3ns(jpi,jprecj,ipk,ipl,ipf,2), zt3sn(jpi,jprecj,ipk,ipl,ipf,2),   &
+         &      zt3ew(jpj,jpreci,ipk,ipl,ipf,2), zt3we(jpj,jpreci,ipk,ipl,ipf,2)  )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      DO jf = 1, ipf                   ! number of arrays to be treated
+         !
+         !                                ! East-West boundaries
+         !                    
+         IF( nbondi == 2) THEN                  ! neither subdomain to the east nor to the west
+            !                                      !* Cyclic
+            IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* Closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :jpreci,:,:,:,jf) = zland  ! east except F-point
+                                               ARRAY_IN(nlci-jpreci+1:jpi   ,:,:,:,jf) = zland  ! west
+            ENDIF
+         ELSEIF(nbondi == -1) THEN              ! subdomain to the east only
+            IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(1:jpreci,:,:,:,jf) = zland     ! south except F-point
+            !
+         ELSEIF(nbondi == 1) THEN               ! subdomain to the west only
+            ARRAY_IN(nlci-jpreci+1:jpi,:,:,:,jf) = zland    ! north
+         ENDIF
+         !                                ! North-South boundaries
+         !
+         IF (nbondj == 2 .OR. nbondj == -1) THEN      !* closed
+           IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,1:jprecj,:,:,jf) = zland            ! south except F-point
+         ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+                                           ARRAY_IN(:,nlcj-jprecj+1:jpj,:,:,jf) = zland   ! north
+         ENDIF
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      !
+      DO jf = 1, ipf
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jh = 1, jpreci
+                        zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(jpreci+jh,:,jk,jl,jf)
+                        zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+         END SELECT
+         !
+         !                           ! Migrations
+!!gm      imigr = jpreci * jpj * ipk * ipl * ipf
+         imigr = jpreci * jpj * ipk * ipl
+         !
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         !                           ! Write Dirichlet lateral conditions
+         iihom = nlci-jpreci
+         !
+         !
+         SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+         !
+      END DO
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      DO jf = 1, ipf
+         IF( nbondj_bdy(IBD_IN(jf)) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,jprecj+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         !                           ! Migrations
+!!gm      imigr = jprecj * jpi * ipk * ipl * ipf
+         imigr = jprecj * jpi * ipk * ipl
+         !
+         SELECT CASE ( nbondj_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         !                           ! Write Dirichlet lateral conditions
+         ijhom = nlcj-jprecj
+         !
+         SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+      END DO
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
+      !
+   END SUBROUTINE ROUTINE_BDY
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef IBD_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90	(revision 8879)
@@ -0,0 +1,310 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define OPT_K(k)                 ,ipf
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define OPT_K(k)                 
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom          ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
+      REAL(wp) ::   zland
+      LOGICAL  ::   ll_Iperio, ll_Jperio
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! north-south & south-north  halos
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! east -west  & west - east  halos
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ALLOCATE( zt3ns(jpi,jprecj,ipk,ipl,ipf,2), zt3sn(jpi,jprecj,ipk,ipl,ipf,2),   &
+         &      zt3ew(jpj,jpreci,ipk,ipl,ipf,2), zt3we(jpj,jpreci,ipk,ipl,ipf,2)  )
+      !
+      ll_Iperio = nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6)
+      ll_Jperio = nbondj == 2 .AND.  jperio == 7
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( PRESENT( cd_mpp ) ) THEN     !==  halos filled with inner values  ==!
+         !
+         DO jf = 1, ipf                      ! number of arrays to be treated
+            !
+            DO jl = 1, ipl                   ! CAUTION: ptab is defined only between nld and nle
+               DO jk = 1, ipk
+                  DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+                     ARRAY_IN(nldi  :nlei  ,jj,jk,jl,jf) = ARRAY_IN(nldi:nlei,nlej,jk,jl,jf)
+                     ARRAY_IN(1     :nldi-1,jj,jk,jl,jf) = ARRAY_IN(nldi     ,nlej,jk,jl,jf)
+                     ARRAY_IN(nlei+1:nlci  ,jj,jk,jl,jf) = ARRAY_IN(     nlei,nlej,jk,jl,jf)
+                  END DO
+                  DO ji = nlci+1, jpi                 ! added column(s) (full)
+                     ARRAY_IN(ji,nldj  :nlej  ,jk,jl,jf) = ARRAY_IN(nlei,nldj:nlej,jk,jl,jf)
+                     ARRAY_IN(ji,1     :nldj-1,jk,jl,jf) = ARRAY_IN(nlei,nldj     ,jk,jl,jf)
+                     ARRAY_IN(ji,nlej+1:jpj   ,jk,jl,jf) = ARRAY_IN(nlei,     nlej,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+         !
+      ELSE                              !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                      ! number of arrays to be treated
+            !
+            !                             ! East-West boundaries
+            IF( ll_Iperio ) THEN                   !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :jpreci,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(nlci-jpreci+1:jpi   ,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( ll_Jperio ) THEN                   !* cyclic (only with no mpp j-split)
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :jprecj,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,nlcj-jprecj+1:jpj   ,:,:,jf) = zland    ! north
+            ENDIF
+         END DO
+         !
+      ENDIF
+
+      ! ------------------------------- !
+      !      East and west exchange     !
+      ! ------------------------------- !
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(jpreci+jh,:,jk,jl,jf)
+                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * ipk * ipl * ipf
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,jprecj+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * ipk * ipl * ipf
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_nfd_generic.h90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_nfd_generic.h90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_nfd_generic.h90	(revision 8879)
@@ -0,0 +1,242 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define LBC_ARG                  (jf)
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define LBC_ARG
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom             ! local integers
+      INTEGER  ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER  ::   ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather
+      INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat     ! for mpi_isend when avoiding mpi_allgather
+      !                                                    ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, ztabl, ztabr
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ipj   = 4            ! 2nd dimension of message transfers (last j-lines)
+      !
+      ALLOCATE( znorthloc(jpi,4,ipk,ipl,ipf) )
+      !
+      znorthloc(:,:,:,:,:) = 0._wp
+      !
+      DO jf = 1, ipf                ! put in znorthloc the last ipj j-lines of ptab
+         DO jl = 1, ipl
+            DO jk = 1, ipk
+               DO jj = nlcj - ipj +1, nlcj
+                  ij = jj - nlcj + ipj
+                  znorthloc(:,ij,jk,jl,jf) = ARRAY_IN(:,jj,jk,jl,jf)
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      !
+      itaille = jpi * ipj * ipk * ipl * ipf
+      !
+      IF( l_north_nogather ) THEN      !==  ????  ==!
+         ALLOCATE( zfoldwk(jpi,4,ipk,ipl,ipf) )
+         ALLOCATE( ztabl(jpi   ,4,ipk,ipl,ipf) , ztabr(jpi*jpmaxngh,4,ipk,ipl,ipf) ) 
+         !
+         ztabr(:,:,:,:,:) = 0._wp
+         ztabl(:,:,:,:,:) = 0._wp
+         !
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj          ! First put local values into the global array
+                     ij = jj - nlcj + ipj
+                     DO ji = nfsloop, nfeloop
+                        ztabl(ji,ij,jk,jl,jf) = ARRAY_IN(ji,jj,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DO jr = 1, nsndto
+            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc /= -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
+               DO jf = 1, ipf
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO jj = 1, ipj
+                           DO ji = ildi, ilei
+                              ztabr(iilb+ji,jj,jk,jl,jf) = zfoldwk(ji,jj,jk,jl,jf)
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ELSE IF( iproc == narea-1 ) THEN
+               DO jf = 1, ipf
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO jj = 1, ipj
+                           DO ji = ildi, ilei
+                              ztabr(iilb+ji,jj,jk,jl,jf) = ARRAY_IN(ji,nlcj-ipj+jj,jk,jl,jf)
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+         IF( l_isend ) THEN
+            DO jr = 1,nsndto
+               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+                  CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )
+               ENDIF    
+            END DO
+         ENDIF
+         DO jf = 1, ipf
+            CALL lbc_nfd_nogather( ztabl(:,:,:,:,jf), ztabr(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition
+         END DO
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN
+                     ij = jj - nlcj + ipj
+                     DO ji= 1, nlci
+                        ARRAY_IN(ji,jj,jk,jl,jf) = ztabl(ji,ij,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DEALLOCATE( zfoldwk )
+         DEALLOCATE( ztabl, ztabr ) 
+      ELSE                             !==  ????  ==!
+         ALLOCATE( ztab       (jpiglo,4,ipk,ipl,ipf     ) )
+         ALLOCATE( znorthgloio(jpi   ,4,ipk,ipl,ipf,jpni) )
+         !
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:,:,:,:) = 0._wp
+         DO jr = 1, ndim_rank_north         ! recover the global north array
+            iproc = nrank_north(jr) + 1
+            ildi  = nldit (iproc)
+            ilei  = nleit (iproc)
+            iilb  = nimppt(iproc)
+            DO jf = 1, ipf
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jj = 1, ipj
+                        DO ji = ildi, ilei
+                           ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr)
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         DO jf = 1, ipf
+            CALL lbc_nfd( ztab(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition
+         END DO
+         !
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN
+                     ij = jj - nlcj + ipj
+                     DO ji= 1, nlci
+                        ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      !
+         DEALLOCATE( ztab )
+         DEALLOCATE( znorthgloio )
+      ENDIF
+      !
+      ! The ztab array has been either:
+      !  a. Fully populated by the mpi_allgather operation or
+      !  b. Had the active points for this domain and northern neighbours populated
+      !     by peer to peer exchanges
+      ! Either way the array may be folded by lbc_nfd and the result for the span of
+      ! this domain will be identical.
+      !
+      DEALLOCATE( znorthloc )
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef LBC_ARG
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 8879)
@@ -291,5 +291,5 @@
             END DO
          ENDIF
-#if defined key_lim2 || defined key_lim3
+#if defined key_lim3
          IF (ln_sic) THEN
             jtype = jtype + 1
@@ -539,9 +539,5 @@
 #if defined  key_lim3
       USE ice, ONLY : &            ! LIM3 Ice model variables
-         & frld
-#endif
-#if defined key_lim2
-      USE ice_2, ONLY : &          ! LIM2 Ice model variables
-         & frld
+         & at_i
 #endif
       IMPLICIT NONE
@@ -567,6 +563,6 @@
          & zgphi1,    &            ! Model latitudes for prof variable 1
          & zgphi2                  ! Model latitudes for prof variable 2
-#if ! defined key_lim2 && ! defined key_lim3
-      REAL(wp), POINTER, DIMENSION(:,:) :: frld
+#if ! defined key_lim3
+      REAL(wp), POINTER, DIMENSION(:,:) :: at_i
 #endif
       LOGICAL :: llnightav        ! Logical for calculating night-time average
@@ -582,6 +578,6 @@
       CALL wrk_alloc( jpi, jpj, zgphi1 )
       CALL wrk_alloc( jpi, jpj, zgphi2 )
-#if ! defined key_lim2 && ! defined key_lim3
-      CALL wrk_alloc(jpi,jpj,frld) 
+#if ! defined key_lim3
+      CALL wrk_alloc(jpi,jpj,at_i) 
 #endif
 
@@ -595,8 +591,8 @@
 
       !-----------------------------------------------------------------------
-      ! No LIM => frld == 0.0_wp
-      !-----------------------------------------------------------------------
-#if ! defined key_lim2 && ! defined key_lim3
-      frld(:,:) = 0.0_wp
+      ! No LIM => at_i == 0.0_wp
+      !-----------------------------------------------------------------------
+#if ! defined key_lim3
+      at_i(:,:) = 0.0_wp
 #endif
       !-----------------------------------------------------------------------
@@ -665,5 +661,5 @@
                zsurfvar(:,:) = sshn(:,:)
                llnightav = .FALSE.
-#if defined key_lim2 || defined key_lim3
+#if defined key_lim3
             CASE('sic')
                IF ( kstp == 0 ) THEN
@@ -678,5 +674,5 @@
                   CYCLE
                ELSE
-                  zsurfvar(:,:) = 1._wp - frld(:,:)
+                  zsurfvar(:,:) = at_i(:,:)
                ENDIF
 
@@ -702,6 +698,6 @@
       CALL wrk_dealloc( jpi, jpj, zgphi1 )
       CALL wrk_dealloc( jpi, jpj, zgphi2 )
-#if ! defined key_lim2 && ! defined key_lim3
-      CALL wrk_dealloc(jpi,jpj,frld)
+#if ! defined key_lim3
+      CALL wrk_dealloc(jpi,jpj,at_i)
 #endif
 
Index: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 8878)
+++ 	(revision )
@@ -1,270 +1,0 @@
-MODULE albedo
-   !!======================================================================
-   !!                       ***  MODULE  albedo  ***
-   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice)
-   !!=====================================================================
-   !! History :  8.0  ! 2001-04  (LIM 1.0)
-   !!   NEMO     1.0  ! 2003-07  (C. Ethe, G. Madec)  Optimization (old name:shine)
-   !!             -   ! 2004-11  (C. Talandier)  add albedo_init
-   !!             -   ! 2001-06  (M. Vancoppenolle) LIM 3.0
-   !!             -   ! 2006-08  (G. Madec)  cleaning for surface module
-   !!            3.6  ! 2016-01  (C. Rousset) new parameterization for sea ice albedo
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   albedo_ice    : albedo for   ice (clear and overcast skies)
-   !!   albedo_oce    : albedo for ocean (clear and overcast skies)
-   !!   albedo_init   : initialisation of albedo computation
-   !!----------------------------------------------------------------------
-   USE phycst         ! physical constants
-   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   albedo_ice   ! routine called sbcice_lim.F90
-   PUBLIC   albedo_oce   ! routine called by ???
-
-   INTEGER  ::   albd_init = 0      !: control flag for initialization
-  
-   REAL(wp) ::   rmue     = 0.40    !  cosine of local solar altitude
-   REAL(wp) ::   ralb_oce = 0.066   ! ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001)
-   REAL(wp) ::   c1       = 0.05    ! snow thickness (only for nn_ice_alb=0)
-   REAL(wp) ::   c2       = 0.10    !  "        "
-   REAL(wp) ::   rcloud   = 0.06    ! cloud effect on albedo (only-for nn_ice_alb=0)
- 
-   !                             !!* namelist namsbc_alb
-   INTEGER  ::   nn_ice_alb
-   REAL(wp) ::   rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE albedo_ice( pt_ice, ph_ice, ph_snw, pa_ice_cs, pa_ice_os )
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE albedo_ice  ***
-      !!          
-      !! ** 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)
-      !!                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 thickness
-      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
-      INTEGER  ::   ijpl               ! number of ice categories (3rd dim of ice input arrays)
-      REAL(wp)            ::   zswitch, z1_c1, z1_c2
-      REAL(wp)                            ::   zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalb_it             ! intermediate variable & albedo of ice (snow free)
-      !!---------------------------------------------------------------------
-
-      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories
-      
-      CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it )
-
-      IF( albd_init == 0 )   CALL albedo_init      ! initialization 
-      
-      SELECT CASE ( nn_ice_alb )
-
-      !------------------------------------------
-      !  Shine and Henderson-Sellers (1985)
-      !------------------------------------------
-      CASE( 0 )
-       
-         !  Computation of ice albedo (free of snow)
-         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = rn_alb_imlt
-         ELSE WHERE                                              ;   zalb(:,:,:) = rn_alb_idry
-         END  WHERE
-      
-         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb
-         ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = 0.472  + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 )
-         ELSE WHERE( 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
-         ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice
-         END WHERE
-     
-         DO jl = 1, ijpl
-            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 > c2
-                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) )
-                  zalb_sf   = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  &
-                     &                           + ph_snw(ji,jj,jl) * ( rn_alb_sdry - zalb_it(ji,jj,jl) ) / c1  )   &
-                     &        +         zswitch   * rn_alb_sdry  
-
-                  ! melting snow
-                  ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > c2
-                  zswitch   = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) )
-                  zalb_sm = ( 1._wp - zswitch ) * ( rn_alb_imlt + ph_snw(ji,jj,jl) * ( rn_alb_smlt - rn_alb_imlt ) / 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
-               
-                  ! Ice/snow 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(:,:,:) + rcloud       ! Oberhuber correction for overcast sky
-
-      !------------------------------------------
-      !  New parameterization (2016)
-      !------------------------------------------
-      CASE( 1 ) 
-
-! compilation of values from literature
-!        rn_alb_sdry = 0.85      ! dry snow
-!        rn_alb_smlt = 0.75      ! melting snow
-!        rn_alb_idry = 0.60      ! bare frozen ice
-! 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 ice albedo (free of snow)
-         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
-         z1_c2 = 1. / 0.05
-         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = rn_alb_imlt
-         ELSE WHERE                                              ;   zalb = rn_alb_idry
-         END  WHERE
-         
-         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 = ralb_oce + ( 0.18 - ralb_oce ) * z1_c2 * ph_ice
-         END WHERE
-
-         z1_c1 = 1. / 0.02
-         z1_c2 = 1. / 0.03
-         !  Computation of the snow/ice albedo
-         DO jl = 1, ijpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  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
-                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
-                  zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
-
-                  ! Ice/snow 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
-         ! Effect of the clouds (2d order polynomial)
-         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 
-
-      END SELECT
-      
-      CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it )
-      !
-   END SUBROUTINE albedo_ice
-
-
-   SUBROUTINE albedo_oce( pa_oce_os , pa_oce_cs )
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE albedo_oce  ***
-      !! 
-      !! ** Purpose :   Computation of the albedo of the ocean
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky
-      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky
-      !!
-      REAL(wp) :: zcoef 
-      !!----------------------------------------------------------------------
-      !
-      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982
-      pa_oce_cs(:,:) = zcoef 
-      pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972
-      !
-   END SUBROUTINE albedo_oce
-
-
-   SUBROUTINE albedo_init
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE albedo_init  ***
-      !!
-      !! ** Purpose :   initializations for the albedo parameters
-      !!
-      !! ** Method  :   Read the namelist namsbc_alb
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry , rn_alb_imlt
-      !!----------------------------------------------------------------------
-      !
-      albd_init = 1                     ! indicate that the initialization has been done
-      !
-      REWIND( numnam_ref )              ! Namelist namsbc_alb in reference namelist : Albedo parameters
-      READ  ( numnam_ref, namsbc_alb, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namsbc_alb in configuration namelist : Albedo parameters
-      READ  ( numnam_cfg, namsbc_alb, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namsbc_alb )
-      !
-      IF(lwp) THEN                      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'albedo : set albedo parameters'
-         WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '   Namelist namsbc_alb : albedo '
-         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
-      ENDIF
-      !
-   END SUBROUTINE albedo_init
-
-   !!======================================================================
-END MODULE albedo
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 8879)
@@ -116,5 +116,5 @@
    END TYPE WGT
 
-   INTEGER,     PARAMETER             ::   tot_wgts = 10
+   INTEGER,     PARAMETER             ::   tot_wgts = 20
    TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts
    INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/ocealb.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/ocealb.F90	(revision 8879)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/ocealb.F90	(revision 8879)
@@ -0,0 +1,49 @@
+MODULE ocealb
+   !!======================================================================
+   !!                       ***  MODULE  ocealb  ***
+   !! Ocean forcing:  bulk thermohaline forcing of the ocean
+   !!=====================================================================
+   !! History :
+   !!   NEMO     4.0  ! 2017-07  (C. Rousset) Split ocean and ice albedos
+   !!----------------------------------------------------------------------
+   !!   oce_alb    : albedo for ocean (clear and overcast skies)
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   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   oce_alb   ! routine called by sbccpl
+  
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2010)
+   !! $Id: ocealb.F90 8268 2017-07-03 15:01:04Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE oce_alb( palb_os , palb_cs )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE oce_alb  ***
+      !! 
+      !! ** Purpose :   Computation of the albedo of the ocean
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   palb_os   !  albedo of ocean under overcast sky
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   palb_cs   !  albedo of ocean under clear sky
+      !!
+      REAL(wp) ::   zcoef 
+      REAL(wp) ::   rmue = 0.40    !  cosine of local solar altitude
+      !!----------------------------------------------------------------------
+      !
+      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982
+      palb_cs(:,:) = zcoef 
+      palb_os(:,:) = 0.06                         ! Parameterization of Kondratyev, 1969 and Payne, 1972
+      !
+   END SUBROUTINE oce_alb
+
+   !!======================================================================
+END MODULE ocealb
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 8879)
@@ -9,7 +9,7 @@
    !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
    !!----------------------------------------------------------------------
-#if defined key_lim3 || defined key_lim2 || defined key_cice
-   !!----------------------------------------------------------------------
-   !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model
+#if defined key_lim3 || defined key_cice
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :             LIM-3 sea-ice model
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
@@ -18,8 +18,4 @@
    USE ice              ! LIM-3 parameters
 # endif
-# if defined key_lim2
-   USE par_ice_2        ! LIM-2 parameters
-   USE ice_2
-# endif
 # if defined key_cice
    USE ice_domain_size, only: ncat 
@@ -31,18 +27,7 @@
    PRIVATE
 
-   PUBLIC sbc_ice_alloc ! called in iceini(_2).F90
-
-# if defined  key_lim2
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE 
-#  if defined key_lim2_vp
-   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner)
-#  else
-   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: EVP: 'C'-grid ice-velocity
-#  endif
-# endif
+   PUBLIC sbc_ice_alloc ! called in sbcmod.F90
+
 # if defined  key_lim3
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2
    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model
    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE 
@@ -50,5 +35,4 @@
 # endif
 # if defined  key_cice
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2
    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3
    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .TRUE.   !: CICE ice model
@@ -64,8 +48,10 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-]
 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qml_ice        !: heat available for snow / ice surface melting     [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice        !: heat conduction flux in the layer below surface   [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_tr     !: solar flux transmitted below the ice surface      [W/m2]
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice       !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice          [kg/m2/s]
 
@@ -83,7 +69,7 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: enthalpy of precip over ice                 [J/m3]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s]
-#endif
-#if defined key_lim3 || defined key_lim2
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz       !: wind speed module at T-point                 [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tsfc_ice           !: sea ice surface skin temperature (on categories)
 #endif
 
@@ -102,21 +88,23 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point
+
    
    ! variables used in the coupled interface
    INTEGER , PUBLIC, PARAMETER ::   jpl = ncat
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj
-#endif
    
-#if defined key_lim2 || defined key_cice
    ! already defined in ice.F90 for LIM3
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s
-#endif
-
-#if defined key_cice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K]
 #endif
 
    REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-]
+
+   !! arrays relating to embedding ice in the ocean
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
 
    !!----------------------------------------------------------------------
@@ -131,23 +119,21 @@
       !!                     ***  FUNCTION sbc_ice_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(5)
+      INTEGER :: ierr(4)
       !!----------------------------------------------------------------------
       ierr(:) = 0
 
-#if defined key_lim3 || defined key_lim2
+      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) )
+
+#if defined key_lim3
       ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     &
          &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     &
-         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   &
+         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl)  , alb_ice (jpi,jpj,jpl) ,   &
+         &      qml_ice(jpi,jpj,jpl)  , qcn_ice(jpi,jpj,jpl)   , qsr_ice_tr(jpi,jpj,jpl),  &
          &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   &
-         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     &
-#if defined key_lim2
-         &      a_i(jpi,jpj,jpl)      ,                             &
-#endif
-#if defined key_lim3
          &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,   &
          &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) ,   &
          &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce (jpi,jpj)  ,   &
-#endif
-         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) )
+         &      emp_ice(jpi,jpj)      , tsfc_ice(jpi,jpj,jpl)  , sstfrz(jpi,jpj), &
+         STAT= ierr(2) )
 #endif
 
@@ -158,14 +144,10 @@
                 ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , &
                 a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , &
-                STAT= ierr(1) )
-      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , &
-         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , &
+                STAT= ierr(2) )
+      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , tn_ice (jpi,jpj,1)    , &
+         &                     v_ice(jpi,jpj)        , alb_ice(jpi,jpj,1)    , &
          &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , &
-         &                     STAT= ierr(2) )
-      
-#endif
-         !
-#if defined key_cice || defined key_lim2
-      IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )
+         &                     STAT= ierr(3) )      
+      IF( ln_cpl )   ALLOCATE( h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) , STAT=ierr(4) )
 #endif
 
@@ -177,8 +159,14 @@
 #else
    !!----------------------------------------------------------------------
-   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model
-   !!----------------------------------------------------------------------
+   !!   Default option                      NO LIM3 or CICE sea-ice model
+   !!----------------------------------------------------------------------
+   USE lib_mpp          ! MPP library
    USE in_out_manager   ! I/O manager
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sbc_ice_alloc
+
    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model
    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model
@@ -186,11 +174,33 @@
    REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-]
    INTEGER         , PUBLIC, PARAMETER ::   jpl = 1 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice                        ! jpi, jpj
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i, h_s
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt
+   !
+   !! arrays relating to embedding ice in the ocean. These arrays need to be declared 
+   !! even if no ice model is required. In the no ice model or traditional levitating 
+   !! ice cases they contain only zeros
+   !! ---------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
+
+CONTAINS
+   INTEGER FUNCTION sbc_ice_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  FUNCTION sbc_ice_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(1)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) )
+      sbc_ice_alloc = MAXVAL( ierr )
+      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc )
+      IF( sbc_ice_alloc > 0 )   CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed')
+   END FUNCTION sbc_ice_alloc
 #endif
 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 8879)
@@ -41,4 +41,5 @@
    LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation
    LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation
+   LOGICAL , PUBLIC ::   ln_meto_cpl    !: Met Office coupling formulation, with surface exchange carried out in atmosphere
    LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
    LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
@@ -47,14 +48,8 @@
    LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
    INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
-   INTEGER , PUBLIC ::   nn_ice_embd    !: flag for levitating/embedding sea-ice in the ocean
-   !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect)
-   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect
-   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure)
+   LOGICAL , PUBLIC ::   ln_ice_embd    !: flag for levitating/embedding sea-ice in the ocean
+   !                                             !: =F levitating ice with mass and salt exchange but no presure effect
+   !                                             !: =T embedded sea-ice (full salt and mass exchanges and pressure)
    INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 
-   INTEGER , PUBLIC ::   nn_limflx      !: LIM3 Multi-category heat flux formulation
-   !                                             !: =-1  Use of per-category fluxes
-   !                                             !: = 0  Average per-category fluxes
-   !                                             !: = 1  Average then redistribute per-category fluxes
-   !                                             !: = 2  Redistribute a single flux over categories
    INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget: 
    !                                             !:  = 0 unchecked 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90	(revision 8879)
@@ -17,4 +17,5 @@
    !!                                          ==> based on AeroBulk (http://aerobulk.sourceforge.net/)
    !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine
+   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce Jules emulator (M. Vancoppenolle) 
    !!----------------------------------------------------------------------
 
@@ -40,9 +41,7 @@
    USE lib_fortran    ! to use key_nosignedzero
 #if defined key_lim3
-   USE ice     , ONLY :   u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b
-   USE limthd_dh      ! for CALL lim_thd_snwblow
-#elif defined key_lim2
-   USE ice_2   , ONLY :   u_ice, v_ice
-   USE par_ice_2      ! LIM-2 parameters
+   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, tm_su
+   USE icethd_dh      ! for CALL ice_thd_snwblow
+   USE icethd_zdf, ONLY:   rn_cnd_s  ! for blk_ice_qcn
 #endif
    USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
@@ -64,8 +63,9 @@
    PUBLIC   sbc_blk_init  ! called in sbcmod
    PUBLIC   sbc_blk       ! called in sbcmod
-#if defined key_lim2 || defined key_lim3
-   PUBLIC   blk_ice_tau   ! routine called in sbc_ice_lim module
-   PUBLIC   blk_ice_flx   ! routine called in sbc_ice_lim module
-#endif
+#if defined key_lim3
+   PUBLIC   blk_ice_tau   ! routine called in icestp module
+   PUBLIC   blk_ice_flx   ! routine called in icestp module
+   PUBLIC   blk_ice_qcn   ! routine called in icestp module
+#endif 
 
 !!Lolo: should ultimately be moved in the module with all physical constants ?
@@ -96,5 +96,5 @@
    REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation
    REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant
-   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! iovi 1.63e-3     ! transfer coefficient over ice
+   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice
    REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant
    !
@@ -111,7 +111,13 @@
    REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements
    REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements
-   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm and oce-atm depending on ice concentration (from Lupkes et al. JGR2012)
+   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012)
+   LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015)
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_oce   ! air-ocean drag (clem)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme
 
    INTEGER  ::   nblk           ! choice of the bulk algorithm
@@ -135,5 +141,6 @@
       !!             ***  ROUTINE sbc_blk_alloc ***
       !!-------------------------------------------------------------------
-      ALLOCATE( Cd_oce(jpi,jpj) , STAT=sbc_blk_alloc )
+      ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), &
+         &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc )
       !
       IF( lk_mpp             )   CALL mpp_sum ( sbc_blk_alloc )
@@ -167,5 +174,5 @@
          &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm
          &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         & 
-         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12
+         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15
       !!---------------------------------------------------------------------
       !
@@ -258,4 +265,6 @@
          WRITE(numout,*) '      factor applied on ocean/ice velocity                rn_vfac      = ', rn_vfac
          WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))'
+         WRITE(numout,*) '      use ice-atm drag from Lupkes2012                    ln_Cd_L12    = ', ln_Cd_L12
+         WRITE(numout,*) '      use ice-atm drag from Lupkes2015                    ln_Cd_L15    = ', ln_Cd_L15
          !
          WRITE(numout,*)
@@ -364,10 +373,5 @@
       REAL(wp), DIMENSION(:,:), POINTER ::   zqlw, zqsb        ! long wave and sensible heat fluxes
       REAL(wp), DIMENSION(:,:), POINTER ::   zqla, zevap       ! latent heat fluxes and evaporation
-      REAL(wp), DIMENSION(:,:), POINTER ::   Cd                ! transfer coefficient for momentum      (tau)
-      REAL(wp), DIMENSION(:,:), POINTER ::   Ch                ! transfer coefficient for sensible heat (Q_sens)
-      REAL(wp), DIMENSION(:,:), POINTER ::   Ce                ! tansfert coefficient for evaporation   (Q_lat)
       REAL(wp), DIMENSION(:,:), POINTER ::   zst               ! surface temperature in Kelvin
-      REAL(wp), DIMENSION(:,:), POINTER ::   zt_zu             ! air temperature at wind speed height
-      REAL(wp), DIMENSION(:,:), POINTER ::   zq_zu             ! air spec. hum.  at wind speed height
       REAL(wp), DIMENSION(:,:), POINTER ::   zU_zu             ! bulk wind speed at height zu  [m/s]
       REAL(wp), DIMENSION(:,:), POINTER ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
@@ -378,6 +382,5 @@
       !
       CALL wrk_alloc( jpi,jpj,   zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap )
-      CALL wrk_alloc( jpi,jpj,   Cd, Ch, Ce, zst, zt_zu, zq_zu )
-      CALL wrk_alloc( jpi,jpj,   zU_zu, ztpot, zrhoa )
+      CALL wrk_alloc( jpi,jpj,   zst, zU_zu, ztpot, zrhoa )
       !
 
@@ -426,6 +429,4 @@
       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
 
-
-
       ! ----------------------------------------------------------------------------- !
       !     II    Turbulent FLUXES                                                    !
@@ -443,11 +444,11 @@
       !
       CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2
-         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
       CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0
-         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
       CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5
-         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
       CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF
-         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
       CASE DEFAULT
          CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
@@ -456,14 +457,15 @@
       !                          ! Compute true air density :
       IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...)
-         zrhoa(:,:) = rho_air( zt_zu(:,:)             , zq_zu(:,:)             , sf(jp_slp)%fnow(:,:,1) )
+         zrhoa(:,:) = rho_air( t_zu(:,:)              , q_zu(:,:)              , sf(jp_slp)%fnow(:,:,1) )
       ELSE                                      ! At zt:
          zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
       END IF
 
-      Cd_oce(:,:) = Cd(:,:)  ! record value of pure ocean-atm. drag (clem)
+!!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef.
+!!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef.
 
       DO jj = 1, jpj             ! tau module, i and j component
          DO ji = 1, jpi
-            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd(ji,jj)   ! using bulk wind speed
+            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed
             taum  (ji,jj) = zztmp * wndm  (ji,jj)
             zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
@@ -500,11 +502,11 @@
       IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN
          !! q_air and t_air are given at 10m (wind reference height)
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed
-         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed
+         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed
+         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed
       ELSE
          !! q_air and t_air are not given at 10m (wind reference height)
          ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!!
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation ! using bulk wind speed
-         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - zt_zu(:,:) )   ! Sensible Heat ! using bulk wind speed
+         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed
+         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) )   ! Sensible Heat, using bulk wind speed
       ENDIF
 
@@ -513,6 +515,6 @@
 
       IF(ln_ctl) THEN
-         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce , clinfo2=' Ce  : ' )
-         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch , clinfo2=' Ch  : ' )
+         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce  : ' )
+         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce  : ' )
          CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
          CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' )
@@ -566,6 +568,5 @@
       !
       CALL wrk_dealloc( jpi,jpj,   zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap )
-      CALL wrk_dealloc( jpi,jpj,   Cd, Ch, Ce, zst, zt_zu, zq_zu )
-      CALL wrk_dealloc( jpi,jpj,   zU_zu, ztpot, zrhoa )
+      CALL wrk_dealloc( jpi,jpj,   zst, zU_zu, ztpot, zrhoa )
       !
       IF( nn_timing == 1 )  CALL timing_stop('blk_oce')
@@ -573,5 +574,5 @@
    END SUBROUTINE blk_oce
 
-#if defined key_lim2 || defined key_lim3
+#if defined key_lim3
 
    SUBROUTINE blk_ice_tau
@@ -591,5 +592,4 @@
       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point
       REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point
-      REAL(wp), DIMENSION(:,:), POINTER ::   Cd               ! transfer coefficient for momentum      (tau)
       !!---------------------------------------------------------------------
       !
@@ -597,18 +597,55 @@
       !
       CALL wrk_alloc( jpi,jpj, zrhoa )
-      CALL wrk_alloc( jpi,jpj, Cd )
-
-      Cd(:,:) = Cd_ice
-
-      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem)
-#if defined key_lim3
-      IF( ln_Cd_L12 ) THEN
-         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations
+
+      ! set transfer coefficients to default sea-ice values
+      Cd_atm(:,:) = Cd_ice
+      Ch_atm(:,:) = Cd_ice
+      Ce_atm(:,:) = Cd_ice
+
+      wndm_ice(:,:) = 0._wp      !!gm brutal....
+
+      ! ------------------------------------------------------------ !
+      !    Wind module relative to the moving ice ( U10m - U_ice )   !
+      ! ------------------------------------------------------------ !
+      SELECT CASE( cp_ice_msh )
+      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
+         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! B grid : NO vector opt
+               ! ... scalar wind at T-point (fld being at T-point)
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   &
+                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  )
+               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   &
+                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  )
+               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
+         !
+      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vect. opt.
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
+               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
+         !
+      END SELECT
+
+      ! Make ice-atm. drag dependent on ice concentration
+      IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations
+         CALL Cdn10_Lupkes2012( Cd_atm )
+         Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical
+      ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations
+         CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm ) 
       ENDIF
-#endif
+
+!!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef.
+!!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef.
 
       ! local scalars ( place there for vector optimisation purposes)
       ! Computing density of air! Way denser that 1.2 over sea-ice !!!
-      !!
       zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1))
 
@@ -616,13 +653,11 @@
       utau_ice  (:,:) = 0._wp
       vtau_ice  (:,:) = 0._wp
-      wndm_ice  (:,:) = 0._wp
       !!gm end
 
-      ! ----------------------------------------------------------------------------- !
-      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   !
-      ! ----------------------------------------------------------------------------- !
+      ! ------------------------------------------------------------ !
+      !    Wind stress relative to the moving ice ( U10m - U_ice )   !
+      ! ------------------------------------------------------------ !
       SELECT CASE( cp_ice_msh )
       CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
-         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! B grid : NO vector opt
@@ -632,33 +667,19 @@
                zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj)
-               zwnorm_f = zrhoa(ji,jj) * Cd(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
                ! ... ice stress at I-point
+               zwnorm_f = zrhoa(ji,jj) * Cd_atm(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
                utau_ice(ji,jj) = zwnorm_f * zwndi_f
                vtau_ice(ji,jj) = zwnorm_f * zwndj_f
-               ! ... scalar wind at T-point (fld being at T-point)
-               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   &
-                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  )
-               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   &
-                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  )
-               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
          END DO
          CALL lbc_lnk( utau_ice, 'I', -1. )
          CALL lbc_lnk( vtau_ice, 'I', -1. )
-         CALL lbc_lnk( wndm_ice, 'T',  1. )
          !
       CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vect. opt.
-               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
-               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
-               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
-            END DO
-         END DO
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vect. opt.
-               utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          &
+               utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            &
                   &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
-               vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          &
+               vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            &
                   &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
             END DO
@@ -666,5 +687,4 @@
          CALL lbc_lnk( utau_ice, 'U', -1. )
          CALL lbc_lnk( vtau_ice, 'V', -1. )
-         CALL lbc_lnk( wndm_ice, 'T',  1. )
          !
       END SELECT
@@ -680,5 +700,5 @@
 
 
-   SUBROUTINE blk_ice_flx( ptsu, palb )
+   SUBROUTINE blk_ice_flx( ptsu, phs, phi, palb )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE blk_ice_flx  ***
@@ -693,4 +713,6 @@
       !!---------------------------------------------------------------------
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies)
       !!
@@ -699,4 +721,6 @@
       REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      -
       REAL(wp) ::   zztmp, z1_lsub           !   -      -
+      REAL(wp) ::   zfrqsr_tr_i              ! sea ice shortwave fraction transmitted below through the ice
+      REAL(wp) ::   zfr1, zfr2, zfac         ! local variables
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw         ! long wave heat flux over ice
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb         ! sensible  heat flux over ice
@@ -705,5 +729,5 @@
       REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (LIM3)
       REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa
-      REAL(wp), DIMENSION(:,:)  , POINTER ::   Cd            ! transfer coefficient for momentum      (tau)
+
       !!---------------------------------------------------------------------
       !
@@ -711,18 +735,7 @@
       !
       CALL wrk_alloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb )
-      CALL wrk_alloc( jpi,jpj,       zrhoa)
-      CALL wrk_alloc( jpi,jpj, Cd )
-
-      Cd(:,:) = Cd_ice
-
-      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al.  2012) (clem)
-#if defined key_lim3
-      IF( ln_Cd_L12 ) THEN
-         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations
-      ENDIF
-#endif
-
-      !
-      ! local scalars ( place there for vector optimisation purposes)
+      CALL wrk_alloc( jpi,jpj,       zrhoa )
+      !
+      ! local scalars
       zcoef_dqlw   = 4.0 * 0.95 * Stef
       zcoef_dqla   = -Ls * 11637800. * (-5897.8)
@@ -752,13 +765,13 @@
                ! ----------------------------!
 
-               ! ... turbulent heat fluxes
+               ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau
                ! Sensible Heat
-               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
+               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1))
                ! Latent Heat
-               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Cd(ji,jj) * wndm_ice(ji,jj)   &
-                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1)  ) )
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  &
+                  &                ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) )
                ! Latent heat sensitivity for ice (Dqla/Dt)
                IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
-                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Cd(ji,jj) * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) )
+                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) / zst2 * EXP(-5897.8 / ptsu(ji,jj,jl))
                ELSE
                   dqla_ice(ji,jj,jl) = 0._wp
@@ -766,5 +779,5 @@
 
                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
-               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj)
+               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj)
 
                ! ----------------------------!
@@ -786,5 +799,4 @@
       CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation
 
-#if defined  key_lim3
       CALL wrk_alloc( jpi,jpj,   zevap, zsnw )
 
@@ -797,11 +809,11 @@
       ! --- evaporation minus precipitation --- !
       zsnw(:,:) = 0._wp
-      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing
-      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )
+      CALL ice_thd_snwblow( (1.-at_i_b(:,:)), zsnw )  ! snow distribution over ice after wind blowing
+      emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )
       emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
       emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:)
 
       ! --- heat flux associated with emp --- !
-      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst
+      qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst
          &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair
          &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
@@ -811,6 +823,7 @@
 
       ! --- total solar and non solar fluxes --- !
-      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
-      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+      qns_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 )  &
+         &           + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
 
       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
@@ -824,15 +837,37 @@
 
       CALL wrk_dealloc( jpi,jpj,   zevap, zsnw )
-#endif
-
-      !--------------------------------------------------------------------
-      ! FRACTIONs of net shortwave radiation which is not absorbed in the
-      ! thin surface layer and penetrates inside the ice cover
-      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
-      !
-      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
-      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
-      !
-      !
+
+      ! --- absorbed and transmitted shortwave radiation (W/m2) --- !
+      !
+      ! former coding was
+      !     fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      !     fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+
+      ! --- surface transmission parameter (i0, Grenfell Maykut 77) --- !
+      zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            !   standard value
+      zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            !   zfr2 such that zfr1 + zfr2 to equal 1
+
+      qsr_ice_tr(:,:,:) = 0._wp
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               zfac = MAX( 0._wp , 1._wp - phi(ji,jj,jl) * 10._wp )     !   linear weighting factor: =0 for phi=0, =1 for phi = 0.1
+               zfrqsr_tr_i = zfr1 + zfac * zfr2                         !   below 10 cm, linearly increase zfrqsr_tr_i until 1 at zero thickness
+
+               IF ( phs(ji,jj,jl) <= 0.0_wp ) THEN 
+                  zfrqsr_tr_i  = zfr1            + zfac * zfr2
+               ELSE 
+                  zfrqsr_tr_i  = 0._wp                                  !   snow fully opaque
+               ENDIF
+
+               qsr_ice_tr(ji,jj,jl) = zfrqsr_tr_i * qsr_ice(ji,jj,jl)   !   transmitted solar radiation 
+
+            END DO
+         END DO
+      END DO
+                                                                                      
+
       IF(ln_ctl) THEN
          CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl)
@@ -846,9 +881,127 @@
       CALL wrk_dealloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb )
       CALL wrk_dealloc( jpi,jpj,       zrhoa )
-      CALL wrk_dealloc( jpi,jpj, Cd )
       !
       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_flx')
 
    END SUBROUTINE blk_ice_flx
+   
+   
+
+   SUBROUTINE blk_ice_qcn( k_monocat, ptsu, ptb, phs, phi )
+   
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_qcn  ***
+      !!
+      !! ** Purpose :   Compute surface temperature and snow/ice conduction flux
+      !!                to force sea ice / snow thermodynamics
+      !!                in the case JULES coupler is emulated
+      !!                
+      !! ** Method  :   compute surface energy balance assuming neglecting heat storage
+      !!                following the 0-layer Semtner (1976) approach
+      !!
+      !! ** Outputs : - ptsu    : sea-ice / snow surface temperature (K)
+      !!              - qcn_ice : surface inner conduction flux (W/m2)
+      !!
+      !!---------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(in)                        ::   k_monocat                 ! single-category option
+
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   ptsu                      ! sea ice / snow surface temperature
+
+      REAL(wp), DIMENSION(:,:)  , INTENT(in)     ::   ptb                       ! sea ice base temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)     ::   phs                       ! snow thickness
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)     ::   phi                       ! sea ice thickness
+      
+      INTEGER                                    ::   ji, jj, jl                ! dummy loop indices
+      INTEGER                                    ::   iter                      !
+      REAL(wp)                                   ::   zfac, zfac2, zfac3        ! dummy factors
+      REAL(wp)                                   ::   zkeff_h, ztsu             !
+      REAL(wp)                                   ::   zqc, zqnet                !
+      REAL(wp)                                   ::   zhe, zqa0                 !
+           
+      INTEGER , PARAMETER                        ::   nit = 10                  ! number of iterations
+      REAL(wp), PARAMETER                        ::   zepsilon = 0.1_wp         ! characteristic thickness for enhanced conduction
+
+      REAL(wp), DIMENSION(:,:,:), POINTER        ::   zgfac                    ! enhanced conduction factor
+      
+      !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_qcn')
+      !
+      CALL wrk_alloc( jpi,jpj,jpl,   zgfac )
+
+      ! -------------------------------------!
+      !      I   Enhanced conduction factor  !
+      ! -------------------------------------!
+      !
+      ! Emulates the enhancement of conduction by unresolved thin ice (k_monocat = 1/3)
+      ! Fichefet and Morales Maqueda, JGR 1997
+      !
+      zgfac(:,:,:) = 1._wp
+      
+      SELECT CASE ( k_monocat ) 
+      
+         CASE ( 1 , 3 )
+      
+            zfac    =   1._wp /  ( rn_cnd_s + rcdic )
+            zfac2   =   EXP(1._wp) * 0.5_wp * zepsilon
+            zfac3   =   2._wp / zepsilon
+      
+            DO jl = 1, jpl                
+               DO jj = 1 , jpj
+                  DO ji = 1, jpi
+                     !                                ! Effective thickness
+                     zhe               =   ( rn_cnd_s * phi(ji,jj,jl) + rcdic * phs(ji,jj,jl) ) * zfac
+                     !                                ! Enhanced conduction factor
+                     IF( zhe >=  zfac2 )  &
+                        zgfac(ji,jj,jl)   =   MIN( 2._wp, ( 0.5_wp + 0.5 * LOG( zhe * zfac3 ) ) )
+                  END DO
+               END DO
+            END DO
+      
+      END SELECT
+      
+      ! -------------------------------------------------------------!
+      !      II   Surface temperature and conduction flux            !
+      ! -------------------------------------------------------------!
+
+      zfac   =   rcdic * rn_cnd_s 
+                                      ! ========================== !
+      DO jl = 1, jpl                  !  Loop over ice categories  !
+         !                            ! ========================== !
+         DO jj = 1 , jpj
+            DO ji = 1, jpi
+               !                      ! Effective conductivity of the snow-ice system divided by thickness
+               zkeff_h   =   zfac * zgfac(ji,jj,jl) / ( rcdic * phs(ji,jj,jl) + rn_cnd_s * phi(ji,jj,jl) )
+                                      ! Store initial surface temperature
+               ztsu      =   ptsu(ji,jj,jl)
+                                      ! Net initial atmospheric heat flux
+               zqa0      =   qsr_ice(ji,jj,jl) - qsr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl)
+               
+               DO iter = 1, nit       ! --- Iteration loop
+               
+                   !                  ! Conduction heat flux through snow-ice system (>0 downwards)
+                   zqc   =   zkeff_h * ( ztsu - ptb(ji,jj) )
+                   !                  ! Surface energy budget
+                   zqnet =   zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc
+                   !                  ! Temperature update
+                   ztsu  =   ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )
+               
+               END DO
+               
+               ptsu(ji,jj,jl)    = MIN( rt0, ztsu )
+               
+               qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
+               
+            END DO
+         END DO
+         
+      END DO 
+      
+      CALL wrk_dealloc( jpi,jpj,jpl,   zgfac )
+      
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_qcn')
+
+   END SUBROUTINE blk_ice_qcn
    
 #endif
@@ -973,4 +1126,5 @@
 
 #if defined key_lim3
+
    SUBROUTINE Cdn10_Lupkes2012( Cd )
       !!----------------------------------------------------------------------
@@ -1022,6 +1176,121 @@
       
    END SUBROUTINE Cdn10_Lupkes2012
+
+
+   SUBROUTINE Cdn10_Lupkes2015( Cd, Ch )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  Cdn10_Lupkes2015  ***
+      !!
+      !! ** pUrpose :    1lternative turbulent transfert coefficients formulation
+      !!                 between sea-ice and atmosphere with distinct momentum 
+      !!                 and heat coefficients depending on sea-ice concentration 
+      !!                 and atmospheric stability (no meltponds effect for now).
+      !!                
+      !! ** Method :     The parameterization is adapted from Lupkes et al. (2015)
+      !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme,
+      !!                 it considers specific skin and form drags (Andreas et al. 2010)
+      !!                 to compute neutral transfert coefficients for both heat and 
+      !!                 momemtum fluxes. Atmospheric stability effect on transfert
+      !!                 coefficient is also taken into account following Louis (1979).
+      !!
+      !! ** References : Lupkes et al. JGR 2015 (theory)
+      !!                 Lupkes et al. ECHAM6 documentation 2015 (implementation)
+      !!
+      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat
+      !
+      ! ECHAM6 constants
+      REAL(wp), PARAMETER ::   z0_skin_ice  = 0.69e-3_wp  ! Eq. 43 [m]
+      REAL(wp), PARAMETER ::   z0_form_ice  = 0.57e-3_wp  ! Eq. 42 [m]
+      REAL(wp), PARAMETER ::   z0_ice       = 1.00e-3_wp  ! Eq. 15 [m]
+      REAL(wp), PARAMETER ::   zce10        = 2.80e-3_wp  ! Eq. 41
+      REAL(wp), PARAMETER ::   zbeta        = 1.1_wp      ! Eq. 41
+      REAL(wp), PARAMETER ::   zc           = 5._wp       ! Eq. 13
+      REAL(wp), PARAMETER ::   zc2          = zc * zc
+      REAL(wp), PARAMETER ::   zam          = 2. * zc     ! Eq. 14
+      REAL(wp), PARAMETER ::   zah          = 3. * zc     ! Eq. 30
+      REAL(wp), PARAMETER ::   z1_alpha     = 1._wp / 0.2_wp  ! Eq. 51
+      REAL(wp), PARAMETER ::   z1_alphaf    = z1_alpha    ! Eq. 56
+      REAL(wp), PARAMETER ::   zbetah       = 1.e-3_wp    ! Eq. 26
+      REAL(wp), PARAMETER ::   zgamma       = 1.25_wp     ! Eq. 26
+      REAL(wp), PARAMETER ::   z1_gamma     = 1._wp / zgamma
+      REAL(wp), PARAMETER ::   r1_3         = 1._wp / 3._wp
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::   zthetav_os, zthetav_is, zthetav_zu
+      REAL(wp) ::   zrib_o, zrib_i
+      REAL(wp) ::   zCdn_skin_ice, zCdn_form_ice, zCdn_ice
+      REAL(wp) ::   zChn_skin_ice, zChn_form_ice
+      REAL(wp) ::   z0w, z0i, zfmi, zfmw, zfhi, zfhw
+      REAL(wp) ::   zCdn_form_tmp
+      !!----------------------------------------------------------------------
+
+      ! Momentum Neutral Transfert Coefficients (should be a constant)
+      zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40
+      zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7
+      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details)
+      !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32)
+
+      ! Heat Neutral Transfert Coefficients
+      zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52 (cf Lupkes email for details)
+     
+      ! Atmospheric and Surface Variables
+      zst(:,:)     = sst_m(:,:) + rt0                                       ! convert SST from Celcius to Kelvin
+      zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)  , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg]
+      zqi_sat(:,:) = 0.98_wp * q_sat( tm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg]
+      !
+      DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility
+         DO ji = fs_2, fs_jpim1
+            ! Virtual potential temperature [K]
+            zthetav_os = zst(ji,jj)   * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
+            zthetav_is = tm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
+            zthetav_zu = t_zu (ji,jj) * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
+            
+            ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
+            zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
+            zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
+            
+            ! Momentum and Heat Neutral Transfert Coefficients
+            zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
+            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
+                       
+            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead)
+            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
+            z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details)
+            IF( zrib_o <= 0._wp ) THEN
+               zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10
+               zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26
+                  &             )**zgamma )**z1_gamma
+            ELSE
+               zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12
+               zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
+            ENDIF
+            
+            IF( zrib_i <= 0._wp ) THEN
+               zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
+               zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25
+            ELSE
+               zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11
+               zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
+            ENDIF
+            
+            ! Momentum Transfert Coefficients (Eq. 38)
+            Cd(ji,jj) = zCdn_skin_ice *   zfmi +  &
+               &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
+            
+            ! Heat Transfert Coefficients (Eq. 49)
+            Ch(ji,jj) = zChn_skin_ice *   zfhi +  &
+               &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )
+            !
+         END DO
+      END DO
+      CALL lbc_lnk_multi( Cd, 'T',  1., Ch, 'T', 1. )
+      !
+   END SUBROUTINE Cdn10_Lupkes2015
+
 #endif
-   
 
    !!======================================================================
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90	(revision 8879)
@@ -52,5 +52,5 @@
    !! COARE own values for given constants:
    REAL(wp), PARAMETER :: &
-      &   zi0     = 600.,  &   !: scale height of the atmospheric boundary layer...1
+      &   zi0     = 600., &   !: scale height of the atmospheric boundary layer...1
       &  Beta0    = 1.25, &   !: gustiness parameter
       &  rctv0    = 0.608     !: constant to obtain virtual temperature...
@@ -60,5 +60,7 @@
 
    SUBROUTINE turb_coare( zt, zu, sst, t_zt, ssq, q_zt, U_zu, &
-      &                   Cd, Ch, Ce, t_zu, q_zu, U_blk )
+      &                   Cd, Ch, Ce, t_zu, q_zu, U_blk,      &
+      &                   Cdn, Chn, Cen                       )
+
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  turb_coare  ***
@@ -106,4 +108,5 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
       INTEGER :: j_itt
@@ -246,4 +249,9 @@
       Ce   = ztmp0*q_star/dq_zu
       !
+      ztmp1 = zu + z0
+      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
+      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
+      Cen = Chn
+      !
       CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu )
       CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90	(revision 8879)
@@ -58,6 +58,8 @@
 CONTAINS
 
-   SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu, &
-      &                   Cd, Ch, Ce, t_zu, q_zu, U_blk )
+   SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu,  &
+      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,       &
+      &                      Cdn, Chn, Cen                        )
+
       !!----------------------------------------------------------------------------------
       !!                      ***  ROUTINE  turb_coare3p5  ***
@@ -105,4 +107,5 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu             [kg/kg]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
       INTEGER :: j_itt
@@ -252,4 +255,9 @@
       Ce   = ztmp0*q_star/dq_zu
       !
+      ztmp1 = zu + z0
+      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
+      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
+      Cen = Chn
+      !
       CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu )
       CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90	(revision 8879)
@@ -64,5 +64,6 @@
 
    SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   &
-      &                   Cd, Ch, Ce , t_zu, q_zu, U_blk )
+      &                   Cd, Ch, Ce , t_zu, q_zu, U_blk,         &
+      &                   Cdn, Chn, Cen                           )
       !!----------------------------------------------------------------------------------
       !!                      ***  ROUTINE  turb_ecmwf  ***
@@ -112,4 +113,5 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
       INTEGER :: j_itt
@@ -266,4 +268,5 @@
             dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
             dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+
          END IF
 
@@ -271,5 +274,5 @@
          ztmp1 = zu + z0
          ztmp0 = ztmp1*Linv
-         func_m = log(ztmp1) - LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv)
+         func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv)
          func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
 
@@ -280,4 +283,9 @@
       ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
       Ce = vkarmn*vkarmn/(func_m*ztmp1)
+
+      ztmp1 = zu + z0
+      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
+      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
+      Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q))
 
       CALL wrk_dealloc( jpi,jpj,   u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90	(revision 8879)
@@ -48,10 +48,11 @@
    !                              ! NCAR own values for given constants:
    REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature...
-   
    !!----------------------------------------------------------------------
 CONTAINS
 
    SUBROUTINE turb_ncar( zt, zu, sst, t_zt, ssq, q_zt, U_zu, &
-      &                  Cd, Ch, Ce, t_zu, q_zu, U_blk )
+      &                  Cd, Ch, Ce, t_zu, q_zu, U_blk,      &
+      &                  Cdn, Chn, Cen                       )
+
       !!----------------------------------------------------------------------------------
       !!                      ***  ROUTINE  turb_ncar  ***
@@ -112,4 +113,5 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
       INTEGER ::   j_itt
@@ -199,8 +201,10 @@
             ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u))
             ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
+            Cdn(:,:) = ztmp0
             sqrt_Cd_n10 = sqrt(ztmp0)
 
             stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability
             Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10)
+            Chn(:,:) = Cx_n10
 
             !! Update of transfer coefficients:
@@ -216,4 +220,5 @@
 
          Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
+         Cen(:,:) = Cx_n10
          ztmp1 = 1. + Cx_n10*ztmp0
          Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 8879)
@@ -29,12 +29,8 @@
    USE ice            ! ice variables
 #endif
-#if defined key_lim2
-   USE par_ice_2      ! ice parameters
-   USE ice_2          ! ice variables
-#endif
    USE cpl_oasis3     ! OASIS3 coupling
    USE geo2ocean      ! 
    USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
-   USE albedo         ! 
+   USE ocealb         ! 
    USE eosbn2         ! 
    USE sbcrnf, ONLY : l_rnfcpl
@@ -44,5 +40,5 @@
 #endif
 #if defined key_lim3
-   USE limthd_dh      ! for CALL lim_thd_snwblow
+   USE icethd_dh      ! for CALL ice_thd_snwblow
 #endif
    !
@@ -58,8 +54,8 @@
 
    PUBLIC   sbc_cpl_init      ! routine called by sbcmod.F90
-   PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_rcv       ! routine called by icestp.F90
    PUBLIC   sbc_cpl_snd       ! routine called by step.F90
-   PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90
-   PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_ice_tau   ! routine called by icestp.F90
+   PUBLIC   sbc_cpl_ice_flx   ! routine called by icestp.F90
    PUBLIC   sbc_cpl_alloc     ! routine called in sbcice_cice.F90
 
@@ -117,6 +113,8 @@
    INTEGER, PARAMETER ::   jpr_isf    = 52
    INTEGER, PARAMETER ::   jpr_icb    = 53
-
-   INTEGER, PARAMETER ::   jprcv      = 53   ! total number of fields received  
+   INTEGER, PARAMETER ::   jpr_ts_ice = 54   ! Sea ice surface temp
+   INTEGER, PARAMETER ::   jpr_rcv    = 55   
+
+   INTEGER, PARAMETER ::   jprcv      = 55   ! total number of fields received  
 
    INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
@@ -152,5 +150,13 @@
    INTEGER, PARAMETER ::   jps_ocyw   = 31   ! currents on grid 2
    INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level 
-   INTEGER, PARAMETER ::   jpsnd      = 32   ! total number of fields sent 
+   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes)
+   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area
+   INTEGER, PARAMETER ::   jps_ht_p   = 35   ! meltpond thickness
+   INTEGER, PARAMETER ::   jps_kice   = 36   ! sea ice effective conductivity
+   INTEGER, PARAMETER ::   jps_sstfrz = 37   ! sea surface freezing temperature
+   INTEGER, PARAMETER ::   jps_ttilyr = 38 ! sea ice top layer temp
+   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent 
+
+   INTEGER :: nn_cats_cpl   ! number of sea ice categories over which the coupling is carried out
 
    !                                  !!** namelist namsbc_cpl **
@@ -163,7 +169,7 @@
    END TYPE FLD_C
    !                                   ! Send to the atmosphere  
-   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                        
+   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_thick1, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_ttilyr         
    !                                   ! Received from the atmosphere
-   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf
+   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf, sn_rcv_ts_ice
    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf                              
    ! Send to waves 
@@ -181,5 +187,5 @@
    TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                     ! all fields recieved from the atmosphere
 
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   alb_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky)
 
    REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2] 
@@ -205,7 +211,7 @@
       ierr(:) = 0
       !
-      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) )
+      ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) )
       
-#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice
+#if ! defined key_lim3 && ! defined key_cice
       ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
 #endif
@@ -242,11 +248,13 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos
       !!
+      LOGICAL ::   ln_iceshelf_init_atmos
       NAMELIST/namsbc_cpl/  sn_snd_temp , sn_snd_alb  , sn_snd_thick , sn_snd_crt   , sn_snd_co2,      & 
          &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau   , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
+         &                  sn_snd_thick1,  sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz , sn_rcv_ts_ice,   sn_snd_ttilyr, &
          &                  sn_snd_ifrac, sn_snd_crtw , sn_snd_wlev  , sn_rcv_hsig  , sn_rcv_phioc ,   & 
          &                  sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper  , sn_rcv_wnum  , sn_rcv_wstrf ,   &
          &                  sn_rcv_wdrag, sn_rcv_qns  , sn_rcv_emp   , sn_rcv_rnf   , sn_rcv_cal   ,   &
          &                  sn_rcv_iceflx,sn_rcv_co2  , nn_cplmodel  , ln_usecplmask, sn_rcv_mslp  ,   &
-         &                  sn_rcv_icb , sn_rcv_isf
+         &                  sn_rcv_icb , sn_rcv_isf, ln_iceshelf_init_atmos,        nn_cats_cpl  
 
       !!---------------------------------------------------------------------
@@ -274,4 +282,9 @@
          WRITE(numout,*)'~~~~~~~~~~~~'
       ENDIF
+
+      !!!!! Getting NEMO4-LIM working at the Met Office: Hardcode number of ice cats to 5 during the initialisation
+      jpl = nn_cats_cpl
+      !!!!!
+
       IF( lwp .AND. ln_cpl ) THEN                        ! control print
          WRITE(numout,*)'  received fields (mutiple ice categogies)'
@@ -300,6 +313,8 @@
          WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 
          WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
+         WRITE(numout,*)'      Sea ice surface skin temperature   = ', TRIM(sn_rcv_ts_ice%cldes ), ' (', TRIM(sn_rcv_ts_ice%clcat ), ')' 
          WRITE(numout,*)'  sent fields (multiple ice categories)'
          WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')'
+         WRITE(numout,*)'      top ice layer temperature             = ', TRIM(sn_snd_ttilyr%cldes  ), ' (', TRIM(sn_snd_ttilyr%clcat  ), ')'
          WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')'
          WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
@@ -310,4 +325,7 @@
          WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd
          WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')'
+         WRITE(numout,*)'      ice effective conductivity                    = ', TRIM(sn_snd_cond%cldes   ), ' (', TRIM(sn_snd_cond%clcat   ), ')'
+         WRITE(numout,*)'      meltponds fraction and depth                    = ', TRIM(sn_snd_mpnd%cldes   ), ' (', TRIM(sn_snd_mpnd%clcat   ), ')'
+         WRITE(numout,*)'      sea surface freezing temp                    = ', TRIM(sn_snd_sstfrz%cldes   ), ' (', TRIM(sn_snd_sstfrz%clcat   ), ')'
          WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')' 
          WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')' 
@@ -318,4 +336,5 @@
          WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel
          WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask
+         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl
       ENDIF
 
@@ -511,6 +530,10 @@
       !
       ! non solar sensitivity mandatory for LIM ice model
-      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
-         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
+
+      IF (.NOT. ln_meto_cpl) THEN
+         IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 3 .AND. nn_components /= jp_iam_sas) &
+            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
+      ENDIF
+
       ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) &
@@ -557,4 +580,13 @@
          srcv(jpr_topm:jpr_botm)%laction = .TRUE.
       ENDIF
+      !                                                      ! ----------------------------- !
+
+      !!!!! To get NEMO4-LIM working at Met Office
+      srcv(jpr_ts_ice)%clname = 'OTsfIce'
+      IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE.
+      IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl
+      IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl
+      !!!!!
+
       !                                                      ! ------------------------- !
       !                                                      !      Wave breaking        !    
@@ -719,9 +751,10 @@
       ssnd(jps_toce)%clname = 'O_SSTSST'
       ssnd(jps_tice)%clname = 'O_TepIce'
+      ssnd(jps_ttilyr)%clname = 'O_TtiLyr'
       ssnd(jps_tmix)%clname = 'O_TepMix'
       SELECT CASE( TRIM( sn_snd_temp%cldes ) )
       CASE( 'none'                                 )       ! nothing to do
       CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE.
-      CASE( 'oce and ice' , 'weighted oce and ice' )
+      CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice')
          ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
          IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl
@@ -746,7 +779,7 @@
       !     2. receiving mixed oce-ice solar radiation 
       IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
-         CALL albedo_oce( zaos, zacs )
+         CALL oce_alb( zaos, zacs )
          ! Due to lack of information on nebulosity : mean clear/overcast sky
-         albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
+         alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
       ENDIF
 
@@ -757,9 +790,15 @@
       ssnd(jps_ficet)%clname = 'OIceFrcT' 
       ssnd(jps_hice)%clname = 'OIceTck'
+      ssnd(jps_a_p)%clname  = 'OPndFrc'
+      ssnd(jps_ht_p)%clname = 'OPndTck'
       ssnd(jps_hsnw)%clname = 'OSnwTck'
+      ssnd(jps_fice1)%clname = 'OIceFrd'
       IF( k_ice /= 0 ) THEN
          ssnd(jps_fice)%laction = .TRUE.                  ! if ice treated in the ocean (even in climato case)
+         ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used
+                                                          ! producing atmos-to-ice fluxes
 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
+         IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl
       ENDIF
       
@@ -779,4 +818,38 @@
       END SELECT
 
+      !                                                      ! ------------------------- ! 
+      !                                                      ! Ice Meltponds             ! 
+      !                                                      ! ------------------------- ! 
+
+
+      !!!!! Getting NEMO4-LIM to work at Met Office
+      ssnd(jps_a_p)%clname = 'OPndFrc'    
+      ssnd(jps_ht_p)%clname = 'OPndTck'    
+      SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 
+      CASE ( 'none' ) 
+         ssnd(jps_a_p)%laction = .FALSE. 
+         ssnd(jps_ht_p)%laction = .FALSE. 
+      CASE ( 'ice only' )  
+         ssnd(jps_a_p)%laction = .TRUE. 
+         ssnd(jps_ht_p)%laction = .TRUE. 
+         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+            ssnd(jps_a_p)%nct = jpl 
+            ssnd(jps_ht_p)%nct = jpl 
+         ELSE 
+            IF ( jpl > 1 ) THEN 
+               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
+            ENDIF 
+         ENDIF 
+      CASE ( 'weighted ice' )  
+         ssnd(jps_a_p)%laction = .TRUE. 
+         ssnd(jps_ht_p)%laction = .TRUE. 
+         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+            ssnd(jps_a_p)%nct = jpl  
+            ssnd(jps_ht_p)%nct = jpl  
+         ENDIF 
+      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 
+      END SELECT 
+      !!!!!
+ 
       !                                                      ! ------------------------- !
       !                                                      !      Surface current      !
@@ -828,5 +901,59 @@
       !                                                      ! ------------------------- !
       ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
-
+      ! 
+      
+      !!!!! Getting NEMO4-LIM to work at the Met Office
+      !                                                      ! ------------------------- ! 
+      !                                                      ! Sea surface freezing temp ! 
+      !                                                      ! ------------------------- ! 
+      ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE. 
+      !!!!!
+
+      ! 
+      !                                                      ! ------------------------- ! 
+      !                                                      !    Ice conductivity       ! 
+      !                                                      ! ------------------------- ! 
+      ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 
+      ! will be some changes to the parts of the code which currently relate only to ice conductivity 
+
+      ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 
+      SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 
+      CASE ( 'none' ) 
+         ssnd(jps_ttilyr)%laction = .FALSE. 
+      CASE ( 'ice only' ) 
+         ssnd(jps_ttilyr)%laction = .TRUE. 
+         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
+            ssnd(jps_ttilyr)%nct = jpl 
+         ELSE 
+            IF ( jpl > 1 ) THEN 
+               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
+            ENDIF 
+         ENDIF 
+      CASE ( 'weighted ice' ) 
+         ssnd(jps_ttilyr)%laction = .TRUE. 
+         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = jpl 
+      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
+      END SELECT 
+
+      ssnd(jps_kice )%clname = 'OIceKn' 
+      SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 
+      CASE ( 'none' ) 
+         ssnd(jps_kice)%laction = .FALSE. 
+      CASE ( 'ice only' ) 
+         ssnd(jps_kice)%laction = .TRUE. 
+         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
+            ssnd(jps_kice)%nct = jpl 
+         ELSE 
+            IF ( jpl > 1 ) THEN 
+               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
+            ENDIF 
+         ENDIF 
+      CASE ( 'weighted ice' ) 
+         ssnd(jps_kice)%laction = .TRUE. 
+         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl 
+      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
+      END SELECT 
+      ! 
+	    
       !                                                      ! ------------------------- ! 
       !                                                      !     Sea surface height    ! 
@@ -1161,4 +1288,25 @@
       IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
       ! 
+
+      !!!!! Getting NEMO4-LIM to work at the Met Office
+      !  ! Sea ice surface skin temp: 
+      IF( srcv(jpr_ts_ice)%laction ) THEN 
+        DO jn = 1, jpl 
+          DO jj = 1, jpj 
+            DO ji = 1, jpi 
+              IF (frcv(jpr_ts_ice)%z3(ji,jj,jn) > 0.0) THEN 
+                tsfc_ice(ji,jj,jn) = 0.0 
+              ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jn) < -60.0) THEN 
+                tsfc_ice(ji,jj,jn) = -60.0 
+              ELSE 
+                tsfc_ice(ji,jj,jn) = frcv(jpr_ts_ice)%z3(ji,jj,jn) 
+              ENDIF 
+            END DO 
+          END DO 
+        END DO 
+      ENDIF 
+      !!!!!
+
+
       !                                                      ! ========================= ! 
       !                                                      ! Mean Sea Level Pressure   !   (taum) 
@@ -1248,5 +1396,5 @@
       IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
          ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
-         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         ub (:,:,1) = ssu_m(:,:)                             ! will be used in icestp in the call of lim_sbc_tau
          un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssu_m', ssu_m )
@@ -1254,5 +1402,5 @@
       IF( srcv(jpr_ocy1)%laction ) THEN
          ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
-         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         vb (:,:,1) = ssv_m(:,:)                             ! will be used in icestp in the call of lim_sbc_tau
          vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssv_m', ssv_m )
@@ -1558,5 +1706,5 @@
    
 
-   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
+   SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )
       !!----------------------------------------------------------------------
       !!             ***  ROUTINE sbc_cpl_ice_flx  ***
@@ -1591,8 +1739,8 @@
       !!
       !! ** Details
-      !!             qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice   => provided
+      !!             qns_tot = (1-a) * qns_oce + a * qns_ice               => provided
       !!                     + qemp_oce + qemp_ice                         => recalculated and added up to qns
       !!
-      !!             qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice   => provided
+      !!             qsr_tot = (1-a) * qsr_oce + a * qsr_ice               => provided
       !!
       !!             emp_tot = emp_oce + emp_ice                           => calving is provided and added to emp_tot (and emp_oce).
@@ -1608,26 +1756,34 @@
       !!                   sprecip           solid precipitation over the ocean  
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
+      REAL(wp), INTENT(in), DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1]
       ! optional arguments, used only in 'mixed oce-ice' case
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
-      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
-      !
-      INTEGER ::   jl         ! dummy loop index
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice
+      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
+      REAL(wp), INTENT(in), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
+      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
+      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   phs        ! snow depth                  [m]
+      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   phi        ! ice thickness               [m]
+      !
+      INTEGER ::   ji,jj,jl         ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zdevap_ice
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i, zevap_ice
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
       !
-      CALL wrk_alloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
-      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
+      CALL wrk_alloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw )
+      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zdevap_ice )
       CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
-      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
+      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i )
+
+      IF (sn_rcv_emp%clcat == 'yes') THEN
+         CALL wrk_alloc( jpi, jpj, jpl, zevap_ice)
+      ELSE
+         CALL wrk_alloc( jpi, jpj, 1, zevap_ice)
+      ENDIF
 
       IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
-      zicefr(:,:) = 1.- p_frld(:,:)
+      ziceld(:,:) = 1. - picefr(:,:)
       zcptn(:,:) = rcp * sst_m(:,:)
       !
@@ -1645,8 +1801,8 @@
          ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
          zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
-         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)
+         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)
       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
-         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
-         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)
+         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
+         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:)
          zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
          ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
@@ -1654,16 +1810,23 @@
 
 #if defined key_lim3
-      ! zsnw = snow fraction over ice after wind blowing (=zicefr if no blowing)
-      zsnw(:,:) = 0._wp  ;  CALL lim_thd_snwblow( p_frld, zsnw )
+      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing)
+      zsnw(:,:) = 0._wp  ;  CALL ice_thd_snwblow( ziceld, zsnw )
       
       ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
-      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip
+      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip
       zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:)                                ! emp_oce = emp_tot - emp_ice
 
       ! --- evaporation over ocean (used later for qemp) --- !
-      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
+      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:)
 
       ! --- evaporation over ice (kg/m2/s) --- !
-      zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1)
+      IF (sn_rcv_emp%clcat == 'yes') THEN
+         DO jl=1,jpl
+            zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
+         ENDDO
+      ELSE
+         zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1)
+      ENDIF
+
       ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
       ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
@@ -1693,5 +1856,5 @@
          tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
          DO jl=1,jpl
-            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:)
+            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,1) * zmsk(:,:)
             devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
          ENDDO
@@ -1703,5 +1866,10 @@
          tprecip(:,:) =         ztprecip(:,:)
          DO jl=1,jpl
-            evap_ice (:,:,jl) = zevap_ice (:,:)
+            IF (sn_rcv_emp%clcat == 'yes') THEN
+               evap_ice (:,:,jl) = zevap_ice (:,:,jl)
+            ELSE
+               evap_ice (:,:,jl) = zevap_ice (:,:,1)
+            ENDIF
+
             devap_ice(:,:,jl) = zdevap_ice(:,:)
          ENDDO
@@ -1709,5 +1877,5 @@
 
 #else
-      zsnw(:,:) = zicefr(:,:)
+      zsnw(:,:) = picefr(:,:)
       ! --- Continental fluxes --- !
       IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
@@ -1748,7 +1916,7 @@
       IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
       IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
-      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average)
+      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average)
       IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
-         &                                                        - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average)
+         &                                                        - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average)
       ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
       !
@@ -1768,5 +1936,5 @@
          ENDIF
       CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
-         zqns_tot(:,:) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
+         zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             DO jl=1,jpl
@@ -1775,7 +1943,7 @@
             ENDDO
          ELSE
-            qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+            qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
             DO jl=1,jpl
-               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_tot(:,:   ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
                zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
             ENDDO
@@ -1785,6 +1953,6 @@
          zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
          zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
-            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   &
-            &                                           + pist(:,:,1) * zicefr(:,:) ) )
+            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * ziceld(:,:)   &
+            &                                           + pist(:,:,1) * picefr(:,:) ) )
       END SELECT
       !                                     
@@ -1797,7 +1965,7 @@
 #if defined key_lim3      
       ! --- non solar flux over ocean --- !
-      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
       zqns_oce = 0._wp
-      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
+      WHERE( ziceld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)
 
       ! Heat content per unit mass of snow (J/kg)
@@ -1806,5 +1974,5 @@
       ENDWHERE
       ! Heat content per unit mass of rain (J/kg)
-      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) ) 
+      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 
 
       ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
@@ -1821,5 +1989,5 @@
          &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus )   ! solid precip over ocean + snow melting
       zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - lfus )   ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
-!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap
+!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap
 !!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice
       
@@ -1854,10 +2022,10 @@
       ! clem: this formulation is certainly wrong... but better than it was...
       zqns_tot(:,:) = zqns_tot(:,:)                            &          ! zqns_tot update over free ocean with:
-         &          - (  p_frld(:,:) * zsprecip(:,:) * lfus )  &          ! remove the latent heat flux of solid precip. melting
+         &          - (  ziceld(:,:) * zsprecip(:,:) * lfus )  &          ! remove the latent heat flux of solid precip. melting
          &          - (  zemp_tot(:,:)                         &          ! remove the heat content of mass flux (assumed to be at SST)
          &             - zemp_ice(:,:) ) * zcptn(:,:) 
 
      IF( ln_mixcpl ) THEN
-         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
          qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
          DO jl=1,jpl
@@ -1875,5 +2043,5 @@
       IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea',  sprecip(:,:) * ( zcptsnw(:,:) - Lfus )                           ) ! heat flux from snow (cell average)
       IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:)                    ) ! heat flux from rain (cell average)
-      IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average)
+      IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) & ! heat flux from from evap (cell average)
          &                                                        ) * zcptn(:,:) * tmask(:,:,1) )
       IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:))   ) ! heat flux from snow (over ocean)
@@ -1899,5 +2067,5 @@
          zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
       CASE( 'oce and ice' )
-         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
+         zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             DO jl=1,jpl
@@ -1906,7 +2074,7 @@
             ENDDO
          ELSE
-            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+            qsr_tot(:,:   ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
             DO jl=1,jpl
-               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_tot(:,:   ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
                zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
             ENDDO
@@ -1918,6 +2086,6 @@
 !       ( see OASIS3 user guide, 5th edition, p39 )
          zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
-            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
-            &                     + palbi         (:,:,1) * zicefr(:,:) ) )
+            &            / (  1.- ( alb_oce_mix(:,:  ) * ziceld(:,:)       &
+            &                     + palbi         (:,:,1) * picefr(:,:) ) )
       END SELECT
       IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
@@ -1930,7 +2098,7 @@
 #if defined key_lim3
       ! --- solar flux over ocean --- !
-      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
       zqsr_oce = 0._wp
-      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
+      WHERE( ziceld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)
 
       IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
@@ -1939,5 +2107,5 @@
 
       IF( ln_mixcpl ) THEN
-         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
          qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
          DO jl=1,jpl
@@ -1971,23 +2139,67 @@
       ENDIF
       
-      !                                                      ! ========================= !
-      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
-      !                                                      ! ========================= !
-      CASE ('coupled')
-         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
-         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
-      END SELECT
-
-      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
-      ! Used for LIM2 and LIM3
-      ! Coupled case: since cloud cover is not received from atmosphere 
-      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
-      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
-      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
-
-      CALL wrk_dealloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
-      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
+      IF( ln_meto_cpl ) THEN
+         !                                                      ! ========================= !
+         SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
+         !                                                      ! ========================= !
+         CASE ('coupled')
+            qml_ice(:,:,:)=frcv(jpr_topm)%z3(:,:,:) * a_i(:,:,:)
+            qcn_ice(:,:,:)=frcv(jpr_botm)%z3(:,:,:) * a_i(:,:,:)
+         END SELECT
+      ENDIF
+
+      ! --- Transmitted shortwave radiation (W/m2) --- !
+      
+      IF ( nice_jules == 0 ) THEN
+               
+         zfrqsr_tr_i(:,:,:) = 0._wp   !   surface transmission parameter
+     
+         ! former coding was    
+         ! Coupled case: since cloud cover is not received from atmosphere 
+         !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
+         !     fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+         !     fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+         
+         ! to retrieve that coding, we needed to access h_i & h_s from here
+         ! we could even retrieve cloud fraction from the coupler
+               
+         DO jl = 1, jpl
+            DO jj = 1 , jpj
+               DO ji = 1, jpi
+            
+                  !--- surface transmission parameter (Grenfell Maykut 77) --- !
+                  zfrqsr_tr_i(ji,jj,jl) = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice 
+               
+                  ! --- influence of snow and thin ice --- !
+                  IF ( phs(ji,jj,jl) >= 0.0_wp ) zfrqsr_tr_i(ji,jj,jl) = 0._wp   !   snow fully opaque
+                  IF ( phi(ji,jj,jl) <= 0.1_wp ) zfrqsr_tr_i(ji,jj,jl) = 1._wp   !   thin ice transmits all solar radiation
+               END DO
+            END DO
+         END DO
+         
+         qsr_ice_tr(:,:,:) =   zfrqsr_tr_i(:,:,:) * qsr_ice(:,:,:)               !   transmitted solar radiation 
+               
+      ENDIF
+      
+      IF ( nice_jules == 2 ) THEN
+      
+         ! here we must receive the qsr_ice_tr array from the coupler
+         ! for now just assume zero
+         
+         qsr_ice_tr(:,:,:) = 0.0_wp
+      
+      ENDIF
+
+
+
+      CALL wrk_dealloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw )
+      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zdevap_ice )
       CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
-      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
+      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i )
+      IF (sn_rcv_emp%clcat == 'yes') THEN
+         CALL wrk_dealloc( jpi,jpj,jpl,zevap_ice)
+      ELSE
+         CALL wrk_dealloc( jpi,jpj,1,zevap_ice)
+      ENDIF
       !
       IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_flx')
@@ -2033,5 +2245,5 @@
             ! we must send the surface potential temperature 
             IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
-            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
+            ELSE                   ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
             ENDIF
             !
@@ -2061,4 +2273,15 @@
                CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
                END SELECT
+            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0  
+               SELECT CASE( sn_snd_temp%clcat ) 
+               CASE( 'yes' )    
+                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
+               CASE( 'no' ) 
+                  ztmp3(:,:,:) = 0.0 
+                  DO jl=1,jpl 
+                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
+                  ENDDO 
+               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
+               END SELECT 
             CASE( 'mixed oce-ice'        )   
                ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
@@ -2073,4 +2296,18 @@
          IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
       ENDIF
+
+      !!!!! Getting NEMO4-LIM working at Met Office
+      ! Top layer ice temperature
+      IF( ssnd(jps_ttilyr)%laction) THEN
+         SELECT CASE( sn_snd_ttilyr%cldes)
+         CASE ('weighted ice')
+            ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
+         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
+         END SELECT
+         IF( ssnd(jps_ttilyr)%laction )   CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
+      ENDIF
+      !!!!!
+
+
       !                                                      ! ------------------------- !
       !                                                      !           Albedo          !
@@ -2086,5 +2323,5 @@
                    ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
                 ELSEWHERE
-                   ztmp1(:,:) = albedo_oce_mix(:,:)
+                   ztmp1(:,:) = alb_oce_mix(:,:)
                 END WHERE
              CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
@@ -2114,5 +2351,5 @@
 
       IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
-         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
+         ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
          DO jl=1,jpl
             ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
@@ -2132,4 +2369,13 @@
          IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info )
       ENDIF
+
+      IF( ssnd(jps_fice1)%laction ) THEN
+         SELECT CASE( sn_snd_thick1%clcat )
+         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
+         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
+         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
+         END SELECT
+         CALL cpl_snd( jps_fice1, isec, ztmp3, info )
+      ENDIF
       
       ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
@@ -2146,11 +2392,11 @@
             SELECT CASE( sn_snd_thick%clcat )
             CASE( 'yes' )   
-               ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
-               ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
+               ztmp3(:,:,1:jpl) =  h_i(:,:,1:jpl) * a_i(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) =  h_s(:,:,1:jpl) * a_i(:,:,1:jpl)
             CASE( 'no' )
                ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
                DO jl=1,jpl
-                  ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
-                  ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
+                  ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl)
+                  ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl)
                ENDDO
             CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
@@ -2159,10 +2405,10 @@
             SELECT CASE( sn_snd_thick%clcat )
             CASE( 'yes' )
-               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
-               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+               ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl)
             CASE( 'no' )
                WHERE( SUM( a_i, dim=3 ) /= 0. )
-                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
-                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
                ELSEWHERE
                  ztmp3(:,:,1) = 0.
@@ -2176,4 +2422,50 @@
          IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
       ENDIF
+
+      ! 
+      ! Send meltpond fields  
+      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 
+         SELECT CASE( sn_snd_mpnd%cldes)  
+         CASE( 'weighted ice' )  
+            SELECT CASE( sn_snd_mpnd%clcat )  
+            CASE( 'yes' )  
+               ztmp3(:,:,1:jpl) =  a_ip(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) =  v_ip(:,:,1:jpl)  
+            CASE( 'no' )  
+               ztmp3(:,:,:) = 0.0  
+               ztmp4(:,:,:) = 0.0  
+               DO jl=1,jpl  
+                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl)  
+                 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl) 
+               ENDDO  
+            CASE default    ;   CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' )  
+            END SELECT  
+         CASE( 'default' )    ;   CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%cldes' )     
+         END SELECT  
+         IF( ssnd(jps_a_p)%laction )   CALL cpl_snd( jps_a_p, isec, ztmp3, info )     
+         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )     
+         ! 
+         ! Send ice effective conductivity 
+         SELECT CASE( sn_snd_cond%cldes) 
+         CASE( 'weighted ice' )    
+            SELECT CASE( sn_snd_cond%clcat ) 
+            CASE( 'yes' )    
+	               ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
+            CASE( 'no' ) 
+               ztmp3(:,:,:) = 0.0 
+               DO jl=1,jpl 
+                 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 
+               ENDDO 
+            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 
+            END SELECT 
+         CASE( 'ice only' )    
+           ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 
+         END SELECT 
+         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info ) 
+      ENDIF 
+      !   
+      !!!!!
+
+
       !                                                      ! ------------------------- !
       !                                                      !  CO2 flux from PISCES     ! 
@@ -2545,4 +2837,8 @@
       IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
 
+      CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz)
+      ztmp1(:,:) = sstfrz(:,:)
+      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
+
       CALL wrk_dealloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
       CALL wrk_dealloc( jpi,jpj,jpl,   ztmp3, ztmp4 )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 8879)
@@ -17,4 +17,5 @@
    USE dom_oce        ! ocean space and time domain
    USE sbc_oce        ! surface ocean boundary condition
+   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
    USE phycst         ! physical constants
    USE sbcrnf         ! ocean runoffs
@@ -94,5 +95,5 @@
          ! and in case of no melt, it can generate HSSW.
          !
-#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice
+#if ! defined key_lim3 && ! defined key_cice
          snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass
          snwice_mass  (:,:) = 0.e0
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 8879)
@@ -137,5 +137,5 @@
             CALL cice_sbc_force(kt)
          ELSE IF ( ksbc == jp_purecpl ) THEN
-            CALL sbc_cpl_ice_flx( 1.0-fr_i  )
+            CALL sbc_cpl_ice_flx( fr_i )
          ENDIF
 
@@ -230,16 +230,12 @@
       CALL lbc_lnk ( fr_iv , 'V', 1. )
 
-      !                                      ! embedded sea ice
-      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
-         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
-         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
-         snwice_mass_b(:,:) = snwice_mass(:,:)
-      ELSE
-         snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges
-         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges
-      ENDIF
+      ! set the snow+ice mass
+      CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
+      CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
+      snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
+      snwice_mass_b(:,:) = snwice_mass(:,:)
+
       IF( .NOT.ln_rstart ) THEN
-         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area
+         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
@@ -477,5 +473,5 @@
       CALL nemo2cice(ztmp,vocn,'F', -1. )
 
-      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+      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}
@@ -680,12 +676,10 @@
       CALL lbc_lnk ( fr_iv , 'V', 1. )
 
-      !                                      ! embedded sea ice
-      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
-         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
-         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
-         snwice_mass_b(:,:) = snwice_mass(:,:)
-         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt
-      ENDIF
+      ! set the snow+ice mass
+      CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
+      CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
+      snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
+      snwice_mass_b(:,:) = snwice_mass(:,:)
+      snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt
 
 ! Release work space
@@ -726,6 +720,6 @@
 
       DO jl = 1,ncat
-         CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. )
-         CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. )
+         CALL cice2nemo(vsnon(:,:,jl,:),h_s(:,:,jl),'T', 1. )
+         CALL cice2nemo(vicen(:,:,jl,:),h_i(:,:,jl),'T', 1. )
       ENDDO
       !
Index: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 8878)
+++ 	(revision )
@@ -1,688 +1,0 @@
-MODULE sbcice_lim
-   !!======================================================================
-   !!                       ***  MODULE  sbcice_lim  ***
-   !! Surface module :  update the ocean surface boundary condition over ice
-   !!       &           covered area using LIM sea-ice model
-   !! Sea-Ice model  :  LIM-3 Sea ice model time-stepping
-   !!=====================================================================
-   !! 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 lim_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 lim_diahsb
-   !!            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' :                                  LIM 3.0 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   sbc_ice_lim  : sea-ice model time-stepping and update ocean sbc over ice-covered area
-   !!----------------------------------------------------------------------
-   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 usrdef_sbc      ! user defined: surface boundary condition
-   USE sbcblk          ! Surface boundary condition: bulk
-   USE sbccpl          ! Surface boundary condition: coupled interface
-   USE albedo          ! ocean & ice albedo
-   !
-   USE phycst          ! Define parameters for the routines
-   USE eosbn2          ! equation of state
-   USE limdyn          ! Ice dynamics
-   USE limtrp          ! Ice transport
-   USE limhdf          ! Ice horizontal diffusion
-   USE limthd          ! Ice thermodynamics
-   USE limitd_me       ! Mechanics on ice thickness distribution
-   USE limsbc          ! sea surface boundary condition
-   USE limdiahsb       ! Ice budget diagnostics
-   USE limwri          ! Ice outputs
-   USE limrst          ! Ice restarts
-   USE limupdate1      ! update of global variables
-   USE limupdate2      ! update of global variables
-   USE limvar          ! Ice variables switch
-   USE limctl          !
-   USE limistate       ! LIM initial state
-   USE limthd_sal      ! LIM ice thermodynamics: salinity
-   !
-   USE c1d             ! 1D vertical configuration
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager library
-   USE prtctl          ! Print control
-   USE lib_fortran     !
-   USE lbclnk          ! lateral boundary condition - MPP link
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-
-   USE bdy_oce   , ONLY: ln_bdy
-   USE bdyice_lim      ! unstructured open boundary data  (bdy_ice_lim routine)
-# if defined key_agrif
-   USE agrif_ice
-   USE agrif_lim3_update
-   USE agrif_lim3_interp
-# endif
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
-   PUBLIC sbc_lim_init ! routine called by sbcmod.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , UCL NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE sbc_ice_lim( kt, ksbc )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_ice_lim  ***
-      !!
-      !! ** Purpose :   update the ocean surface boundary condition via the
-      !!                Louvain la Neuve Sea Ice Model time stepping
-      !!
-      !! ** 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    ! type of sbc flux ( 1 = user defined formulation, 
-                                       !                    3 = bulk formulation,
-                                       !                    4 = Pure Coupled formulation)
-      !!
-      INTEGER  ::   jl                 ! dummy loop index
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
-      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice 
-      !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 )   CALL timing_start('sbc_ice_lim')
-
-      !-----------------------!
-      ! --- Ice time step --- !
-      !-----------------------!
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-
-# if defined key_agrif
-         IF( .NOT. Agrif_Root() )  lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1
-# endif
-
-         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean)
-         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)
-         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
-
-         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) )
-         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
-
-         ! Mask sea ice surface temperature (set to rt0 over land)
-         DO jl = 1, jpl
-            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
-         END DO
-         !
-         !------------------------------------------------!
-         ! --- Dynamical coupling with the atmosphere --- !
-         !------------------------------------------------!
-         ! It provides the following fields:
-         ! utau_ice, vtau_ice : surface ice stress (U- & V-points)   [N/m2]
-         !-----------------------------------------------------------------
-                                      CALL sbc_lim_bef         ! Store previous ice values
-         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 wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice)
-                                      CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
-            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
-            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
-            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
-         ENDIF
-
-         !-------------------------------------------------------!
-         ! --- ice dynamics and transport (except in 1D case) ---!
-         !-------------------------------------------------------!
-         numit = numit + nn_fsbc                  ! Ice model time step
-         !
-                                      CALL sbc_lim_diag0       ! set diag of mass, heat and salt fluxes to 0
-                                      CALL lim_rst_opn( kt )   ! Open Ice restart file
-         !
-         ! --- zap this if no ice dynamics --- !
-         IF( .NOT. lk_c1d .AND. ln_limdyn ) THEN
-            !
-            IF( nn_limdyn /= 0 ) THEN                          ! -- Ice dynamics
-                                      CALL lim_dyn( kt )       !     rheology  
-            ELSE
-               u_ice(:,:) = rn_uice * umask(:,:,1)             !     or prescribed velocity
-               v_ice(:,:) = rn_vice * vmask(:,:,1)
-            ENDIF
-                                      CALL lim_trp( kt )       ! -- Ice transport (Advection/diffusion)
-            IF( nn_limdyn == 2 .AND. nn_monocat /= 2 )  &      ! -- Mechanical redistribution (ridging/rafting)
-               &                      CALL lim_itd_me         
-            IF( nn_limdyn == 2 )      CALL lim_update1( kt )   ! -- Corrections
-            !
-         ENDIF
-
-         ! ---
-#if defined key_agrif
-         IF( .NOT. Agrif_Root() )     CALL agrif_interp_lim3('T')
-#endif
-         IF( ln_limthd .AND. ln_bdy ) CALL bdy_ice_lim( kt )   ! -- bdy ice thermo 
-         ! previous lead fraction and ice volume for flux calculations
-                                      CALL sbc_lim_bef                        
-                                      CALL lim_var_glo2eqv     ! ht_i and ht_s for ice albedo calculation
-                                      CALL lim_var_agg(1)      ! at_i for coupling (via pfrld) 
-         !
-         pfrld(:,:)   = 1._wp - at_i(:,:)
-         phicif(:,:)  = vt_i(:,:)
-
-         !------------------------------------------------------!
-         ! --- Thermodynamical coupling with the atmosphere --- !
-         !------------------------------------------------------!
-         ! It provides the following fields:
-         ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2]
-         ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2]
-         ! dqns_ice, dqla_ice : non solar & latent heat sensistivity   (T-point)         [W/m2]
-         ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s]
-         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%]
-         !----------------------------------------------------------------------------------------
-         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs )
-         
-                                      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
-         SELECT CASE( ksbc )
-            CASE( jp_usr )   ;        CALL usrdef_sbc_ice_flx( kt ) ! user defined formulation
-            CASE( jp_blk )                                          ! bulk formulation
-               ! albedo depends on cloud fraction because of non-linear spectral effects
-               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-                                      CALL blk_ice_flx( t_su, alb_ice )
-               IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su )
-               IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
-            CASE ( jp_purecpl )
-               ! albedo depends on cloud fraction because of non-linear spectral effects
-               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-                                      CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su )
-               IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
-         END SELECT
-
-         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs )
-
-         !----------------------------!
-         ! --- ice thermodynamics --- !
-         !----------------------------!
-         ! --- zap this if no ice thermo --- !
-         IF( ln_limthd )              CALL lim_thd( kt )        ! -- Ice thermodynamics      
-         IF( ln_limthd )              CALL lim_update2( kt )    ! -- Corrections
-         ! ---
-# if defined key_agrif
-         IF( .NOT. Agrif_Root() )     CALL agrif_update_lim3( kt )
-# endif
-                                      CALL lim_var_glo2eqv      ! necessary calls (at least for coupling)
-                                      CALL lim_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 lim_sbc_flx( kt )    ! -- Update surface ocean mass, heat and salt fluxes
-!!# if defined key_agrif
-!!         IF( .NOT. Agrif_Root() )   CALL Agrif_ParentGrid_To_ChildGrid()
-!!# endif
-         IF( ln_limdiahsb )           CALL lim_diahsb( kt )     ! -- Diagnostics and outputs 
-         !
-                                      CALL lim_wri( 1 )         ! -- Ice outputs 
-         !
-         IF( kt == nit000 .AND. ln_rstart )   &
-            &                         CALL iom_close( numrir )  ! close input ice restart file
-         !
-         IF( lrst_ice )               CALL lim_rst_write( kt )  ! -- Ice restart file 
-         !
-         IF( ln_limctl )              CALL lim_ctl( kt )        ! alerts in case of model crash
-         !
-      ENDIF   ! End sea-ice time step only
-
-      !-------------------------!
-      ! --- Ocean time step --- !
-      !-------------------------!
-      ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere
-      !    using before instantaneous surf. currents
-      IF( ln_limdyn )                 CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )
-!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim')
-      !
-   END SUBROUTINE sbc_ice_lim
-
-
-   SUBROUTINE sbc_lim_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_lim_init  ***
-      !!
-      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules
-      !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, ierr
-      !!----------------------------------------------------------------------
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'sbc_lim_init : update ocean surface boudary condition' 
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
-      !
-      !                                ! 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 lim_run_init                ! set some ice run parameters
-      !
-      !                                ! Allocate the ice arrays
-      ierr =        ice_alloc        ()      ! ice variables
-      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing
-      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics
-      IF( ln_limdyn )   ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics
-      !
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays')
-      !
-      CALL lim_dyn_init                ! set ice dynamics parameters
-      !
-      CALL lim_itd_init                ! ice thickness distribution initialization
-      !
-      CALL lim_hdf_init                ! set ice horizontal diffusion computation parameters
-      !
-      CALL lim_thd_init                ! set ice thermodynics parameters
-      !
-      CALL lim_thd_sal_init            ! set ice salinity parameters
-      !
-      IF( ln_limdyn )   CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation
-      !                                ! Initial sea-ice state
-      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst
-         numit = 0
-         numit = nit000 - 1
-         CALL lim_istate
-      ELSE                                    ! start from a restart file
-         CALL lim_rst_read
-         numit = nit000 - 1
-      ENDIF
-      CALL lim_var_agg(2)
-      CALL lim_var_glo2eqv
-      !
-      CALL lim_sbc_init                 ! ice surface boundary condition
-      !
-      IF( ln_limdiahsb) CALL lim_diahsb_init  ! initialization for diags
-      !
-      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction
-      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( gphit(ji,jj) > 0._wp ) THEN  ;  rn_amax_2d(ji,jj) = rn_amax_n  ! NH
-            ELSE                             ;  rn_amax_2d(ji,jj) = rn_amax_s  ! SH
-            ENDIF
-         END DO
-      END DO
-      !
-      nstart = numit  + nn_fsbc
-      nitrun = nitend - nit000 + 1
-      nlast  = numit  + nitrun
-      !
-      IF( nstock == 0 )   nstock = nlast + 1
-      !
-   END SUBROUTINE sbc_lim_init
-
-
-   SUBROUTINE lim_run_init
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE lim_run_init ***
-      !!
-      !! ** Purpose :   Definition some run parameter for ice model
-      !!
-      !! ** Method  :   Read the namicerun namelist and check the parameter
-      !!              values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namicerun
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, rn_amax_n, rn_amax_s, cn_icerst_in, cn_icerst_indir,   &
-         &                cn_icerst_out, cn_icerst_outdir, ln_limthd, ln_limdyn, nn_limdyn, rn_uice, rn_vice  
-      NAMELIST/namicediag/ ln_limdiachk, ln_limdiahsb, ln_limctl, iiceprt, jiceprt  
-      !!-------------------------------------------------------------------
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
-      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
-      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicerun )
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namicediag in reference namelist : Parameters for ice
-      READ  ( numnam_ice_ref, namicediag, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicediag in configuration namelist : Parameters for ice
-      READ  ( numnam_ice_cfg, namicediag, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicediag )
-      !
-      IF(lwp) THEN                        ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_run_init : ice share parameters for dynamics/advection/thermo of sea-ice'
-         WRITE(numout,*) ' ~~~~~~'
-         WRITE(numout,*) '   number of ice  categories                               = ', jpl
-         WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i
-         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s
-         WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n 
-         WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s
-         WRITE(numout,*) '   Ice thermodynamics (T) or not (F)            ln_limthd  = ', ln_limthd
-         WRITE(numout,*) '   Ice dynamics       (T) or not (F)            ln_limdyn  = ', ln_limdyn
-         WRITE(numout,*) '     (ln_limdyn=T) Ice dynamics switch          nn_limdyn  = ', nn_limdyn
-         WRITE(numout,*) '       2: total'
-         WRITE(numout,*) '       1: advection only (no diffusion, no ridging/rafting)'
-         WRITE(numout,*) '       0: advection only (as 1 + prescribed velocity, bypass rheology)'
-         WRITE(numout,*) '     (ln_limdyn=T) prescribed u-vel (case nn_limdyn=0)     = ', rn_uice
-         WRITE(numout,*) '     (ln_limdyn=T) prescribed v-vel (case nn_limdyn=0)     = ', rn_vice
-         WRITE(numout,*)
-         WRITE(numout,*) '...and ice diagnostics'
-         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '   Diagnose online heat/mass/salt budget     ln_limdiachk  = ', ln_limdiachk
-         WRITE(numout,*) '   Output          heat/mass/salt budget     ln_limdiahsb  = ', ln_limdiahsb
-         WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_limctl
-         WRITE(numout,*) '   i-index for control prints (ln_limctl=true)             = ', iiceprt
-         WRITE(numout,*) '   j-index for control prints (ln_limctl=true)             = ', jiceprt
-      ENDIF
-      !
-      ! sea-ice timestep and inverse
-      rdt_ice   = REAL(nn_fsbc) * rdt  
-      r1_rdtice = 1._wp / rdt_ice 
-
-      ! inverse of nlay_i and nlay_s
-      r1_nlay_i = 1._wp / REAL( nlay_i, wp )
-      r1_nlay_s = 1._wp / REAL( nlay_s, wp )
-      !
-      IF( lwp .AND. ln_bdy .AND. ln_limdiachk )  &
-         &   CALL ctl_warn('online conservation check activated but it does not work with BDY')
-      !
-      IF( lwp ) WRITE(numout,*) '   ice timestep rdt_ice  = ', rdt_ice
-      !
-   END SUBROUTINE lim_run_init
-
-
-   SUBROUTINE lim_itd_init
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_init ***
-      !!
-      !! ** Purpose :   Initializes the ice thickness distribution
-      !! ** Method  :   ...
-      !! ** input   :   Namelist namiceitd
-      !!-------------------------------------------------------------------
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namiceitd/ nn_catbnd, rn_himean
-      !
-      INTEGER  ::   jl                   ! dummy loop index
-      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
-      REAL(wp) ::   zhmax, znum, zden, zalpha !
-      !!------------------------------------------------------------------
-      !
-      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice
-      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice
-      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namiceitd )
-      !
-      IF(lwp) THEN                        ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd
-         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean
-      ENDIF
-      !
-      !----------------------------------
-      !- Thickness categories boundaries
-      !----------------------------------
-      !
-      hi_max(:) = 0._wp
-      !
-      SELECT CASE ( nn_catbnd  )    ! type of ice categories distribution
-      !
-      CASE (1)                            !==  tanh function (CICE)  ==!
-         zc1 =  3._wp / REAL( jpl, wp )
-         zc2 = 10._wp * zc1
-         zc3 =  3._wp
-         DO jl = 1, jpl
-            zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
-            hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
-         END DO
-         !
-      CASE (2)                            !==  h^(-alpha) function  ==!
-         zalpha = 0.05_wp
-         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
-         !
-      END SELECT
-      !
-      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,*) '      Thickness category boundaries '
-      IF(lwp) WRITE(numout,*) '         hi_max ', hi_max(0:jpl)
-      !
-   END SUBROUTINE lim_itd_init
-
-
-   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE ice_lim_flx  ***
-      !!
-      !! ** Purpose :   update the ice surface boundary condition by averaging and / or
-      !!                redistributing fluxes on ice categories
-      !!
-      !! ** Method  :   average then redistribute
-      !!
-      !! ** Action  :
-      !!---------------------------------------------------------------------
-      INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ;
-      !                                                         ! = 1 average and redistribute ; =2 redistribute
-      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), POINTER, DIMENSION(:,:) :: zalb_m    ! Mean albedo over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m    ! Mean temperature over all categories
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m  ! Mean sublimation over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ice_lim_flx')
-      !
-      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==!
-      CASE( 0 , 1 )
-         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
-         !
-         z_qns_m  (:,:) = fice_ice_ave ( pqns_ice (:,:,:) )
-         z_qsr_m  (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )
-         z_dqn_m  (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )
-         z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) )
-         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) )
-         DO jl = 1, jpl
-            pdqn_ice  (:,:,jl) = z_dqn_m(:,:)
-            pdevap_ice(:,:,jl) = z_devap_m(:,:)
-         END DO
-         !
-         DO jl = 1, jpl
-            pqns_ice (:,:,jl) = z_qns_m(:,:)
-            pqsr_ice (:,:,jl) = z_qsr_m(:,:)
-            pevap_ice(:,:,jl) = z_evap_m(:,:)
-         END DO
-         !
-         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
-      END SELECT
-      !
-      SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==!
-      CASE( 1 , 2 )
-         CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m )
-         !
-         zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) )
-         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) )
-         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
-         !
-         CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m )
-      END SELECT
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ice_lim_flx')
-      !
-   END SUBROUTINE ice_lim_flx
-
-
-   SUBROUTINE sbc_lim_bef
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_lim_bef  ***
-      !!
-      !! ** purpose :  store ice variables at "before" time step
-      !!----------------------------------------------------------------------
-      a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area
-      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
-      v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume
-      v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume
-      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
-      smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content
-      oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content
-      u_ice_b(:,:)     = u_ice(:,:)
-      v_ice_b(:,:)     = v_ice(:,:)
-      !
-      at_i_b (:,:)     = SUM( a_i_b(:,:,:), dim=3 )
-      
-   END SUBROUTINE sbc_lim_bef
-
-
-   SUBROUTINE sbc_lim_diag0
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_lim_diag0  ***
-      !!
-      !! ** purpose :  set ice-ocean and ice-atm. fluxes to zeros at the beggining
-      !!               of the time step
-      !!----------------------------------------------------------------------
-      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  
-      
-      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(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp
-      hfx_err_dif(:,:) = 0._wp
-      wfx_err_sub(:,:) = 0._wp
-      !
-      afx_tot(:,:) = 0._wp   ;
-      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp
-      !
-      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp
-      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp
-
-      tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here)
-      
-   END SUBROUTINE sbc_lim_diag0
-
-
-   FUNCTION fice_cell_ave ( ptab )
-      !!--------------------------------------------------------------------------
-      !! * Compute average over categories, for grid cell (ice covered and free ocean)
-      !!--------------------------------------------------------------------------
-      REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave
-      REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab
-      INTEGER :: jl ! Dummy loop index
-
-      fice_cell_ave (:,:) = 0._wp
-      DO jl = 1, jpl
-         fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl)
-      END DO
-
-   END FUNCTION fice_cell_ave
-
-
-   FUNCTION fice_ice_ave ( ptab )
-      !!--------------------------------------------------------------------------
-      !! * Compute average over categories, for ice covered part of grid cell
-      !!--------------------------------------------------------------------------
-      REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave
-      REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab
-
-      fice_ice_ave (:,:) = 0.0_wp
-      WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
-
-   END FUNCTION fice_ice_ave
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option           Dummy module      NO LIM 3.0 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   !
-   SUBROUTINE sbc_ice_lim ( kt, ksbc )     ! Dummy routine
-      INTEGER, INTENT(in) ::   kt, ksbc
-      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt
-   END SUBROUTINE sbc_ice_lim
-   !
-   SUBROUTINE sbc_lim_init                 ! Dummy routine
-   END SUBROUTINE sbc_lim_init
-#endif
-
-   !!======================================================================
-END MODULE sbcice_lim
Index: anches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 8878)
+++ 	(revision )
@@ -1,274 +1,0 @@
-MODULE sbcice_lim_2
-   !!======================================================================
-   !!                       ***  MODULE  sbcice_lim_2  ***
-   !! Surface module :  update surface ocean boundary condition over ice covered area using LIM sea-ice model
-   !! Sea-Ice model  :  LIM-2 Sea ice model time-stepping
-   !!======================================================================
-   !! History :  1.0   !  06-2006  (G. Madec)  from icestp_2.F90
-   !!            3.0   !  08-2008  (S. Masson, E. .... ) coupled interface
-   !!            3.3   !  05-2009  (G.Garric) addition of the lim2_evp case
-   !!----------------------------------------------------------------------
-#if defined key_lim2
-   !!----------------------------------------------------------------------
-   !!   'key_lim2' :                                    LIM-2 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   sbc_ice_lim_2   : sea-ice model time-stepping and update ocean sbc over ice-covered area
-   !!----------------------------------------------------------------------
-   USE oce              ! ocean dynamics and tracers
-   USE dom_oce          ! ocean space and time domain
-   USE ice_2
-   USE par_ice_2
-   USE iceini_2
-   USE dom_ice_2
-
-   USE sbc_oce          ! Surface boundary condition: ocean fields
-   USE sbc_ice          ! Surface boundary condition: ice   fields
-   USE sbcblk           ! Surface boundary condition: bulk
-   USE sbccpl           ! Surface boundary condition: coupled interface
-   USE albedo
-
-   USE phycst           ! Define parameters for the routines
-   USE eosbn2           ! equation of state
-   USE limdyn_2
-   USE limtrp_2
-   USE limdmp_2
-   USE limthd_2
-   USE limsbc_2         ! sea surface boundary condition
-   USE limdia_2
-   USE limwri_2
-   USE limrst_2
-
-   USE c1d              ! 1D vertical configuration
-
-   USE lbclnk           ! lateral boundary condition - MPP link
-   USE lib_mpp          ! MPP library
-   USE wrk_nemo         ! work arrays
-   USE iom              ! I/O manager library
-   USE in_out_manager   ! I/O manager
-   USE prtctl           ! Print control
-
-# if defined key_agrif
-   USE agrif_ice
-   USE agrif_lim2_update
-# endif
-
-   USE bdy_oce   , ONLY: ln_bdy
-   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine)
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE sbc_ice_lim_2( kt, ksbc )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_ice_lim_2  ***
-      !!                   
-      !! ** Purpose :   update the ocean surface boundary condition via the 
-      !!                Louvain la Neuve Sea Ice Model time stepping 
-      !!
-      !! ** 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    ! type of sbc ( =4 bulk ; =5 coupled )
-      !!
-      INTEGER  ::   ji, jj   ! dummy loop indices
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os   ! ice albedo under overcast sky
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs   ! ice albedo under clear sky
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K)
-      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice 
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc_ice_lim_2 : update ocean surface boudary condition' 
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM) time stepping'
-         !
-         CALL ice_init_2
-         !
-# if defined key_agrif
-         IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2   ! AGRIF: set the meshes
-# endif
-      ENDIF
-
-      !                                        !----------------------!
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
-         !                                     !----------------------!
-# if defined key_agrif
-         IF( .NOT. Agrif_Root() ) lim_nbstep = MOD(lim_nbstep,Agrif_rhot()&
-         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
-# endif
-
-         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice)
-         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
-
-         !  Bulk Formulea !
-         !----------------!
-         ! ... mean surface ocean current at ice dynamics point
-         SELECT CASE( cp_ice_msh )
-         CASE( 'I' )                  !== B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
-            DO jj = 2, jpj
-               DO ji = 2, jpi   ! NO vector opt. possible
-                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) &
-                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
-                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) &
-                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
-               END DO
-            END DO
-            CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
-            CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
-            !
-         CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
-            u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point
-            v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
-            !
-         END SELECT
-
-         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         CALL eos_fzp( sss_m(:,:), tfu(:,:) )
-         tfu(:,:) = tfu(:,:) + rt0
-
-         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
-
-         ! Ice albedo
-
-         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
-                                 reshape( hsnif, (/jpi,jpj,1/) ), &
-                          zalb_cs, zalb_os )
-
-         SELECT CASE( ksbc )
-         CASE( jp_blk , jp_purecpl )   ! BULK and COUPLED bulk formulations
-
-            ! albedo depends on cloud fraction because of non-linear spectral effects
-            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-
-         END SELECT
-
-         ! ... Sea-ice surface boundary conditions output from bulk formulae :
-         !     - utau_ice   ! surface ice stress i-component (I-point)   [N/m2]
-         !     - vtau_ice   ! surface ice stress j-component (I-point)   [N/m2]
-         !     - qns_ice    ! non solar heat flux over ice   (T-point)   [W/m2]
-         !     - qsr_ice    !     solar heat flux over ice   (T-point)   [W/m2]
-         !     - qla_ice    ! latent    heat flux over ice   (T-point)   [W/m2]
-         !     - dqns_ice   ! non solar heat sensistivity    (T-point)   [W/m2]
-         !     - dqla_ice   ! latent    heat sensistivity    (T-point)   [W/m2]
-         !     - tprecip    ! total precipitation            (T-point)   [Kg/m2/s]
-         !     - sprecip    ! solid precipitation            (T-point)   [Kg/m2/s]
-         !     - fr1_i0     ! 1sr fraction of qsr penetration in ice     [%]
-         !     - fr2_i0     ! 2nd fraction of qsr penetration in ice     [%]
-         !
-         SELECT CASE( ksbc )
-         !
-         CASE( jp_blk )           ! Bulk formulation
-            CALL blk_ice_tau
-            CALL blk_ice_flx( zsist, zalb_ice )
-            !
-         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
-            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
-            !
-         END SELECT
-         
-         IF( ln_mixcpl) THEN
-            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
-            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
-            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
-         ENDIF
-
-         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
-
-         IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-            CALL prt_ctl_info( 'Ice Forcings ' )
-            CALL prt_ctl( tab2d_1=tprecip ,clinfo1=' sbc_ice_lim: precip  : ', tab2d_2=sprecip , clinfo2=' Snow    : ' )
-            CALL prt_ctl( tab2d_1=utau_ice,clinfo1=' sbc_ice_lim: utau_ice: ', tab2d_2=vtau_ice, clinfo2=' vtau_ice: ' )
-            CALL prt_ctl( tab2d_1=sst_m   ,clinfo1=' sbc_ice_lim: sst     : ', tab2d_2=sss_m   , clinfo2=' sss     : ' )
-            CALL prt_ctl( tab2d_1=u_oce   ,clinfo1=' sbc_ice_lim: u_io    : ', tab2d_2=v_oce   , clinfo2=' v_io    : ' )
-            CALL prt_ctl( tab2d_1=hsnif   ,clinfo1=' sbc_ice_lim: hsnif  1: ', tab2d_2=hicif   , clinfo2=' hicif   : ' )
-            CALL prt_ctl( tab2d_1=frld    ,clinfo1=' sbc_ice_lim: frld   1: ', tab2d_2=sist    , clinfo2=' sist    : ' )
-         ENDIF
-
-         ! ---------------- !
-         !  Ice model step  !
-         ! ---------------- !
-         numit = numit + nn_fsbc                           ! Ice model time step
-
-                           CALL lim_rst_opn_2  ( kt )  ! Open Ice restart file
-         IF( .NOT. lk_c1d ) THEN                       ! Ice dynamics & transport (except in 1D case)
-                           CALL lim_dyn_2      ( kt )      ! Ice dynamics    ( rheology/dynamics )
-                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion )
-           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping 
-           IF( ln_bdy    ) CALL bdy_ice_lim( kt ) ! bdy ice thermo
-         END IF
-         !                                             ! Ice surface fluxes in coupled mode 
-         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations
-            a_i(:,:,1)=fr_i
-            CALL sbc_cpl_ice_flx( frld,                                              &
-            !                                optional arguments, used only in 'mixed oce-ice' case
-            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist )
-            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
-         ENDIF
-                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
-                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
-
-         IF(  .NOT. lk_mpp )THEN
-            IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 )   &
-            &              CALL lim_dia_2      ( kt )      ! Ice Diagnostics
-         ENDIF
-# if ! defined key_iomput
-                           CALL lim_wri_2      ( kt )      ! Ice outputs
-# endif
-         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
-         !
-# if defined key_agrif && defined key_lim2
-         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt )
-# endif
-         !
-         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
-         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
-         !
-      ENDIF                                    ! End sea-ice time step only
-      !
-      !                                        !--------------------------!
-      !                                        !  at all ocean time step  !
-      !                                        !--------------------------!
-      !                                               
-      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
-      !                                                   ! otherwise the atm.-ocean stresses are used everywhere
-      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
-      !
-   END SUBROUTINE sbc_ice_lim_2
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option           Dummy module      NO LIM 2.0 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine
-      INTEGER, INTENT(in) ::   kt, ksbc    
-      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc
-   END SUBROUTINE sbc_ice_lim_2
-#endif
-
-   !!======================================================================
-END MODULE sbcice_lim_2
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 8879)
@@ -33,6 +33,7 @@
    USE sbcblk         ! surface boundary condition: bulk formulation
    USE sbcice_if      ! surface boundary condition: ice-if sea-ice model
-   USE sbcice_lim     ! surface boundary condition: LIM 3.0 sea-ice model
-   USE sbcice_lim_2   ! surface boundary condition: LIM 2.0 sea-ice model
+#if defined key_lim3
+   USE icestp         ! surface boundary condition: LIM 3.0 sea-ice model
+#endif
    USE sbcice_cice    ! surface boundary condition: CICE    sea-ice model
    USE sbcisf         ! surface boundary condition: ice-shelf
@@ -90,6 +91,6 @@
       NAMELIST/namsbc/ nn_fsbc  ,                                                    &
          &             ln_usr   , ln_flx   , ln_blk       ,                          &
-         &             ln_cpl   , ln_mixcpl, nn_components, nn_limflx,               &
-         &             nn_ice   , nn_ice_embd,                                       &
+         &             ln_cpl   , ln_mixcpl, ln_meto_cpl  , nn_components,           &
+         &             nn_ice   , ln_ice_embd,                                       &
          &             ln_traqsr, ln_dm2dc ,                                         &
          &             ln_rnf   , nn_fwb   , ln_ssr   , ln_isf    , ln_apr_dyn ,     &
@@ -117,12 +118,10 @@
 #if defined key_agrif
       IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid)
-         IF( lk_lim2 )   nn_ice      = 2
-         IF( lk_lim3 )   nn_ice      = 3
-         IF( lk_cice )   nn_ice      = 4
+         IF( lk_lim3 )   nn_ice      = 2
+         IF( lk_cice )   nn_ice      = 3
       ENDIF
 #else
-      IF( lk_lim2 )   nn_ice      = 2
-      IF( lk_lim3 )   nn_ice      = 3
-      IF( lk_cice )   nn_ice      = 4
+      IF( lk_lim3 )   nn_ice      = 2
+      IF( lk_cice )   nn_ice      = 3
 #endif
       !
@@ -138,10 +137,10 @@
          WRITE(numout,*) '         mixed forced-coupled     formulation       ln_mixcpl     = ', ln_mixcpl
 !!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist 
+         WRITE(numout,*) '         Met Office coupling formulation            ln_mixcpl     = ', ln_meto_cpl
          WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis
          WRITE(numout,*) '         components of your executable              nn_components = ', nn_components
-         WRITE(numout,*) '         Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx
          WRITE(numout,*) '      Sea-ice : '
          WRITE(numout,*) '         ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice
-         WRITE(numout,*) '         ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd
+         WRITE(numout,*) '         ice embedded into ocean                    ln_ice_embd   = ', ln_ice_embd
          WRITE(numout,*) '      Misc. options of sbc : '
          WRITE(numout,*) '         Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr
@@ -201,40 +200,18 @@
       CASE( 0 )                        !- no ice in the domain
       CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)  
-      CASE( 2 )                        !- LIM2 ice model
-         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : LIM2 sea-ice model requires ln_blk or ln_cpl = T' )
-      CASE( 3 )                        !- LIM3 ice model
-         IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : LIM3 sea-ice models require nn_ice_embd = 1 or 2' )
-      CASE( 4 )                        !- CICE ice model
+      CASE( 2 )                        !- LIM3 ice model
+      CASE( 3 )                        !- CICE ice model
          IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' )
-         IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : CICE sea-ice models require nn_ice_embd = 1 or 2' )
          IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
       CASE DEFAULT                     !- not supported
       END SELECT
       !
-      IF( nn_ice == 3 ) THEN           !- LIM3 case: multi-category flux option
-         IF(lwp) WRITE(numout,*)
-         SELECT CASE( nn_limflx )         ! LIM3 Multi-category heat flux formulation
-         CASE ( -1 )
-            IF(lwp) WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) '
-            IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
-         CASE ( 0  )
-            IF(lwp) WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) '
-         CASE ( 1  )
-            IF(lwp) WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) '
-            IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
-         CASE ( 2  )
-            IF(lwp) WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) '
-            IF( .NOT.ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in forced mode cannot be 2' )
-         CASE DEFAULT
-            CALL ctl_stop( 'sbcmod: LIM3 option, nn_limflx, should be between -1 and 2' )
-         END SELECT
-      ELSE                             ! other sea-ice model
-         IF( nn_limflx >= 0  )   CALL ctl_warn( 'sbc_init : multi-category flux option (nn_limflx) only available in LIM3' )
-      ENDIF
-      !
       !                       !**  allocate and set required variables
       !
       !                             !* allocate sbc arrays
       IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' )
+#if ! defined key_lim3 && ! defined key_cice
+      IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_ice arrays' )
+#endif
       !
       IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero
@@ -331,13 +308,18 @@
       IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization
       !
-      IF( ln_isf      )   CALL sbc_isf_init               ! Compute iceshelves
+      IF( ln_isf      )   CALL sbc_isf_init            ! Compute iceshelves
       !
                           CALL sbc_rnf_init            ! Runof initialization
       !
-      IF( nn_ice == 3 )   CALL sbc_lim_init            ! LIM3 initialization
-      !
-      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )   ! CICE initialization
-      !
-      IF( ln_wave     )   CALL sbc_wave_init              ! surface wave initialisation
+#if defined key_lim3
+           IF    ( lk_agrif .AND. nn_ice == 0 ) THEN
+                          IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' )  ! clem2017: allocate ice arrays in case agrif + lim + no-ice in child grid
+           ELSEIF( nn_ice == 2 ) THEN
+                          CALL ice_init                ! LIM3 initialization
+           ENDIF
+#endif
+      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc )   ! CICE initialization
+      !
+      IF( ln_wave     )   CALL sbc_wave_init           ! surface wave initialisation
       !
    END SUBROUTINE sbc_init
@@ -428,8 +410,9 @@
       !
       SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas
-      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model)
-      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model
-      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model
-      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model
+      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )             ! Ice-cover climatology ("Ice-if" model)
+#if defined key_lim3
+      CASE(  2 )   ;         CALL ice_stp  ( kt, nsbc )           ! LIM-3 ice model
+#endif
+      CASE(  3 )   ;         CALL sbc_ice_cice ( kt, nsbc )       ! CICE ice model
       END SELECT
 
@@ -539,5 +522,5 @@
       !!---------------------------------------------------------------------
       !
-      IF( nn_ice == 4 )   CALL cice_sbc_final
+      IF( nn_ice == 3 )   CALL cice_sbc_final
       !
    END SUBROUTINE sbc_final
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 8879)
@@ -236,5 +236,5 @@
       ENDIF
       !
-      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate
+      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by iceistate
          !
          IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays'
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 8879)
@@ -137,5 +137,9 @@
          END DO
       END DO   
-      CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. )
+!!gm      CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. )
+      CALL lbc_lnk( usd(:,:,:), 'U', -1. )
+      CALL lbc_lnk( vsd(:,:,:), 'V', -1. )
+
+
       !
       !                       !==  vertical Stokes Drift 3D velocity  ==!
@@ -152,10 +156,12 @@
       END DO
       !
-      IF( .NOT. AGRIF_Root() ) THEN
-         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh(nlci-1,   :  ,:) = 0._wp      ! east
-         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh(  2   ,   :  ,:) = 0._wp      ! west
-         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh(  :   ,nlcj-1,:) = 0._wp      ! north
-         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh(  :   ,  2   ,:) = 0._wp      ! south
-      ENDIF
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west
+         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east
+         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south
+         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north
+      ENDIF
+#endif
       !
       CALL lbc_lnk( ze3divh, 'T', 1. )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 8879)
@@ -48,5 +48,4 @@
    LOGICAL , PUBLIC ::   ln_qsr_2bd   !: 2 band         light absorption flag
    LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag
-   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem)
    INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
    REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
@@ -269,15 +268,13 @@
       END DO
       !
-      IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
-               ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
-               ENDIF
-            END DO
-         END DO
-         ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere
-         CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
-      ENDIF
+      ! sea-ice: store the 1st ocean level attenuation coefficient
+      DO jj = 2, jpjm1 
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
+            ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
+            ENDIF
+         END DO
+      END DO
+      CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
       !
       IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
@@ -336,5 +333,5 @@
       TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
       !!
-      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
+      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,  &
          &                  nn_chldta, rn_abs, rn_si0, rn_si1
       !!----------------------------------------------------------------------
@@ -359,5 +356,4 @@
          WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
          WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
-         WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice
          WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
          WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90	(revision 8879)
@@ -27,6 +27,6 @@
 
    PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module
-   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
-   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
+   PUBLIC   usrdef_sbc_ice_tau  ! routine called by icestp.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx  ! routine called by icestp.F90 for ice thermo
 
    !! * Substitutions
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8879)
@@ -141,7 +141,4 @@
       CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
 # endif
-# if defined key_lim2
-      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM2
-# endif
 # if defined key_lim3
       CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3
@@ -640,5 +637,5 @@
       !
       IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
-      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
+      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
       IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
       IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/oce.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 8879)
@@ -65,12 +65,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
 
-   !! arrays relating to embedding ice in the ocean. These arrays need to be declared 
-   !! even if no ice model is required. In the no ice model or traditional levitating 
-   !! ice cases they contain only zeros
-   !! ---------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
-
    !! Energy budget of the leads (open water embedded in sea ice)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-]
@@ -87,5 +79,5 @@
       !!                   ***  FUNCTION oce_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(7)
+      INTEGER :: ierr(6)
       !!----------------------------------------------------------------------
       !
@@ -110,16 +102,14 @@
          &     riceload(jpi,jpj),                             STAT=ierr(2) )
          !
-      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) )
-         !
-      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) )
+      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(3) )
          !
       ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
          &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), &
          &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), &
-         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(5) )
+         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(4) )
          !
-      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(6) )
+      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(5) )
 #if defined key_agrif
-      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(7) )
+      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(6) )
 #endif
          !
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 8879)
@@ -61,7 +61,7 @@
       !!                     ***  ROUTINE stp  ***
       !!
-      !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.)
-      !!              - Time stepping of LIM (dynamic and thermodynamic eqs.)
-      !!              - Tme stepping  of TRC (passive tracer eqs.)
+      !! ** Purpose : - Time stepping of OPA  (momentum and active tracer eqs.)
+      !!              - Time stepping of ESIM (dynamic and thermodynamic eqs.)
+      !!              - Time stepping of TRC  (passive tracer eqs.)
       !!
       !! ** Method  : -1- Update forcings and data
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8879)
@@ -9,4 +9,6 @@
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
    !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
+   !!            3.7  ! 2016-09  (G. Madec)  Remove solver
+   !!            4.0  ! 2017-04  (G. Madec)  regroup global communications
    !!----------------------------------------------------------------------
 
@@ -21,5 +23,4 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! distributed memory computing
-   USE lib_fortran     ! Fortran routines library 
 
    IMPLICIT NONE
@@ -42,8 +43,11 @@
       !! ** Method  : - Save the time step in numstp
       !!              - Print it each 50 time steps
-      !!              - Stop the run IF problem ( indic < 0 )
+      !!              - Stop the run IF problem encountered by setting indic=-3
+      !!                Problems checked: |ssh| maximum larger than 10 m
+      !!                                  |U|   maximum larger than 10 m/s 
+      !!                                  negative sea surface salinity
       !!
-      !! ** Actions :   'time.step' file containing the last ocean time-step
-      !!                
+      !! ** Actions :   "time.step" file = last ocean time-step
+      !!                "run.stat"  file = run statistics
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
@@ -51,8 +55,11 @@
       !!
       INTEGER  ::   ji, jj, jk             ! dummy loop indices
-      INTEGER  ::   ii, ij, ik             ! local integers
-      REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars
-      INTEGER, DIMENSION(3) ::   ilocu     ! 
-      INTEGER, DIMENSION(2) ::   ilocs     ! 
+      INTEGER  ::   iih, ijh               ! local integers
+      INTEGER  ::   iiu, iju, iku          !   -       -
+      INTEGER  ::   iis, ijs               !   -       -
+      REAL(wp) ::   zzz                    ! local real 
+      INTEGER , DIMENSION(3) ::   ilocu
+      INTEGER , DIMENSION(2) ::   ilocs, iloch
+      REAL(wp), DIMENSION(3) ::   zmax
       !!----------------------------------------------------------------------
       !
@@ -61,126 +68,62 @@
          WRITE(numout,*) 'stp_ctl : time-stepping control'
          WRITE(numout,*) '~~~~~~~'
-         ! open time.step file
+         !                                ! open time.step file
          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         !                                ! open run.stat file
+         CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
       !
-      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
-      IF(lwp) REWIND( numstp )                       !  --------------------------
+      IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file)
+         WRITE ( numstp, '(1x, i8)' )   kt
+         REWIND( numstp )
+      ENDIF
       !
-      !                                              !* Test maximum of velocity (zonal only)
-      !                                              !  ------------------------
-      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
-      zumax = 0.e0
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
-          END DO 
-        END DO 
-      END DO        
-      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
+      !                                   !==  test of extrema  ==!
+      zmax(1) = MAXVAL(  ABS( sshn(:,:) )  )                                  ! ssh max
+      zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only)
+      zmax(3) = MAXVAL( -tsn(:,:,1,jp_sal) , mask = tmask(:,:,1) == 1._wp )   ! minus surface salinity max
       !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
+      IF( lk_mpp )   CALL mpp_max_multiple( zmax(:), 3 ) ! max over the global domain
       !
-      IF( zumax > 20.e0 ) THEN
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN
+         WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ',   zmax(1), ' |U| max: ', zmax(2),   &
+            &                                     ' SSS min: '  , - zmax(3)
+      ENDIF
+      !
+      IF ( zmax(1) > 10._wp .OR.   &                     ! too large sea surface height ( > 10 m)
+         & zmax(2) > 10._wp .OR.   &                     ! too large velocity ( > 10 m/s)
+         & zmax(3) >  0._wp ) THEN                       ! negative sea surface salinity
          IF( lk_mpp ) THEN
-            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
+            CALL mpp_maxloc( ABS(sshn)        , tmask(:,:,1), zzz, iih, ijh )
+            CALL mpp_maxloc( ABS(un)          , umask       , zzz, iiu, iju, iku )
+            CALL mpp_minloc( tsn(:,:,1,jp_sal), tmask(:,:,1), zzz, iis, ijs )
          ELSE
+            iloch = MINLOC( ABS( sshn(:,:) ) )
             ilocu = MAXLOC( ABS( un(:,:,:) ) )
-            ii = ilocu(1) + nimpp - 1
-            ij = ilocu(2) + njmpp - 1
-            ik = ilocu(3)
+            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1._wp )
+            iih = iloch(1) + nimpp - 1   ;   ijh = iloch(2) + njmpp - 1
+            iiu = ilocu(1) + nimpp - 1   ;   iju = ilocu(2) + njmpp - 1   ;   iku = ilocu(3)
+            iis = ilocs(1) + nimpp - 1   ;   ijs = ilocs(2) + njmpp - 1
          ENDIF
          IF(lwp) THEN
             WRITE(numout,cform_err)
-            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
+            WRITE(numout,*) ' stpctl: |ssh| > 10 m   or   |U| > 10 m/s   or   SSS < 0'
             WRITE(numout,*) ' ====== '
-            WRITE(numout,9400) kt, zumax, ii, ij, ik
+            WRITE(numout,9100) kt,   zmax(1), iih, ijh
+            WRITE(numout,9200) kt,   zmax(2), iiu, iju, iku
+            WRITE(numout,9300) kt, - zmax(3), iis, ijs
             WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
+            WRITE(numout,*) '          output of last computed fields in output.abort.nc file'
          ENDIF
          kindic = -3
       ENDIF
-9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
+9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5)
+9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5)
+9300  FORMAT (' kt=',i8,'   SSS   min: ',1pg11.4,', at  i j  : ',2i5)
       !
-      !                                              !* Test minimum of salinity
-      !                                              !  ------------------------
-      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
-      zsmin = 100._wp
-      DO jj = 2, jpjm1
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
+      !                                            !==  run statistics  ==!   ("run.stat" file)
+      IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3)
       !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
-      !
-      IF( zsmin < 0.) THEN 
-         IF (lk_mpp) THEN
-            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
-         ELSE
-            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
-            ii = ilocs(1) + nimpp - 1
-            ij = ilocs(2) + njmpp - 1
-         ENDIF
-         !
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
-            WRITE(numout,*) '======= '
-            WRITE(numout,9500) kt, zsmin, ii, ij
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
-      !
-      !
-      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
-
-      ! log file (ssh statistics)
-      ! --------                                   !* ssh statistics (and others...)
-      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
-         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      zsshmax = 0.e0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_max( zsshmax )                ! min over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax
-      !
-      IF( zsshmax > 10.e0 ) THEN 
-         IF (lk_mpp) THEN
-            CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij)
-         ELSE
-            ilocs = MAXLOC( ABS(sshn(:,:)) )
-            ii = ilocs(1) + nimpp - 1
-            ij = ilocs(2) + njmpp - 1
-         ENDIF
-         !
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m'
-            WRITE(numout,*) '======= '
-            WRITE(numout,9600) kt, zsshmax, ii, ij
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9600  FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5)
-      !
-      zssh2 = glob_sum( sshn(:,:) * sshn(:,:) )
-      !
-      IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics
-      !
-9700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16)
+9400  FORMAT(' it :', i8, '    |ssh|_max: ', e16.10, ' |U|_max: ',e16.10,' SSS_min: ',e16.10)
       !
    END SUBROUTINE stp_ctl
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/diawri.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 8879)
@@ -38,8 +38,6 @@
    USE iom
    USE ioipsl
-#if defined key_lim2
-   USE limwri_2 
-#elif defined key_lim3
-   USE limwri
+#if defined key_lim3
+   USE icewri
 #endif
    USE lib_mpp         ! MPP library
@@ -397,8 +395,8 @@
          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 
-#if defined key_lim2
-      CALL lim_wri_state_2( kt, id_i, nh_i )
-#elif defined key_lim3
-      CALL lim_wri_state( kt, id_i, nh_i )
+#if defined key_lim3
+      IF( nn_ice == 2 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid
+         CALL ice_wri_state( kt, id_i, nh_i )
+      ENDIF
 #else
       CALL histend( id_i, snc4chunks=snc4set )
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 8879)
@@ -86,7 +86,4 @@
       CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
 # endif
-# if defined key_lim2
-      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM
-# endif
 # if defined key_lim3
       CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3
@@ -134,9 +131,9 @@
       !
 #if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN
+!!clem2017      IF( .NOT. Agrif_Root() ) THEN
          CALL Agrif_ParentGrid_To_ChildGrid()
          IF( nn_timing == 1 )   CALL timing_finalize
          CALL Agrif_ChildGrid_To_ParentGrid()
-      ENDIF
+!!clem2017      ENDIF
 #endif
       IF( nn_timing == 1 )   CALL timing_finalize
@@ -513,5 +510,5 @@
       ierr =        dia_wri_alloc   ()
       ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + oce_alloc       ()          ! (tsn...) needed for agrif and/or lim3 and bdy
+      ierr = ierr + oce_alloc       ()          ! (tsn...) needed for agrif and/or ESIM and bdy
       ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
       !
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 8879)
@@ -115,5 +115,5 @@
       ELSE
          sst_m(:,:) = 0._wp
-         sss_m(:,:) = 0._wp
+         sss_m(:,:) = 35._wp
          ssu_m(:,:) = 0._wp
          ssv_m(:,:) = 0._wp
@@ -313,5 +313,5 @@
    ENDIF
  
-      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate
+      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate
       l_initdone = .TRUE.
       !
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/step.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 8879)
@@ -24,5 +24,5 @@
    USE diawri           ! Standard run outputs             (dia_wri routine)
    USE bdy_oce   , ONLY: ln_bdy
-   USE bdydta           ! clem: mandatory for LIM3
+   USE bdydta           ! clem: mandatory for ESIM
    USE stpctl           ! time stepping control            (stp_ctl routine)
    !
@@ -89,5 +89,5 @@
                              CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp
 
-      ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from  
+      ! ==> clem: open boundaries is mandatory for ESIM because ice BDY is not decoupled from  
       !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
       !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.  
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 8879)
@@ -63,5 +63,5 @@
       INTEGER  ::   ji, jj, jn                                     ! dummy loop indices
       REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars
-      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars
+      REAL(wp) ::   zftra, zcd, zdtra, ztfx, ztra                  ! temporary scalars
       CHARACTER (len=22) :: charout
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx
@@ -77,10 +77,4 @@
       !
       zrtrn = 1.e-15_wp
-
-      SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option
-         CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only
-         CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                
-      !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure
-      END SELECT
 
       IF( kt == nittrc000 ) THEN
@@ -145,5 +139,5 @@
                   ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux
                   ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
-                  ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange)
+                  ztfx  = zftra                             ! net tracer flux
    
                   zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 8879)
@@ -63,5 +63,4 @@
    USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths
    USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1)
-   USE sbc_oce , ONLY :   nn_ice_embd => nn_ice_embd  !: flag for  levitating/embedding sea-ice in the ocean
    USE sbc_oce , ONLY :   atm_co2    =>    atm_co2    !  atmospheric pCO2
    USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 8879)
@@ -172,8 +172,8 @@
    CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers
    INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping
+!$AGRIF_DO_NOT_TREAT
    ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp
    TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process)
-   !
-
+!$AGRIF_END_DO_NOT_TREAT
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA	(revision 8879)
@@ -11,5 +11,5 @@
 # @ total_tasks = NPROCS
 # time
-# @ wall_clock_limit = 1:30:00
+# @ wall_clock_limit = 00:59:00
 # @ queue
 
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS	(revision 8879)
@@ -8,5 +8,5 @@
 module load intel/compiler/64/14.0/2013_sp1.2.144
 module load openmpi/intel/64/1.6.5
-module load slurm/2.5.7
+module load slurm/16.05.8
 
 #
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/README
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/README	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/README	(revision 8879)
@@ -45,5 +45,5 @@
                INPUT_DIR   	   : directory in which store input files (tar file)
                TMPDIR      	   : temporary directory NEEDED ONLY FOR IBM machines (put EXP00 directory)
-	       NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, solver.stat, tracer.stat and ocean.output files in
+	       NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, run.stat, tracer.stat and ocean.output files in
       			             tree NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE)
  in fcm_job.sh :
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/all_functions.sh
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/all_functions.sh	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/all_functions.sh	(revision 8879)
@@ -219,17 +219,17 @@
     fi
     # Save output & debug files in NEMO_VALIDATION tree
-    echo "saving ocean & ice output, solver.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette
+    echo "saving ocean & ice output, run.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette
     echo "            " >> ${SETTE_DIR}/output.sette
     [ -f ${EXE_DIR}/ocean.output ] && cp ${EXE_DIR}/*ocean.output ${NEMO_VALID}/.
-    [ -f ${EXE_DIR}/solver.stat ] && cp ${EXE_DIR}/*solver.stat ${NEMO_VALID}/.
+    [ -f ${EXE_DIR}/run.stat ] && cp ${EXE_DIR}/*run.stat ${NEMO_VALID}/.
     [ -f ${EXE_DIR}/output.namelist.dyn ] && cp ${EXE_DIR}/*output.nam* ${NEMO_VALID}/.
     [ -f ${EXE_DIR}/tracer.stat ] && cp ${EXE_DIR}/*tracer.stat ${NEMO_VALID}/.
 
-    if [ -n "$(ls ${NEMO_VALID}/*solver*)" ] ; then
-	echo "moved solver.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
-	echo "moved solver.stat in ${NEMO_VALID} directory"  
+    if [ -n "$(ls ${NEMO_VALID}/*run*)" ] ; then
+	echo "moved run.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "moved run.stat in ${NEMO_VALID} directory"  
     else
-	echo "problem in looking for solver.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
-	echo "solver.stat IS NOT in ${NEMO_VALID} directory" 
+	echo "problem in looking for run.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "run.stat IS NOT in ${NEMO_VALID} directory" 
     fi
     if [ -n "$(ls ${NEMO_VALID}/*ocean.output*)" ] ; then
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette.sh
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette.sh	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette.sh	(revision 8879)
@@ -56,5 +56,5 @@
 #   set_namelist     : function declared in all_functions that sets namelist parameters 
 #   post_test_tidyup : creates validation storage directory and copies required output files 
-#                      (solver.stat and ocean.output) in it after execution of test.
+#                      (run.stat and ocean.output) in it after execution of test.
 #
 #  VALIDATION tree is:
@@ -137,5 +137,5 @@
 # ORCA2_OFF_PISCES  :  5 &  6
 # AMM12             :  7 &  8 
-# SAS               :  9     fos SAS there is no solver so is useless to test REPRO
+# SAS               :  9     fos SAS there is no run.stat so is useless to test REPRO
 # ISOMIP            : 10 & 11
 # ORCA2_LIM3_OBS    : 12
@@ -143,5 +143,5 @@
 #                     15 & 16 
 
-for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
+for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 
 
 do
@@ -312,4 +312,6 @@
     set_namelist namelist_cfg jpnj 8
     set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_ice_cfg ln_icediachk .true.
+##    set_namelist namelist_ice_cfg ln_icediahsb .true.
     set_namelist namelist_top_cfg ln_trcdta .false.
     # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
@@ -350,4 +352,6 @@
     set_namelist namelist_cfg jpnj 8
     set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_ice_cfg ln_icediachk .true.
+##    set_namelist namelist_ice_cfg ln_icediahsb .true.
     set_namelist namelist_top_cfg ln_rsttr .true.
     set_namelist namelist_top_cfg nn_rsttr 2
@@ -411,4 +415,6 @@
     set_namelist namelist_cfg jpnj 8
     set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_ice_cfg ln_icediachk .true.
+    set_namelist namelist_ice_cfg ln_icediahsb .true.
     set_namelist namelist_top_cfg ln_trcdta .false.
     # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
@@ -452,4 +458,6 @@
     set_namelist namelist_cfg jpnj 4
     set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_ice_cfg ln_icediachk .true.
+    set_namelist namelist_ice_cfg ln_icediahsb .true.
     set_namelist namelist_top_cfg ln_trcdta .false.
     # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
@@ -661,5 +669,5 @@
     export TEST_NAME="LONG"
     cd ${CONFIG_DIR0}
-    . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_tide" del_key ${DEL_KEYS}
+    . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 del_key ${DEL_KEYS}
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -810,4 +818,5 @@
     set_namelist namelist_cfg jpnj 8
     set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_ice_cfg ln_icediachk .true.
     if [ ${USING_MPMD} == "yes" ] ; then
        set_xio_using_server iodef.xml true
@@ -835,4 +844,5 @@
     set_namelist namelist_cfg ln_rstart .true.
     set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_ice_cfg ln_icediachk .true.
     set_namelist namelist_ice_cfg cn_icerst_in \"SAS_00000050_restart_ice\"
     if [ ${USING_MPMD} == "yes" ] ; then
@@ -1121,4 +1131,5 @@
     set_namelist 1_namelist_cfg nn_it000 1
     set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
@@ -1219,5 +1230,5 @@
     export TEST_NAME="LONG"
     cd ${CONFIG_DIR0}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top"
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif key_zdftmx" del_key "key_zdftmx_new key_top"
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -1245,4 +1256,5 @@
     set_namelist 1_namelist_cfg nn_itend 300
     set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
@@ -1283,4 +1295,5 @@
     set_namelist 1_namelist_cfg nn_itend 300
     set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_rstart .true.
     set_namelist 1_namelist_cfg nn_rstctl 2
@@ -1293,4 +1306,5 @@
     set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\"
     set_namelist 1_namelist_cfg cn_ocerst_in \"O2LP_LONG_00000150_restart\"
+    set_namelist 1_namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000150_restart_ice\"
 
     for (( i=1; i<=$NPROC; i++)) ; do
@@ -1300,4 +1314,5 @@
         ln -sf ../LONG/O2LP_LONG_00000075_restart_ice_${L_NPROC}.nc .
         ln -sf ../LONG/1_O2LP_LONG_00000150_restart_${L_NPROC}.nc .
+        ln -sf ../LONG/1_O2LP_LONG_00000150_restart_ice_${L_NPROC}.nc .
     done
     if [ ${USING_MPMD} == "yes" ] ; then
@@ -1316,5 +1331,5 @@
     export TEST_NAME="REPRO_4_4"
     cd ${CONFIG_DIR0}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top"
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif key_zdftmx" del_key "key_zdftmx_new key_top"
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -1339,4 +1354,5 @@
     set_namelist 1_namelist_cfg nn_it000 1
     set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
@@ -1378,4 +1394,5 @@
     set_namelist 1_namelist_cfg nn_itend 150
     set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_clobber .true.
     set_namelist 1_namelist_cfg ln_read_cfg .true.
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_beginner.sh
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_beginner.sh	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_beginner.sh	(revision 8879)
@@ -55,5 +55,5 @@
 #   set_namelist     : function declared in all_functions that sets namelist parameters 
 #   post_test_tidyup : creates validation storage directory and copies required output files 
-#                      (solver.stat and ocean.output) in it after execution of test.
+#                      (run.stat and ocean.output) in it after execution of test.
 #
 #  VALIDATION tree is:
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_rpt.sh
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_rpt.sh	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_rpt.sh	(revision 8879)
@@ -1,4 +1,5 @@
 #!/bin/bash -f
 #
+# set -vx
 # simple SETTE report generator.
 #
@@ -23,8 +24,8 @@
     dorv=`echo $dorv | sed -e 's:.*/::'`
     f1o=$vdir/$nam/$mach/$dorv/LONG/ocean.output
-    f1s=$vdir/$nam/$mach/$dorv/LONG/solver.stat
+    f1s=$vdir/$nam/$mach/$dorv/LONG/run.stat
     f1t=$vdir/$nam/$mach/$dorv/LONG/tracer.stat
     f2o=$vdir/$nam/$mach/$dorv/SHORT/ocean.output
-    f2s=$vdir/$nam/$mach/$dorv/SHORT/solver.stat
+    f2s=$vdir/$nam/$mach/$dorv/SHORT/run.stat
     f2t=$vdir/$nam/$mach/$dorv/SHORT/tracer.stat
 
@@ -46,13 +47,13 @@
       if [ $? == 0 ]; then
         if [ $pass == 0 ]; then 
-          printf "%-20s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv 
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view solver.stat differences"
+          printf "%-20s %s %s\n" $nam  " run.stat    restartability  passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " run.stat    restartability  FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view run.stat differences"
           read y
           sdiff f1.tmp$$ $f2s
@@ -118,8 +119,8 @@
     rep2=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -1l`
     f1o=$vdir/$nam/$mach/$dorv/$rep1/ocean.output
-    f1s=$vdir/$nam/$mach/$dorv/$rep1/solver.stat
+    f1s=$vdir/$nam/$mach/$dorv/$rep1/run.stat
     f1t=$vdir/$nam/$mach/$dorv/$rep1/tracer.stat
     f2o=$vdir/$nam/$mach/$dorv/$rep2/ocean.output
-    f2s=$vdir/$nam/$mach/$dorv/$rep2/solver.stat
+    f2s=$vdir/$nam/$mach/$dorv/$rep2/run.stat
     f2t=$vdir/$nam/$mach/$dorv/$rep2/tracer.stat
 
@@ -139,13 +140,13 @@
       if [ $? == 0 ]; then
         if [ $pass == 0 ]; then 
-          printf "%-20s %s %s\n" $nam  " solver.stat reproducibility passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " solver.stat reproducibility FAILED : " $dorv 
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view solver.stat differences"
+          printf "%-20s %s %s\n" $nam  " run.stat    reproducibility passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " run.stat    reproducibility FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view run.stat differences"
           read y
           sdiff f1.tmp$$ $f2s
@@ -199,4 +200,5 @@
   mach=`grep "COMPILER=" ./sette.sh | sed -e 's/COMPILER=//'`
   NEMO_VALID=`grep "NEMO_VALIDATION_DIR=" ./param.cfg | sed -e 's/NEMO_VALIDATION_DIR=//'`
+  NEMO_VALID=`eval "echo $NEMO_VALID"`
 #
   if [ ! -d $NEMO_VALID ]; then
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_xios.sh
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_xios.sh	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/SETTE/sette_xios.sh	(revision 8879)
@@ -52,5 +52,5 @@
 #   set_namelist     : function declared in all_functions that sets namelist parameters 
 #   post_test_tidyup : creates validation storage directory and copies required output files 
-#                      (solver.stat and ocean.output) in it after execution of test.
+#                      (run.stat and ocean.output) in it after execution of test.
 #
 #  VALIDATION tree is:
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 8879)
@@ -65,5 +65,5 @@
  echo "Adding keys in : ${NEW_CONF}" 
  for i in ${list_add_key} ; do
-	if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "$i" )" -ne 0 ] ; then
+	if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "\<$i\>" )" -ne 0 ] ; then
  	   echo "key $i already present in cpp_${NEW_CONF}.fcm" 
 	else
Index: /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref	(revision 8878)
+++ /branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref	(revision 8879)
@@ -278,7 +278,7 @@
                            !  = 2  Redistribute a single flux over categories (coupled mode only)
                      ! Sea-ice :
-   nn_ice      = 2         !  =0 no ice boundary condition   ,
+   nn_ice      = 3         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice")
+                           !  =3-4 ice-model used                         ("key_lim3", "key_cice")
    nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
                            !  =1 levitating ice with mass and salt exchange but no presure effect
@@ -670,8 +670,4 @@
    bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
    bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-! for lim2
-!   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
-!   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
 ! for lim3
 !   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
