Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/iodef.xml
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/iodef.xml	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/iodef.xml	(revision 4056)
@@ -0,0 +1,666 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+        <field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<field id="eken"         description="kinetic energy"                            unit="m2/s2" axis_ref="deptht"   />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+    <!-- tidal composante -->
+    <field id="M2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="M2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="S2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="S2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="N2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="N2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="K1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="K1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="O1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="O1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Q1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Q1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="M4x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="M4y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="K2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="K2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="P1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="P1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Mfx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Mfy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Mmx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Mmy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+
+    <field id="M2x_u"          description="M2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="M2y_u"          description="M2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="S2x_u"          description="S2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="S2y_u"          description="S2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="N2x_u"          description="N2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="N2y_u"          description="N2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K1x_u"          description="K1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="K1y_u"          description="K1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="O1x_u"          description="O1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="O1y_u"          description="O1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Q1x_u"          description="Q1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Q1y_u"          description="Q1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="M4x_u"          description="M4 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="M4y_u"          description="M4 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K2x_u"          description="K2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="K2y_u"          description="K2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="P1x_u"          description="P1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="P1y_u"          description="P1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mfx_u"          description="Mf current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Mfy_u"          description="Mf current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mmx_u"          description="Mm current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Mmy_u"          description="Mm current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+
+    <field id="M2x_v"          description="M2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="M2y_v"          description="M2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="S2x_v"          description="S2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="S2y_v"          description="S2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="N2x_v"          description="N2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="N2y_v"          description="N2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K1x_v"          description="K1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="K1y_v"          description="K1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="O1x_v"          description="O1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="O1y_v"          description="O1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Q1x_v"          description="Q1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Q1y_v"          description="Q1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="M4x_v"          description="M4 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="M4y_v"          description="M4 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K2x_v"          description="K2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="K2y_v"          description="K2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="P1x_v"          description="P1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="P1y_v"          description="P1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mfx_v"          description="Mf current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Mfy_v"          description="Mf current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mmx_v"          description="Mm current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Mmy_v"          description="Mm current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+	
+	<!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+	<field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                  />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"   operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   operation="inst(X)"  />
+        <field id="traj_dep"   description="floats depth"       unit="m"     operation="inst(X)"  />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  operation="inst(X)"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   operation="inst(X)"  />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" operation="inst(X)"  />
+        <field id="traj_group" description="floats group"       unit="none"  operation="inst(X)"  />
+      </group>
+
+      <!-- ptrc on T grid -->
+
+      <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T_crs">
+	<field id="Sal"      description="Salinity tracer"        unit="PSU" />
+      </group>
+
+
+      <!-- coarse grid output -->
+      <group id="gcrs_T" axis_ref="none" grid_ref="grid_T_crs">
+	<field id="toce_crs"   description="temperature"             unit="degC" axis_ref="deptht" />
+       	<field id="soce_crs"   description="salinity"                unit="psu"  axis_ref="deptht" />
+	<field id="ssh_crs"    description="sea surface height"      unit="m"                      />
+	<field id="sst_crs"    description="sea surface temperature" unit="degC"                   />
+	<field id="sss_crs"    description="sea surface salinity"    unit="psu"                    />
+	<field id="hdiv_crs"   description="horizontal divergence"   unit="s-1" axis_ref="deptht"  />
+        <field id="eken_crs"   description="kinetic energy"          unit="m2/s2" axis_ref="deptht" />
+      </group>
+
+      <group id="gcrs_U"  axis_ref="depthu" grid_ref="grid_U_crs">
+	<field id="uoce_crs"   description="ocean current along i-axis"   unit="m/s" />
+	<field id="uocet_crs"   description="ocean current along i-axis times temperature"   unit="degC.m/s" />
+	<field id="uoces_crs"   description="ocean current along i-axis times salinity"   unit="psu.m/s" />
+     </group>
+      
+      <group id="gcrs_V"  axis_ref="depthv" grid_ref="grid_V_crs">
+	<field id="voce_crs"   description="ocean current along j-axis"   unit="m/s" />
+	<field id="vocet_crs"  description="ocean current along j-axis times temperature" unit="degC.m/s" />
+	<field id="voces_crs"  description="ocean current along j-axis times salinity"    unit="psu.m/s" />
+      </group>
+
+      <group id="gcrs_W"  axis_ref="depthw" grid_ref="grid_W_crs">
+	<field id="woce_crs"   description="ocean vertical velocity"            unit="m/s"    />
+	<field id="avs_crs"    description="salt vertical eddy diffusivity"     unit="m2/s"    />
+      </group>
+
+
+    </field_definition>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".FALSE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+        <file id="2h_ptrc_T" name="auto" description="passive tracers" >
+          <field ref="Sal" name="Sal" />
+        </file>
+
+       <file id="2h_gcrs_T" name="auto" description="ocean T grid coarsened variables" >
+          <field ref="soce_crs"         name="vosaline"  />
+        </file>
+
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".FALSE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".FALSE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".FALSE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".FALSE.">                      <!-- 1d files -->
+
+          <file id="1d_grid_T" name="auto" description="ocean T grid coarsened variables" >
+             <field ref="toce"    name="votemper" />
+             <field ref="soce"    name="vosaline" />
+             <field ref="sst"     name="sosstsst" />
+             <field ref="sss"     name="sosaline" />
+             <field ref="ssh"     name="sossheig" />
+             <field ref="eken"    name="energkin"  />
+          </file>
+
+          <file id="1d_gcrs_T" name="auto" description="ocean T grid coarsened variables" >
+             <field ref="toce_crs"    name="votemper" />
+             <field ref="soce_crs"    name="vosaline" />
+      	     <field ref="sst_crs"     name="sosstsst" />
+	     <field ref="sss_crs"     name="sosaline" />
+             <field ref="ssh_crs"     name="sossheig" />
+             <field ref="hdiv_crs"    name="vohdiver" />
+             <field ref="eken_crs"    name="energkin" />
+          </file>
+      
+      </group>
+
+      <group id="3d" output_freq="259200" output_level="10" enabled=".FALSE.">                      <!-- 3d files -->
+      </group>
+
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+        <file id="5d_grid_T" name="auto" description="ocean T grid coarsened variables" >
+	  <field ref="eken"         name="energkin"  />
+          <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	</file>
+
+        <file id="5d_gcrs_T" name="auto" description="ocean T grid coarsened variables" >
+           <field ref="eken_crs"    name="energkin" />
+           <field ref="toce_crs"    name="votemper" />
+           <field ref="soce_crs"    name="vosaline" />
+	   <field ref="sst_crs"     name="sosstsst" />
+	   <field ref="sss_crs"     name="sosaline" />
+           <field ref="ssh_crs"     name="sossheig" />
+           <field ref="hdiv_crs"    name="vohdiver" />
+        </file>	
+
+	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+	  <field ref="uoce"         name="vozocrtx"  />
+	</file>
+
+        <file id="5d_gcrs_U" name="auto" description="ocean U grid coarsened variables" >
+           <field ref="uoce_crs"    name="vozocrtx" />
+           <field ref="uocet_crs"   name="vozouoct" />
+           <field ref="uoces_crs"   name="vozouocs" />
+        </file>	
+	
+	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+	  <field ref="voce"         name="vomecrty"  />
+	</file>
+
+        <file id="5d_gcrs_V" name="auto" description="ocean V grid coarsened variables" >
+           <field ref="voce_crs"    name="vomecrty"  />
+           <field ref="vocet_crs"   name="vomevoct" />
+           <field ref="voces_crs"   name="vomevocs" />
+        </file>	
+	
+	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+	  <field ref="woce"         name="vovecrtz" />
+          <field ref="avs"         name="kzkzkzkz" />
+	</file>
+
+        <file id="5d_gcrs_W" name="auto" description="ocean W grid coarsened variables" >
+           <field ref="woce_crs"    name="vovecrtz"  />
+           <field ref="avs_crs"         name="kzkzkzkz" />
+        </file>	
+
+	<file id="5d_ptrc_T" name="auto" description="passive tracers" >
+	  <field ref="Sal" name="Sal" />
+	</file>
+
+	
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".FALSE.">                      <!-- real monthly files -->
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".FALSE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".FALSE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".FALSE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".FALSE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".FALSE.">                      <!-- real yearly files -->
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".FALSE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".FALSE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".FALSE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m"       positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m"       positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m"       positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m"       positive=".false." />
+      <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+	<zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+	<zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+	<zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+	<zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+	<zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+	<zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+	<zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+	<zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+	<zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+	<zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+	<zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+	<zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+	<zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+ 	<zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+	<zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+	<zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+	<zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+	<zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+	<zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+	<zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+	<zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+	<zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+	<zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+	<zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+	<zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+	<zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_T_crs" description="coarse grid T" />
+      <grid id="grid_U_crs" description="coarse grid U" />
+      <grid id="grid_V_crs" description="coarse grid V" />
+      <grid id="grid_W_crs" description="coarse grid W" />
+
+    </grid_definition>    
+    
+  </context>
+
+</simulation>
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist	(revision 4056)
@@ -0,0 +1,1009 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    = 900       !  last  time step (std 5475)
+   nn_date0    =  010101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T
+                           !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
+                          ! ldf : set lateral mixing parameters
+      ! laplacian operator                      ln_dyldf : set lateral mixing parameters
+      ! laplacian operator                      ln_dy!    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart
+                           !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
+   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
+   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =      75   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =      75   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .true.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namtsd       data: temperature & salinity                         
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    1      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      =  5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.0    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+   ln_crs    = .TRUE.      !  Logical switch for coarsening module
+   nn_crs_kz = 0 
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity                           
+!-----------------------------------------------------------------------
+!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' '
+   !
+   cn_dir        = './'     !  root directory for the location of the runoff files
+   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulae formulation
+!!   namsbc_core     CORE bulk formulae formulation
+!!   namsbc_mfs      MFS  bulk formulae formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .false.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     =   'ecmwf'   ,        6          , 'u10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_wndj     =   'ecmwf'   ,        6          , 'v10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_clc      =   'ecmwf'   ,        6          , 'clc'     ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''
+   sn_msl      =   'ecmwf'   ,        6          , 'msl'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_tair     =   'ecmwf'   ,        6          , 't2'      ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_rhm      =   'ecmwf'   ,        6          , 'rh'      ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''
+   sn_prec     =   'ecmwf'   ,        6          , 'precip'  ,    .true.    , .true.  , 'daily'  ,'bicubic.nc' , ''
+
+   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                    !     description       !  multiple  !    vector   !      vector          ! vector !
+!                    !                       ! categories !  reference  !    orientation       ! grids  !
+! send
+sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''    
+sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''    
+sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''    
+sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'       
+sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''        
+! receive
+sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'   
+sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
+   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
+   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
+   rn_si1      =   23.0    !  2 bands: longest depth of extinction
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .false.    !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =  -166.67  !  magnitude of the damping on salinity   [mm/day]
+   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
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+   ln_tide_pot   = .true.   !  use tidal potential forcing
+   nb_harmo      =    11    !  number of constituents used
+   clname(1)     =   'M2'   !  name of constituent
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   cn_dir  =    'bdydta/'
+   ln_full_vel = .false.
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries              
+!-----------------------------------------------------------------------
+   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                        
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
+   ln_traadv_tvd    =  .true.   !  TVD scheme                
+   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
+   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
+   ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUICKEST scheme                 
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .true.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .false.   !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         = 0! 2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                  
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.2e-1  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   1.2e-4  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .false.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F)
+   nn_npc      =    1            !  frequency of application of npc
+   nn_npcp     =  365            !  npc control print frequency
+   ln_zdfexp   = .false.   !  time-stepping: split-explicit (T) or implicit (F) time stepping
+   nn_zdfexp   =    3            !  number of sub-timestep for ln_zdfexp=T
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+   rn_avmri    = 100.e-4   !  maximum value of the vertical viscosity
+   rn_alp      =   5.      !  coefficient of the parameterization
+   nn_ric      =   2       !  coefficient of the parameterization
+   rn_ekmfc    =   0.7     !  Factor in the Ekman depth Equation
+   rn_mldmin   =   1.0     !  minimum allowable mixed-layer depth estimate (m)
+   rn_mldmax   =1000.0     !  maximum allowable mixed-layer depth estimate (m)
+   rn_wtmix    =  10.0     !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
+   rn_wvmix    =  10.0     !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
+   ln_mldw     = .true.    !  Flag to use or not the mized layer depth param.
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
+   rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
+   rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
+   rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
+   jpni        =   8      !  jpni   number of processors following i (set automatically if < 1)
+   jpnj        =   1       !  jpnj   number of processors following j (set automatically if < 1)
+   jpnij       =   8      !  jpnij  number of local domains (set automatically if < 1)
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+   ln_ctl      = .true.   !  trends control print (expensive!)
+   nn_print    =    0      !  level of print (0 no extra print)
+   nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus
+   nn_ictle    =    0      !  end   i indice of control sum        multi processor runs
+   nn_jctls    =    0      !  start j indice of control               over a subdomain)
+   nn_jctle    =    0      !  end   j indice of control
+   nn_isplt    =    1      !  number of processors in i-direction
+   nn_jsplt    =    1      !  number of processors in j-direction
+   nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
+                           !     (no physical validity of the results)
+   nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   jpnfl         = 1          !  total number of floats during the run
+   jpnnewflo     = 0          !  number of floats for the restart
+   ln_rstflo     = .false.    !  float restart (T) or not (F)
+   nn_writefl    =      75    !  frequency of writing in float output file 
+   nn_stockfl    =    5475    !  frequency of creation of the float restart file 
+   ln_argo       = .false.    !  Argo type floats (stay at the surface each 10 days)
+   ln_flork4     = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
+                              !  or computed with Blanke' scheme (F)
+   ln_ariane     = .true.     !  Input with Ariane tool convention(T)
+   ln_flo_ascii  = .true.     !  Output with Ariane tool netcdf convention(F) or ascii file (T)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+!-----------------------------------------------------------------------
+    nit000_han = 1         ! First time step used for harmonic analysis
+    nitend_han = 75        ! Last time step used for harmonic analysis
+    nstep_han  = 15        ! Time step frequency for harmonic analysis
+    tname(1)   = 'M2'      ! Name of tidal constituents
+    tname(2)   = 'K1'
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 15       !  time step frequency for transports computing
+    nn_dctwri   = 15       !  time step frequency for transports writing
+    nn_secdebug = 112      !      0 : no section to debug
+                           !     -1 : debug all section
+                           !  0 < n : debug section number n
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept   !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or 
+               !   passive tracer coarsened online simulations     
+!-----------------------------------------------------------------------
+   nn_factx  = 3           !  Reduction factor of x-direction
+   nn_facty  = 3           !  Reduction factor of y-direction
+   cn_binref = 'NORTH'     !  Bin centering preference: NORTH or EQUAT
+                           !  NORTH, coarse grid is binned
+                           !         with preferential treatment of
+                           !         the north fold
+                           !  EQUAT, coarse grid is binned
+                           !         with centering at the equator 
+                           !         Symmetry with nn_facty being
+                           !         odd-numbered. Asymmetry with
+                           !         even-numbered nn_facty. 
+   nn_fcrs     = 1         !  frequence of coarsening 
+   nn_msh_crs  = 1         !  frequence of coarsening 
+   ln_crs_top  = .true.    !  frequence of coarsening 
+/
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_crs
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_crs	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_crs	(revision 4056)
@@ -0,0 +1,1009 @@
+!key_traldf_eiv !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =    75   !  last  time step (std 5475)
+   nn_date0    =  010101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T
+                           !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
+                           !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart
+                           !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
+   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
+   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =      75   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =      75   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .true.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namtsd       data: temperature & salinity                         
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+   ln_crs      = .TRUE.      !  Logical switch for coarsening module 
+   nn_crs_kz   = 0         !  coarsening of kz :=0 mean
+                           !                   :=1 max
+                           !                   :=2 min
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity                           
+!-----------------------------------------------------------------------
+!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' '
+   !
+   cn_dir        = './'     !  root directory for the location of the runoff files
+   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulae formulation
+!!   namsbc_core     CORE bulk formulae formulation
+!!   namsbc_mfs      MFS  bulk formulae formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     =   'ecmwf'   ,        6          , 'u10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_wndj     =   'ecmwf'   ,        6          , 'v10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_clc      =   'ecmwf'   ,        6          , 'clc'     ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''
+   sn_msl      =   'ecmwf'   ,        6          , 'msl'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_tair     =   'ecmwf'   ,        6          , 't2'      ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_rhm      =   'ecmwf'   ,        6          , 'rh'      ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''
+   sn_prec     =   'ecmwf'   ,        6          , 'precip'  ,    .true.    , .true.  , 'daily'  ,'bicubic.nc' , ''
+
+   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                    !     description       !  multiple  !    vector   !      vector          ! vector !
+!                    !                       ! categories !  reference  !    orientation       ! grids  !
+! send
+sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''    
+sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''    
+sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''    
+sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'       
+sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''        
+! receive
+sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'   
+sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''    
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
+   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
+   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
+   rn_si1      =   23.0    !  2 bands: longest depth of extinction
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =  -166.67  !  magnitude of the damping on salinity   [mm/day]
+   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
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+   ln_tide_pot   = .true.   !  use tidal potential forcing
+   nb_harmo      =    11    !  number of constituents used
+   clname(1)     =   'M2'   !  name of constituent
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''
+   cn_dir  =    'bdydta/'
+   ln_full_vel = .false.
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries              
+!-----------------------------------------------------------------------
+   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                        
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
+   ln_traadv_tvd    =  .true.   !  TVD scheme                
+   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
+   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
+   ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUICKEST scheme                 
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .false.   !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                  
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F)
+   nn_npc      =    1            !  frequency of application of npc
+   nn_npcp     =  365            !  npc control print frequency
+   ln_zdfexp   = .false.   !  time-stepping: split-explicit (T) or implicit (F) time stepping
+   nn_zdfexp   =    3            !  number of sub-timestep for ln_zdfexp=T
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+   rn_avmri    = 100.e-4   !  maximum value of the vertical viscosity
+   rn_alp      =   5.      !  coefficient of the parameterization
+   nn_ric      =   2       !  coefficient of the parameterization
+   rn_ekmfc    =   0.7     !  Factor in the Ekman depth Equation
+   rn_mldmin   =   1.0     !  minimum allowable mixed-layer depth estimate (m)
+   rn_mldmax   =1000.0     !  maximum allowable mixed-layer depth estimate (m)
+   rn_wtmix    =  10.0     !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
+   rn_wvmix    =  10.0     !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
+   ln_mldw     = .true.    !  Flag to use or not the mized layer depth param.
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
+   rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
+   rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
+   rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
+   jpni        =   2       !  jpni   number of processors following i (set automatically if < 1)
+   jpnj        =   2       !  jpnj   number of processors following j (set automatically if < 1)
+   jpnij       =   4       !  jpnij  number of local domains (set automatically if < 1)
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+   ln_ctl      = .false.   !  trends control print (expensive!)
+   nn_print    =    0      !  level of print (0 no extra print)
+   nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus
+   nn_ictle    =    0      !  end   i indice of control sum        multi processor runs
+   nn_jctls    =    0      !  start j indice of control               over a subdomain)
+   nn_jctle    =    0      !  end   j indice of control
+   nn_isplt    =    1      !  number of processors in i-direction
+   nn_jsplt    =    1      !  number of processors in j-direction
+   nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
+                           !     (no physical validity of the results)
+   nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   jpnfl         = 1          !  total number of floats during the run
+   jpnnewflo     = 0          !  number of floats for the restart
+   ln_rstflo     = .false.    !  float restart (T) or not (F)
+   nn_writefl    =      75    !  frequency of writing in float output file 
+   nn_stockfl    =    5475    !  frequency of creation of the float restart file 
+   ln_argo       = .false.    !  Argo type floats (stay at the surface each 10 days)
+   ln_flork4     = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
+                              !  or computed with Blanke' scheme (F)
+   ln_ariane     = .true.     !  Input with Ariane tool convention(T)
+   ln_flo_ascii  = .true.     !  Output with Ariane tool netcdf convention(F) or ascii file (T)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+!-----------------------------------------------------------------------
+    nit000_han = 1         ! First time step used for harmonic analysis
+    nitend_han = 75        ! Last time step used for harmonic analysis
+    nstep_han  = 15        ! Time step frequency for harmonic analysis
+    tname(1)   = 'M2'      ! Name of tidal constituents
+    tname(2)   = 'K1'
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 15       !  time step frequency for transports computing
+    nn_dctwri   = 15       !  time step frequency for transports writing
+    nn_secdebug = 112      !      0 : no section to debug
+                           !     -1 : debug all section
+                           !  0 < n : debug section number n
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept   !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or 
+               !   passive tracer coarsened online simulations     
+!-----------------------------------------------------------------------
+   nn_factx  = 3           !  Reduction factor of x-direction
+   nn_facty  = 3           !  Reduction factor of y-direction
+   cn_binref = 'NORTH'     !  Bin centering preference: NORTH or EQUAT
+                           !  NORTH, coarse grid is binned
+                           !         with preferential treatment of
+                           !         the north fold
+                           !  EQUAT, coarse grid is binned
+                           !         with centering at the equator 
+                           !         Symmetry with nn_facty being
+                           !         odd-numbered. Asymmetry with
+                           !         even-numbered nn_facty. 
+   nn_fcrs     = 1           !  frequence of coarsening 
+   nn_msh_crs  = 1           !  frequence of coarsening
+   ln_crs_top  = .true.    ! coarsening of bio
+/
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice	(revision 4056)
@@ -0,0 +1,129 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! 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_out = "restart_ice"      !  suffix of ice restart name (output)
+   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
+   creepl      =   1.0e-08 !  creep limit
+   ecc         =   2.0     !  eccentricity of the elliptical yield curve
+   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   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 !
+!              !              !  (if <0  months)  !   name   !  (logical)   !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_hicif    = 'ice_damping',  -1.              , 'hicif'  ,   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = '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/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice_lim2
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice_lim2	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice_lim2	(revision 4056)
@@ -0,0 +1,129 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! 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_out = "restart_ice"      !  suffix of ice restart name (output)
+   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
+   creepl      =   1.0e-08 !  creep limit
+   ecc         =   2.0     !  eccentricity of the elliptical yield curve
+   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   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 !
+!              !              !  (if <0  months)  !   name   !  (logical)   !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_hicif    = 'ice_damping',  -1.              , 'hicif'  ,   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = '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/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice_lim3
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice_lim3	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_ice_lim3	(revision 4056)
@@ -0,0 +1,193 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/LIM3 :  1 - dynamics/advection/thermo          (namicerun)
+!! namelists    2 - ice intialisation                  (namiceini)
+!!              3 - ice dynamic                        (namicedyn)
+!!              4 - ice advection                      (namicetrp)
+!!              5 - thermodynamic                      (namicethd)
+!!              6 - ice salinity                       (namicesal)
+!!              7 - mechanical redistribution of ice   (namiceitdme)
+!!              8 - ice diagnostics                    (namicedia)
+!!              9 - ice outputs                        (namiceout)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!-----------------------------------------------------------------------
+&namicerun     !   Share parameters for dynamics/advection/thermo
+!-----------------------------------------------------------------------
+   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
+   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
+   ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F)
+   acrit       =  1.0e-02 , 1.0e-02  !  minimum fraction for leads in the Northern (Southern) Hemisphere
+   hsndif      =  0.0      !  computation of temperature in snow (=0.0) or not
+   hicdif      =  0.0      !  computation of temperature in ice  (=0.0) or not (=9999.0)
+   cai         =  1.40e-3  !  atmospheric drag over sea ice
+   cao         =  1.00e-3  !  atmospheric drag over ocean
+   ln_nicep    = .false.   !  Ice points output for debug (yes or no)
+/
+!-----------------------------------------------------------------------
+&namiceini     !   ice initialisation
+!-----------------------------------------------------------------------
+   ttest       =  2.0      !  threshold water temperature for initial sea ice
+   hninn       =  0.3      !  initial snow thickness in the north
+   hnins       =  0.1      !        "            "          south
+   hginn_u     =  3.50     !  initial undeformed ice thickness in the north
+   hgins_u     =  1.0      !        "            "              "     south
+   aginn_u     =  0.95     !  initial undeformed ice concentration in the north
+   agins_u     =  0.9      !        "            "              "         south
+   hginn_d     =  0.0      !  initial  deformed  ice thickness     in the north
+   hgins_d     =  0.0      !  
+   aginn_d     =  0.00     !  initial  deformed  ice concentration in the north
+   agins_d     =  0.00     !        "            "              "         south
+   sinn        =  6.301    !  initial salinity in the north
+   sins        =  6.301    !        "            "    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      = 500       !  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       =   4.0e+04 !  1st bulk-rheology parameter
+   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
+   etamn       =   0.0e+07 !  minimun value for viscosity
+   creepl      =   1.0e-12 !  creep limit
+   ecc         =   2.0     !  eccentricity of the elliptical yield curve
+   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   nevp        = 300       !  number of iterations for subcycling in EVP, SB, 400
+   telast      =9600.0     !  timescale for elastic waves, SB, 720.0
+   alphaevp    =   1.0     !  coefficient for the solution of internal ice stresses
+/
+!-----------------------------------------------------------------------
+&namicetrp     !   ice transport
+!-----------------------------------------------------------------------
+   bound       =   0.      !  boundary conditions (=0.0 no-slip, =1.0 free-slip)
+/
+!-----------------------------------------------------------------------
+&namicethd     !   ice thermodynamic
+!-----------------------------------------------------------------------
+   hmelt       = -0.15     !  maximum melting at the bottom
+   hiccrit     = 0.1 , 0.1 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere
+                           !         caution 1.0, 1.0 best value to be used!!! (gilles G.)  ????
+   fraz_swi    = 0.0       !  use of frazil ice collection thickness in function of wind (1.0) or not (0.0)
+   maxfrazb    = 0.0       !  maximum portion of frazil ice collecting at the ice bottom
+   vfrazb      = 0.4166667 !  thresold drift speed for frazil ice collecting at the ice bottom
+   Cfrazb      = 5.0       !  squeezing coefficient for frazil ice collecting at the ice bottom
+   hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket
+   hiclim      = 0.10      !  minimum ice thickness
+   amax        = 0.999     !  maximum lead fraction
+   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.25      !  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
+   betas       = 0.6       !  exponent in lead-ice fractionation of snow precipitation 0.66
+                           !        betas = 1 -> equipartition, betas < 1 -> more on leads
+   kappa_i     = 1.0       !  extinction radiation parameter in sea ice (1.0)
+   nconv_i_thd = 50        !  maximal number of iterations for heat diffusion computation
+   maxer_i_thd = 0.0001    !  maximal error in temperature for heat diffusion computation
+   thcon_i_swi = 1         !  switch for computation of thermal conductivity in the ice
+                           !        (0) Untersteiner (1964), (1) Pringle et al. (2007)
+/
+!-----------------------------------------------------------------------
+&namicesal     !   ice salinity
+!-----------------------------------------------------------------------
+   num_sal     =  2        !  salinity option: 1 -> S = bulk_sal
+                           !                   2 -> S = S(z,t) with a simple parameterization
+                           !                   3 -> S = S(z) profile of Scwharzacher [1959]
+                           !                   4 -> S = S(h) Cox and Weeks [1974]
+   bulk_sal    =  4.0      !  if 1 is used, it represents the ice salinity
+   sal_G       =  5.00     !  restoring salinity for GD
+   time_G      =  1.728e+6 !  restoring time for GD
+   sal_F       =  2.00     !  restoring salinity for flushing
+   time_F      =  8.640e+5 !  restoring time for flushing
+   s_i_max     = 20.0      !  Maximum salinity 
+   s_i_min     =  0.1      !  Minimum tolerated ice salinity
+   s_i_0       =  3.5      !  1st salinity for salinity profile
+   s_i_1       =  4.5      !  2nd salinity for salinity profile
+/
+!-----------------------------------------------------------------------
+&namiceitdme   !   parameters for mechanical redistribution of ice 
+!-----------------------------------------------------------------------
+   ridge_scheme_swi = 0      !  which ridging scheme using (1=Rothrock,else=Hibler79)
+   Cs               =   0.50 !  shearing energy contribution to ridging
+   Cf               =  17.0  !  ratio of ridging work to PE change in ridging
+   fsnowrdg         =   0.5  !  snow fraction that survives in ridging
+   fsnowrft         =   0.5  !  snow fraction that survives in rafting
+   Gstar            =   0.15 !  fractional area of thin ice being ridged
+   astar            =   0.05 !  equivalent of gstar (0.05 for TH75 and 0.03 for weaker ice)
+   Hstar            = 100.0  !  parameter determining the maximum thickness of ridged ice
+   raftswi          =   1    !  rafting or not
+   hparmeter        =   0.75 !  threshold thickness for rafting or not
+   Craft            =   5.0  !  coefficient used in the rafting function
+   ridge_por        =   0.3  !  initial porosity of the ridged ice (typically 0.30)
+   sal_max_ridge    =  15.0  !  maximum ridged ice salinity
+   partfun_swi      =   1    !  participation function linear, TH75 (0) or exponential Letal07 (1)
+   transfun_swi     =   0    !  transfer function uniform of H80 (0) or exponential Letal07 (1)
+   brinstren_swi    =   0    !  (1) use brine volume to diminish ice strength
+/
+!-----------------------------------------------------------------------
+&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
+!-----------------------------------------------------------------------
+   noumef      =   37      !  number of fields
+   add_diag_swi=    1      !  1 -> diagnose distribution in thickness space
+                           !  0 -> only simple diagnostics
+!
+!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
+!           !                                      !           !           ! or not !  factor  !  factor  !
+   field_1  = 'Ice concentration                  ', 'iiceconc', '%       ',    1   ,  1.0     ,    0.0
+   field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
+   field_3  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
+   field_4  = 'Daily bottom thermo ice production ', 'iicebopr', 'cm/day  ',    1   , 100.     ,    0.0
+   field_5  = 'Daily dynamic ice production       ', 'iicedypr', 'cm/day  ',    1   , 100.     ,    0.0
+   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 = 'Heat flux due to brine release     ', 'iocehebr', 'w/m2    ',    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
+   field_20 = 'Mean ice salinity                  ', 'iicesali', 'psu     ',    1   ,  1.0     ,    0.0
+   field_21 = 'Mean ice age                       ', 'iiceages', 'years   ',    1   ,  0.002739,    0.0
+   field_22 = 'Daily lateral thermo ice prod.     ', 'iicelapr', 'cm/day  ',    1   ,100.      ,    0.0
+   field_23 = 'Daily snowice ice production       ', 'iicesipr', 'cm/day  ',    1   ,100.      ,    0.0
+   field_24 = 'Mean ice temperature               ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
+   field_25 = 'Ice total heat content             ', 'iiceheco', '10^9 J  ',    1   ,  1.0     ,    0.0
+   field_26 = 'Ice surface temperature            ', 'iicesurt', 'C       ',    1   ,  1.0     , -273.15
+   field_27 = 'Snow temperature                   ', 'isnotem2', 'C       ',    1   ,  1.0     , -273.15
+   field_28 = 'Fsbri - brine salt flux            ', 'iicfsbri', 'kg/m2/s ',    1   ,  1.0     ,    0.0
+   field_29 = 'Fseqv - equivalent FW salt flux    ', 'iicfseqv', 'kg/m2/s ',    1   ,  1.0     ,    0.0
+   field_30 = 'Brine volume                       ', 'ibrinvol', '%       ',    1   ,  100.0   ,    0.0
+   field_31 = 'Frazil ice collection thickness    ', 'iicecolf', 'm       ',    1   ,  1.0     ,    0.0
+   field_32 = 'Ice strength                       ', 'iicestre', 'N/m     ',    1   ,  0.001   ,    0.0
+   field_33 = 'Ice velocity                       ', 'iicevelo', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_34 = 'Surface melt                       ', 'iicesume', 'cm/day  ',    1   ,100.      ,    0.0
+   field_35 = 'Bottom melt                        ', 'iicebome', 'cm/day  ',    1   ,100.      ,    0.0
+   field_36 = 'Divergence                         ', 'iicedive', '10-8s-1 ',    1   ,  1.0e8   ,    0.0
+   field_37 = 'Shear                              ', 'iiceshea', '10-8s-1 ',    1   ,  1.0e8   ,    0.0
+/      
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_top
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_top	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/namelist_top	(revision 4056)
@@ -0,0 +1,108 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    )
+!!              2 - tracer data initialisation            (namtrc_dta)
+!!              3 - tracer advection                      (namtrc_adv)
+!!              4 - tracer lateral diffusion              (namtrc_ldf)
+!!              5 - tracer vertical physics               (namtrc_zdf)
+!!              6 - tracer newtonian damping              (namtrc_dmp)
+!!              7 - dynamical tracer trends               (namtrc_trd)
+!!              8 - tracer output diagonstics             (namtrc_dia)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namtrc     !   tracers definition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   nn_dttrc      = 1         !  time step frequency for passive sn_tracers
+   nn_writetrc   =  100     !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   2       !  restart control = 0 initial time step is not compared to the restart file value
+                           !                  = 1 do not use the value in the restart file
+                           !                  = 2 calendar parameters read in the restart file
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   ln_trcdta     =   .true. !  Initialisation from data input file (T) or not (F)
+!
+!              !    name   !           title of the field              !   units    ! initial data ! save   !
+!              !           !                                           !            ! from file    ! or not !
+!              !           !                                           !            ! or not       !        !
+   sn_tracer(1)   = 'Sal     ' , 'Salinity tracer                     ',  ' PSU ' ,  .true.     ,  .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+!
+!                !  file name               ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!                !                          !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing   
+   sn_trcdta(1)  = 'ini_sal'                   , -1           ,'vosaline' ,    .false.    , .false., 'yearly'   , ''       , ' '
+!  sn_trcdta(1)  = 'data_Age'        ,        -12        ,  'CML'     ,    .false.   , .true. , 'yearly'  , ''       , ''
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+   rn_trfac(1)   =   1.0  !  multiplicative factor
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer
+!-----------------------------------------------------------------------
+   ln_trcadv_cen2   =  .false.  !  2nd order centered scheme
+   ln_trcadv_tvd    =  .true.  !  TVD scheme
+   ln_trcadv_muscl  =  .false.   !  MUSCL scheme
+   ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer
+!-----------------------------------------------------------------------
+   ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
+!                               !  Type of the operator :
+   ln_trcldf_lap    =  .true.   !     laplacian operator
+   ln_trcldf_bilap  =  .false.  !     bilaplacian operator
+                                !  Direction of action  :
+   ln_trcldf_level  =  .false.  !     iso-level
+   ln_trcldf_hor    =  .false.!.true.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
+   ln_trcldf_iso    =  .true.!.false.   !     iso-neutral                       (require "key_ldfslp")
+!                               !  Coefficient
+   rn_ahtrc_0       =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .false.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping
+!-----------------------------------------------------------------------
+   ln_trcdmp   =  .false.  !  add a damping termn (T) or not (F)
+   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp_tr  =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf_tr  =   50.     !  surface time scale of damping   [days]
+   rn_bot_tr   =  360.     !  bottom  time scale of damping   [days]
+   rn_dep_tr   =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file_tr  =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
+!                          or mixed-layer trends          ('key_trdmld_trc')
+!----------------------------------------------------------------------
+   nn_trd_trc  =  10      !  time step frequency and tracers trends
+   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
+   ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
+   ln_trdtrc(1)  =   .false.
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .false.   !  save additional diag. (T) or not (F)
+   nn_writedia   =  5475     !  time step frequency for diagnostics
+/
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/xmlio_server.def
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/xmlio_server.def	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/EXP00/xmlio_server.def	(revision 4056)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .FALSE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crs.F90	(revision 4056)
@@ -0,0 +1,390 @@
+MODULE crs   
+   !!======================================================================
+   !!                         ***  MODULE crs_dom  ***
+   !!        Declare the coarse grid domain and other public variables 
+   !!        then allocate them if needed.
+   !!======================================================================
+   !!  History     2012-06  Editing  (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
+   !!----------------------------------------------------------------------   
+   USE par_oce  
+   USE dom_oce
+   USE in_out_manager
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   
+   PUBLIC crs_dom_alloc, crs_dom_alloc2  ! Called from crsini.F90
+   PUBLIC dom_grid_glo   
+   PUBLIC dom_grid_crs 
+
+      ! Domain variables
+      INTEGER, PUBLIC  ::  jpiglo_crs ,   &             !: 1st dimension of global coarse grid domain
+                   jpjglo_crs                   !: 2nd dimension of global coarse grid domain
+      INTEGER, PUBLIC  ::  jpi_crs ,   &                !: 1st dimension of local coarse grid domain
+                   jpj_crs                      !: 2nd dimension of local coarse grid domain
+      INTEGER, PUBLIC  ::  jpi_full ,  &                !: 1st dimension of local parent grid domain
+                   jpj_full                     !: 2nd dimension of local parent grid domain
+
+      INTEGER, PUBLIC  ::  nistr , njstr
+      INTEGER, PUBLIC  ::  niend , njend, start
+      INTEGER, PUBLIC  ::  reste
+
+      INTEGER, PUBLIC  ::  jpi_crsm1, jpj_crsm1         !: loop indices      
+      INTEGER, PUBLIC  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices      
+      INTEGER, PUBLIC  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
+      INTEGER, PUBLIC  ::  npolj_full, npolj_crs        !: north fold mark
+      INTEGER, PUBLIC  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo
+      INTEGER, PUBLIC  ::  npiglo, npjglo               !: jpjglo
+      INTEGER, PUBLIC  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid
+      INTEGER, PUBLIC  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid
+      INTEGER, PUBLIC  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid
+      INTEGER, PUBLIC  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid
+      INTEGER, PUBLIC  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid
+      INTEGER, PUBLIC  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid
+      INTEGER, PUBLIC  ::  nlej_end                     !: ending indices of internal sub-domain on coarse grid
+
+      INTEGER, PUBLIC  ::  narea_full, narea_crs        !: node
+      INTEGER, PUBLIC  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition
+      INTEGER, PUBLIC  ::  jpim1_full, jpjm1_full       !: 
+      INTEGER, PUBLIC  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
+      INTEGER, PUBLIC  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
+      INTEGER, PUBLIC  ::  nreci_full, nrecj_full
+      INTEGER, PUBLIC  ::  nreci_crs, nrecj_crs
+      !cc
+      INTEGER, PUBLIC ::   noea_full, nowe_full        !: index of the local neighboring processors in
+      INTEGER, PUBLIC ::   noso_full, nono_full        !: east, west, south and north directions
+      INTEGER, PUBLIC ::   npne_full, npnw_full        !: index of north east and north west processor
+      INTEGER, PUBLIC ::   npse_full, npsw_full        !: index of south east and south west processor
+      INTEGER, PUBLIC ::   nbne_full, nbnw_full        !: logical of north east & north west processor
+      INTEGER, PUBLIC ::   nbse_full, nbsw_full        !: logical of south east & south west processor
+      INTEGER, PUBLIC ::   nidom_full                  !: ???
+      INTEGER, PUBLIC ::   nproc_full                  !:number for local processor
+      INTEGER, PUBLIC ::   nbondi_full, nbondj_full    !: mark of i- and j-direction local boundaries
+      INTEGER, PUBLIC ::   noea_crs, nowe_crs          !: index of the local neighboring processors in
+      INTEGER, PUBLIC ::   noso_crs, nono_crs          !: east, west, south and north directions
+      INTEGER, PUBLIC ::   npne_crs, npnw_crs          !: index of north east and north west processor
+      INTEGER, PUBLIC ::   npse_crs, npsw_crs          !: index of south east and south west processor
+      INTEGER, PUBLIC ::   nbne_crs, nbnw_crs          !: logical of north east & north west processor
+      INTEGER, PUBLIC ::   nbse_crs, nbsw_crs          !: logical of south east & south west processor
+      INTEGER, PUBLIC ::   nidom_crs                   !: ???
+      INTEGER, PUBLIC ::   nproc_crs                   !:number for local processor
+      INTEGER, PUBLIC ::   nbondi_crs, nbondj_crs      !: mark of i- and j-direction local boundaries
+      
+
+      INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset
+      INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending  j-indices of parent subset
+      INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs
+      INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs
+      INTEGER, PUBLIC  :: mxbinctr, mybinctr            ! central point in grid box
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit_crs, nldit_full     !: first, last indoor index for each i-domain
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit_crs, nleit_full    !: first, last indoor index for each j-domain
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt_crs, nimppt_full    !: first, last indoor index for each j-domain
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcjt_crs, nlcjt_full  !: dimensions of every subdomain
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldjt_crs, nldjt_full     !: first, last indoor index for each i-domain
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlejt_crs, nlejt_full    !: first, last indoor index for each j-domain
+      INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain
+             
+      ! Masks
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
+      
+  !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol      
+
+      ! Scale factors
+      REAL(wp), PUBLIC, DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
+      REAL(wp), PUBLIC, DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
+      REAL(wp), PUBLIC, DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
+      REAL(wp), PUBLIC, DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs
+            REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3f_max_crs, e3w_max_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: fse3t_crs, fse3u_crs, fse3v_crs, fse3f_crs, fse3w_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: fse3t_n_crs, fse3t_b_crs, fse3t_a_crs
+      
+      ! Surface
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk, e1e2w_crs, e2e3u_crs, e1e3v_crs
+                                                                  ! vertical scale factors 
+      ! Coordinates
+      REAL(wp), PUBLIC, DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
+      REAL(wp), PUBLIC, DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
+      REAL(wp), PUBLIC, DIMENSION(:,:),   ALLOCATABLE :: ff_crs
+      INTEGER , PUBLIC,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
+      
+      
+      ! Weights
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
+
+      ! CRS Namelist
+      LOGICAL, PUBLIC   :: ln_crs_top = .FALSE.          !:coarsening online for the bio
+      INTEGER, PUBLIC           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid
+      INTEGER, PUBLIC           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid
+      CHARACTER(len=5), PUBLIC  :: cn_binref  = 'NORTH' !: NORTH = binning starts north fold (equator could be asymmetric)
+                                                !: EQUAT = binning centers at equator (north fold my have artifacts)     
+                                                !:    for even reduction factors, equator placed in bin biased south
+      INTEGER, PUBLIC           :: nn_fcrs    = 3       !: frequence of coarsening
+      INTEGER, PUBLIC           :: nn_msh_crs = 1       !: Organization of mesh mask output
+                                                !: 0 = no mesh mask output
+                                                !: 1 = unified mesh mask output
+                                                !: 2 = 2 separate mesh mask output
+                                                !: 3 = 3 separate mesh mask output
+      CHARACTER(len=11), PUBLIC :: cn_ocerstcrs         !: root name of restart files for coarsened variables
+         
+      INTEGER, PUBLIC           :: nrestx, nresty       !: for determining odd or even reduction factor
+
+      ! Grid reduction factors
+      REAL(wp), PUBLIC     ::  rfactx_r                !: inverse of x-dim reduction factor
+      REAL(wp), PUBLIC     ::  rfacty_r                !: inverse of y-dim reduction factor
+      REAL(wp), PUBLIC     ::  rfactxy 
+
+      !! Horizontal grid parameters for domhgr
+      !! =====================================
+      INTEGER, PUBLIC  ::   nphgr_msh_crs = 0   !: type of horizontal mesh
+      !                                 !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+      !                                 !  = 1 geographical mesh on the sphere with regular grid-spacing
+      !                                 !  = 2 f-plane with regular grid-spacing
+      !                                 !  = 3 beta-plane with regular grid-spacing
+      !                                 !  = 4 Mercator grid with T/U point at the equator
+      
+      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
+      REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs, tsb_crs, tsa_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs, wn2_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:)  , ALLOCATABLE      :: ua_crs, va_crs, wa_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs    
+      REAL(wp), PUBLIC, DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:,:)  , ALLOCATABLE      :: pts_crs, ptt_crs, rn2_crs, rb2_crs, rhd_crs, rhop_crs    
+
+      ! 
+      ! Surface fluxes to pass to TOP
+      ! Variable for the AGE
+      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: gtsu_crs, gtsv_crs   
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: gru_crs, grv_crs   
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, emp_b_crs, emps_crs, fr_i_crs, wndm_crs, emp_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs
+
+
+      ! Vertical diffusion
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp  
+# if defined key_zdfddm
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
+# endif
+
+      ! Mixing and Mixed Layer Depth
+      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::  nmln_crs     
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  hmld_crs, hmlp_crs, hmlpt_crs               
+
+      ! Direction of lateral diffusion
+
+
+CONTAINS
+   
+   INTEGER FUNCTION crs_dom_alloc()
+      !!-------------------------------------------------------------------
+      !!                     *** FUNCTION crs_dom_alloc ***
+      !!  ** Purpose :   Allocate public crs arrays  
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER, DIMENSION(17) :: ierr
+
+      ierr(:) = 0
+
+      ! Set up bins for coarse grid, horizontal only.
+      ALLOCATE( mis2_crs(jpiglo_crs) , mie2_crs(jpiglo_crs) , mjs2_crs(jpjglo_crs) , mje2_crs(jpjglo_crs),&
+      & mig_crs(jpi_crs), mjg_crs(jpj_crs), mi0_crs(jpiglo_crs), mi1_crs(jpiglo_crs), &
+      & mj0_crs(jpjglo_crs), mj1_crs(jpjglo_crs),  STAT=ierr(1) )
+
+      ! Set up Mask and Mesh
+
+      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  &
+         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
+
+      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs), rnfmsk_crs(jpi_crs,jpj_crs), &
+      &     tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) )
+
+      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & 
+         &      gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
+         &      gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
+         &      gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
+         &      ff_crs(jpi_crs,jpj_crs)    , STAT=ierr(4))
+
+      ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , & 
+         &      e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , & 
+         &      e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
+         &      e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
+         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
+
+      ALLOCATE( fse3t_crs(jpi_crs,jpj_crs,jpk)  , fse3w_crs(jpi_crs,jpj_crs,jpk) , & 
+         &      fse3u_crs(jpi_crs,jpj_crs,jpk)  , fse3v_crs(jpi_crs,jpj_crs,jpk) , & 
+         &      e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)   , & 
+         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)   , &
+         &      e3f_crs(jpi_crs,jpj_crs,jpk)    , fse3f_crs(jpi_crs,jpj_crs,jpk) , & 
+         &      fse3t_b_crs(jpi_crs,jpj_crs,jpk), fse3t_n_crs(jpi_crs,jpj_crs,jpk),&
+         &      fse3t_a_crs(jpi_crs,jpj_crs,jpk), e1e2w_msk(jpi_crs,jpj_crs,jpk) , &
+         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk) , &
+         &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk)     , &
+         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , e3t_max_crs(jpi_crs,jpj_crs,jpk),&
+         &      e3w_max_crs(jpi_crs,jpj_crs,jpk), e3u_max_crs(jpi_crs,jpj_crs,jpk),&
+         &      e3v_max_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6))
+
+
+      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk) , facsurfu(jpi_crs,jpj_crs,jpk) , & 
+         &      facvol_t(jpi_crs,jpj_crs,jpk) , facvol_w(jpi_crs,jpj_crs,jpk) , &
+         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk) , ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
+         &      bt_crs(jpi_crs,jpj_crs,jpk)   , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
+
+
+      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk) , crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , & 
+         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk) , crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
+
+
+      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs) , mbkt_crs(jpi_crs,jpj_crs) , &
+         &      mbku_crs(jpi_crs,jpj_crs)   , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
+
+      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk) , gdepu_crs(jpi_crs,jpj_crs,jpk) , &
+         &      gdepv_crs(jpi_crs,jpj_crs,jpk) , gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
+
+
+      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , &
+         &      ua_crs(jpi_crs,jpj_crs,jpk) , va_crs(jpi_crs,jpj_crs,jpk) , &
+         &      wn_crs(jpi_crs,jpj_crs,jpk) , wn2_crs(jpi_crs,jpj_crs,jpk), &
+         &      wa_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),&
+         &      rke_crs(jpi_crs,jpj_crs,jpk), pts_crs(jpi_crs,jpj_crs,jpk), &
+         &      ptt_crs(jpi_crs,jpj_crs,jpk), rn2_crs(jpi_crs,jpj_crs,jpk), & 
+         &      rb2_crs(jpi_crs,jpj_crs,jpk), rhd_crs(jpi_crs,jpj_crs,jpk), &
+         &      rhop_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(11))
+
+      ALLOCATE( sshn_crs(jpi_crs,jpj_crs),  emp_crs(jpi_crs,jpj_crs) , emp_b_crs(jpi_crs,jpj_crs), &
+         &      qsr_crs(jpi_crs,jpj_crs) ,  wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
+         &      vtau_crs(jpi_crs,jpj_crs),  emps_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs, jpj_crs) , &
+         &      fr_i_crs(jpi_crs, jpj_crs),   STAT=ierr(12)  )
+ 
+      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts), tsa_crs(jpi_crs,jpj_crs,jpk,jpts), &
+       &        avt_crs(jpi_crs,jpj_crs,jpk), gtsu_crs(jpi_crs,jpj_crs,jpts), gtsv_crs(jpi_crs,jpj_crs,jpts),  &
+       &        gru_crs(jpi_crs,jpj_crs), grv_crs(jpi_crs,jpj_crs), &
+# if defined key_zdfddm
+         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
+# endif
+         &      STAT=ierr(13) )
+
+      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
+         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
+         
+      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), &
+       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
+                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), &
+       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) )
+
+         
+      crs_dom_alloc = MAXVAL(ierr)
+
+   END FUNCTION crs_dom_alloc
+   
+   INTEGER FUNCTION crs_dom_alloc2()
+      !!-------------------------------------------------------------------
+      !!                     *** FUNCTION crs_dom_alloc ***
+      !!  ** Purpose :   Allocate public crs arrays  
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER, DIMENSION(1) :: ierr
+
+      ierr(:) = 0
+      
+      ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) )
+      crs_dom_alloc2 = MAXVAL(ierr)
+
+      END FUNCTION crs_dom_alloc2
+
+   SUBROUTINE dom_grid_glo
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE dom_grid_glo  ***
+      !!
+      !! ** Purpose : +Return back to parent grid domain 
+      !!---------------------------------------------------------------------
+
+      !                         Return to parent grid domain
+      jpi    = jpi_full
+      jpj    = jpj_full
+      jpim1  = jpim1_full
+      jpjm1  = jpjm1_full
+      nperio = nperio_full
+
+      npolj  = npolj_full
+      jpiglo = jpiglo_full
+      jpjglo = jpjglo_full
+
+      nlci   = nlci_full
+      nlcj   = nlcj_full
+      nldi   = nldi_full
+      nldj   = nldj_full
+      nlei   = nlei_full
+      nlej   = nlej_full
+      nimpp  = nimpp_full
+      njmpp  = njmpp_full
+      
+      nlcit(:)   = nlcit_full(:)
+      nldit(:)   = nldit_full(:)
+      nleit(:)   = nleit_full(:)
+      nimppt(:)  = nimppt_full(:)
+      nlcjt(:)   = nlcjt_full(:)
+      nldjt(:)   = nldjt_full(:)
+      nlejt(:)   = nlejt_full(:)
+      njmppt(:)  = njmppt_full(:)
+
+
+      
+
+   END SUBROUTINE dom_grid_glo
+
+   SUBROUTINE dom_grid_crs
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE dom_grid_crs  ***
+      !!
+      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
+      !!---------------------------------------------------------------------
+
+ 
+      !
+      !                        Switch to coarse grid domain
+      jpi    = jpi_crs
+      jpj    = jpj_crs
+      jpim1  = jpi_crsm1
+      jpjm1  = jpj_crsm1
+      nperio = nperio_crs
+
+      npolj  = npolj_crs
+      jpiglo = jpiglo_crs
+      jpjglo = jpjglo_crs
+
+
+      nlci   = nlci_crs
+      nlcj   = nlcj_crs
+      nldi   = nldi_crs
+      nlei   = nlei_crs
+      nlej   = nlej_crs
+      nldj   = nldj_crs
+      nimpp  = nimpp_crs
+      njmpp  = njmpp_crs
+      
+      nlcit(:)  = nlcit_crs(:)
+      nldit(:)  = nldit_crs(:)
+      nleit(:)  = nleit_crs(:)
+      nimppt(:) = nimppt_crs(:)
+      nlcjt(:)  = nlcjt_crs(:)
+      nldjt(:)  = nldjt_crs(:)
+      nlejt(:)  = nlejt_crs(:)
+      njmppt(:) = njmppt_crs(:)
+
+
+      !
+   END SUBROUTINE dom_grid_crs
+   
+      
+   !!======================================================================
+
+END MODULE crs
+
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdiawri.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdiawri.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdiawri.F90	(revision 4056)
@@ -0,0 +1,266 @@
+MODULE crsdiawri
+   !!======================================================================
+   !!                     ***  MODULE  diawri  ***
+   !! Ocean diagnostics :  write ocean output files
+   !!=====================================================================
+   !!   2012-07  (J. Simeon, C. Calone, G. Madec, C. Ethe)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   crs_dia_wri       : create the standard output files for coarse grid and prep
+   !!                       other variables needed to be passed to TOP
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
+   USE sol_oce         ! solver variables
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcrnf
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE sbcssr          ! restoring term toward SST/SSS climatology
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer
+   USE dianam          ! build name of file (routine)
+   USE zdfddm          ! vertical  physics: double diffusion
+   USE diahth          ! thermocline diagnostics
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE diadimg         ! dimg direct access file format output
+   USE diaar5, ONLY :   lk_diaar5
+   USE iom
+   USE eosbn2
+#if defined key_lim2
+   USE limwri_2 
+#endif
+   USE lib_mpp         ! MPP library
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working array
+   USE crs
+   USE crsdom
+   USE crsiom
+   USE crslbclnk
+   USE eosbn2
+   USE phycst
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   crs_dia_wri                 ! routines called by step.F90
+
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "domzgr_substitute.h90"
+#  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 crs_dia_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_dia_wri  ***
+      !!                   
+      !! ** Purpose :   Basic output of coarsened dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!      1. Accumulate in time the dimensionally-weighted fields
+      !!      2. At time of output, rescale [1] by dimension and time
+      !!         to yield the spatial and temporal average.
+      !!  See. diawri_dimg.h90, sbcmod.F90
+      !!
+      !! ** Method  :  use iom_put via crs_iom_put
+      !!----------------------------------------------------------------------
+      !!
+      
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER               ::   ji, jj, jk              ! dummy loop indices
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztt, zss 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs !
+      REAL(wp)       :: z2dcrsu, z2dcrsv, zgde3w, zt, zs, zh, zalbet, zbeta, zds
+      !!
+       !!----------------------------------------------------------------------
+      ! 
+
+      IF( nn_timing == 1 )   CALL timing_start('crs_dia_wri')
+      
+      !  Initialize arrays
+      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )
+      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )
+      CALL wrk_alloc( jpi, jpj, jpk, ztt, zss       )
+      !
+      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
+
+      ! Depth work arrrays
+      zfse3t(:,:,:) = fse3t(:,:,:)
+      zfse3u(:,:,:) = fse3u(:,:,:)
+      zfse3v(:,:,:) = fse3v(:,:,:)
+      zfse3w(:,:,:) = fse3w(:,:,:)
+
+      IF( kt == nit000  ) THEN
+         tsn_crs(:,:,:,:) = 0._wp    ! temp/sal  array, now 
+         un_crs (:,:,:  ) = 0._wp    ! u-velocity
+         vn_crs (:,:,:  ) = 0._wp    ! v-velocity
+         wn_crs (:,:,:  ) = 0._wp    ! w
+         avt_crs(:,:,:  ) = 0._wp    ! avt
+         sshn_crs(:,:   ) = 0._wp    ! ssh
+      ENDIF
+
+      ! 2. Coarsen fields at each time step
+      ! --------------------------------------------------------
+
+      !  Temperature
+      ztt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( ztt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
+      ztt(:,:,:) = tsa(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( ztt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      tsa_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
+      ztt(:,:,:) = tsb(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( ztt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
+      CALL crs_iom_put( "toce_crs", pv_r3d=tsn_crs(:,:,:,jp_tem) )    ! temp
+      CALL crs_iom_put( "sst_crs" , pv_r2d=tsn_crs(:,:,1,jp_tem) )    ! sst
+
+      !  Salinity
+      zss(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zss, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      tsn_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
+      zss(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zss, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
+      CALL crs_iom_put( "soce_crs" , pv_r3d=tsn_crs(:,:,:,jp_sal) )    ! sal
+      CALL crs_iom_put( "sss_crs"  , pv_r2d=tsn_crs(:,:,1,jp_sal) )    ! sss
+
+      !  U-velocity
+      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_iom_put( "uoce_crs"  , pv_r3d=un_crs  )   ! i-current 
+      !
+      ztt(:,:,:) = 0._wp     ;    zss(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   
+               ztt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
+               zss(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
+            END DO
+         END DO
+      END DO
+      CALL crs_dom_ope( ztt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_iom_put( "uocet_crs" , pv_r3d=zt_crs )   ! uT
+      CALL crs_dom_ope( zss, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_iom_put( "uoces_crs" , pv_r3d=zs_crs )   ! uS
+
+
+      !  V-velocity
+      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_iom_put( "voce_crs"  , pv_r3d=vn_crs  )   ! v-current 
+      !                                                                                 
+      ztt(:,:,:) = 0._wp     ;    zss(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   
+               ztt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
+               zss(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
+            END DO
+         END DO
+      END DO
+      CALL crs_dom_ope( ztt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_iom_put( "vocet_crs" , pv_r3d=zt_crs )   ! vT
+
+      CALL crs_dom_ope( zss, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_iom_put( "voces_crs" , pv_r3d=zs_crs )   ! vS
+      
+      
+      !  Kinetic energy
+      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      CALL crs_iom_put( "eken_crs", pv_r3d=rke_crs )
+            ! coarsenig of avt, avs
+            
+      SELECT CASE ( nn_crs_kz )
+         CASE ( 0 )
+            CALL crs_dom_ope( fsavs(:,:,:), 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
+            CALL crs_iom_put( "avs_crs" , pv_r3d=avs_crs  )   ! i-current 
+         CASE ( 1 )
+            CALL crs_dom_ope( fsavs(:,:,:), 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
+            CALL crs_iom_put( "avs_crs" , pv_r3d=avs_crs  )   ! i-current 
+         
+         CASE ( 2 )
+            CALL crs_dom_ope( fsavs(:,:,:), 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
+            CALL crs_iom_put( "avs_crs" , pv_r3d=avs_crs  )   ! i-current 
+      END SELECT
+    !  CALL crs_iom_put( "avs_crs" , pv_r3d=avs_crs )
+   
+      ! Variables pour le traceur AGE
+      CALL crs_dom_ope( utau, 'SUM', 'U', umask, utau_crs, p_e12=e2u, p_surf_crs=e2u_crs, psgn=1.0 )
+      CALL crs_dom_ope( vtau, 'SUM', 'V', vmask, vtau_crs, p_e12=e1v, p_surf_crs=e1v_crs, psgn=1.0 )
+      CALL crs_dom_ope( wndm, 'SUM', 'T', tmask, wndm_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+      CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs, psgn=1.0  )
+      CALL crs_dom_ope( qsr, 'SUM', 'T', tmask, qsr_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0  )
+      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0  )
+      CALL crs_dom_ope( emps, 'SUM', 'T', tmask, emps_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0  )
+      CALL crs_dom_ope( emp, 'SUM', 'T', tmask, emp_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0  )
+      CALL crs_dom_ope( fr_i, 'SUM', 'T', tmask, fr_i_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0  )
+      
+      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 
+      DO jk = 1, jpkm1
+         DO ji = 2, jpi_crsm1
+            DO jj = 2, jpj_crsm1
+               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
+                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
+                      &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
+                   z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
+                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
+                   !
+                   hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0  )
+      CALL crs_iom_put( "hdiv_crs", pv_r3d=hdivn_crs )  
+      
+      !  W-velocity
+      
+      wn2_crs(:,:,jpk) = 0._wp
+      DO jk = jpkm1, 1, -1
+         wn2_crs(:,:,jk) = wn2_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
+      ENDDO
+
+      
+      !  Sea-surface Height 
+      CALL crs_dom_ope( sshn, 'VOL', 'T', tmask, sshn_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0  )
+      CALL crs_iom_put( "ssh_crs" , pv_r2d=sshn_crs  )   ! ssh output 
+
+      !  W-velocity
+      CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0  )
+     ! CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w )
+      CALL crs_iom_put( "woce_crs" , pv_r3d=wn_crs  )   ! i-current
+      
+      ! Brunt-Vaisala frequency 
+      ztt(:,:,:) = tsn(:,:,:,jp_tem)
+      zss(:,:,:) = tsn(:,:,:,jp_sal)
+      CALL crs_dom_ope( ztt, 'VOL', 'T', tmask, ptt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) ! potential temperature
+      CALL crs_dom_ope( zss, 'VOL', 'T', tmask, pts_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) ! potential salinity  
+
+      !  Clean-up
+      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
+      CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )
+      CALL wrk_dealloc( jpi, jpj, jpk, ztt, zss       )
+      !
+      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('crs_dia_wri')
+      !
+     
+      
+   END SUBROUTINE crs_dia_wri
+
+   !!======================================================================
+END MODULE crsdiawri 
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdom.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdom.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdom.F90	(revision 4056)
@@ -0,0 +1,3538 @@
+MODULE crsdom
+   !!===================================================================
+   !!                  ***  crs.F90 ***
+   !!  Purpose: Interface for calculating quantities from a  
+   !!           higher-resolution grid for the coarse grid.
+   !!
+   !!  Method:  Given the user-defined reduction factor, 
+   !!           the averaging bins are set: 
+   !!           - cn_binref = NORTH, starting from the north 
+   !!           to the south in the model interior domain, 
+   !!           in this way the north fold and redundant halo cells  
+   !!           could be handled in a consistent manner and 
+   !!           the irregularities of bin size can be handled
+   !!           more naturally by the presence of land
+   !!           in the southern boundary.  Thus the southernmost bin 
+   !!           could be of an irregular bin size.
+   !!           Information on the parent grid is retained, specifically,
+   !!           each coarse grid cell's volume and ocean surface 
+   !!           at the faces, relative to the parent grid.
+   !!           - cn_binref = EQUAT (not yet available), starting
+   !!           at a centralized bin at the equator, being only
+   !!           truly centered for odd-numbered j-direction reduction 
+   !!           factors.
+   !!  References:  Aumont, O., J.C. Orr, D. Jamous, P. Monfray
+   !!               O. Marti and G. Madec, 1998. A degradation 
+   !!               approach to accelerate simulations to steady-state 
+   !!               in a 3-D tracer transport model of the global ocean.
+   !!               Climate Dynamics, 14:101-116.
+   !!  History: 
+   !!       Original.   May 2012.  (J. Simeon, C. Calone, G. Madec, C. Ethe)
+   !!===================================================================
+
+   USE dom_oce        ! ocean space and time domain and to get jperio
+   USE wrk_nemo       ! work arrays
+   USE crs            ! domain for coarse grid
+   USE in_out_manager 
+   USE par_kind, ONLY: wp
+   USE crslbclnk
+   USE lib_mpp
+   
+
+   IMPLICIT NONE
+
+   PRIVATE 
+
+   PUBLIC crs_dom_ope
+   PUBLIC crs_dom_e3_max, crs_dom_sfc, crs_dom_msk, crs_dom_hgr, crs_dom_coordinates
+   PUBLIC crs_dom_facvol, crs_dom_def, crs_dom_bat
+
+   INTERFACE crs_dom_ope
+      MODULE PROCEDURE crs_dom_ope_3d, crs_dom_ope_2d
+   END INTERFACE
+
+   !! Substitutions
+#  include "domzgr_substitute.h90"
+   
+CONTAINS
+
+
+   SUBROUTINE crs_dom_msk
+      
+      INTEGER  ::  ji, jj, jk                   ! dummy loop indices
+      INTEGER  ::  ijie,ijis,ijje,ijjs,ii,ij
+      REAL(wp) ::  zmask
+      
+      ! Initialize
+
+      tmask_crs(:,:,:) = 0.0
+      vmask_crs(:,:,:) = 0.0
+      umask_crs(:,:,:) = 0.0
+      fmask_crs(:,:,:) = 0.0
+      
+      DO jk = 1, jpkm1
+         DO ji = 2, nlei_crs  
+            ijie = mie_crs(ji)
+            ijis = mis_crs(ji)
+            
+         IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+            IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+             jj   = mje_crs(2)
+                          
+               zmask = 0.0
+               zmask = SUM( tmask(ijis:ijie,jj,jk) ) 
+               IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( vmask(ijis:ijie,jj     ,jk) )  
+               IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = umask(ijie     ,jj,jk)   
+               IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0
+               
+               fmask_crs(ji,jj,jk) = fmask(ijie,2,jk)
+             ENDIF
+          ELSE
+          
+              jj   = mje_crs(2)
+              ij   = mjs_crs(2)
+          
+               zmask = 0.0
+               zmask = SUM( tmask(ijis:ijie,ij:jj,jk) ) 
+               IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( vmask(ijis:ijie,jj     ,jk) )  
+               IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM(umask(ijie,ij:jj,jk))   
+               IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0
+               
+               fmask_crs(ji,jj,jk) = fmask(ijie,2,jk)
+           
+           ENDIF
+            
+           DO jj = 3, nlej_crs
+            ijje = mje_crs(jj)
+            ijjs = mjs_crs(jj)
+                          
+               zmask = 0.0
+               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
+               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )  
+               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )  
+               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0
+               
+               fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)  
+
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )
+      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )
+      CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )
+      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )
+      !
+   END SUBROUTINE crs_dom_msk
+
+   SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_coordinates ***
+      !! ** Purpose :  Determine the coordinates for the coarse grid
+      !! 
+      !! ** Method  :  From the parent grid subset, search for the central
+      !!               point.  For an odd-numbered reduction factor,
+      !!               the coordinate will be that of the central T-cell.
+      !!               For an even-numbered reduction factor, of a non-square
+      !!               coarse grid box, the coordinate will be that of 
+      !!               the east or north face or more likely.  For a square
+      !!               coarse grid box, the coordinate will be that of
+      !!               the central f-corner.
+      !!
+      !! ** Input   :  p_gphi = parent grid gphi[t|u|v|f]
+      !!               p_glam = parent grid glam[t|u|v|f]
+      !!               cd_type  = grid type (T,U,V,F)
+      !! ** Output  :  p_gphi_crs = coarse grid gphi[t|u|v|f]
+      !!               p_glam_crs = coarse grid glam[t|u|v|f]
+      !!              
+      !! History. 1 Jun.
+      !!----------------------------------------------------------------
+      !! Arguments
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_gphi  ! Parent grid latitude
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_glam  ! Parent grid longitude
+      CHARACTER(len=1),                     INTENT(in)  :: cd_type   ! grid type (T,U,V,F) 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_gphi_crs  ! Coarse grid latitude
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_glam_crs  ! Coarse grid longitude
+
+      !! Local variables
+      INTEGER :: ji, jj, jk                   ! dummy loop indices
+      INTEGER :: ijis, ijjs
+
+  
+      SELECT CASE ( cd_type )
+         CASE ( 'T' )
+            DO jj =  nldj_crs, nlej_crs
+            ijjs = mjs_crs(jj) + mxbinctr 
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji) + mxbinctr 
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'U' )
+            DO jj =  nldj_crs, nlej_crs    
+            ijjs = mjs_crs(jj) + mxbinctr      
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'V' )
+            DO jj =  nldj_crs, nlej_crs   
+            ijjs = mjs_crs(jj) + mxbinctr
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji) + mxbinctr 
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'F' )
+            DO jj =  nldj_crs, nlej_crs
+            ijjs = mjs_crs(jj) + mxbinctr
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+      END SELECT
+
+      ! Retroactively add back the boundary halo cells.
+      CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 )
+      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 )
+         
+      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd
+      SELECT CASE ( cd_type )
+         CASE ( 'T', 'V' )
+            DO ji = 2, nlei_crs
+               ijis = mis_crs(ji) + mxbinctr 
+               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+               p_glam_crs(ji,1) = p_glam(ijis,1)
+            ENDDO
+         CASE ( 'U', 'F' )
+            DO ji = 2, nlei_crs
+               ijis = mis_crs(ji) 
+               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+               p_glam_crs(ji,1) = p_glam(ijis,1)
+            ENDDO
+      END SELECT
+
+      !                                             ! Fill i=1, i=jpi at j=1
+  !    p_gphi_crs(1      ,1) = p_gphi(jpi_crsm1,1)
+ !     p_glam_crs(1      ,1) = p_glam(jpi_crsm1,1)
+      !                                             ! Fill upper-right corner i=1, j=jpj_crs
+  !    p_gphi_crs(jpi_crs,1) = p_gphi(2        ,1)
+ !     p_glam_crs(jpi_crs,1) = p_glam(2        ,1)
+      !                                            
+   END SUBROUTINE crs_dom_coordinates
+
+  SUBROUTINE crs_dom_hgr( p_e1, p_e2, cd_type, p_e1_crs, p_e2_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_hgr ***
+      !!
+      !! ** Purpose :  Get coarse grid horizontal scale factors and unmasked fraction
+      !!
+      !! ** Method  :  For grid types T,U,V,Fthe 2D scale factors of 
+      !!               the coarse grid are the sum of the east or north faces of the 
+      !!               parent grid subset comprising the coarse grid box.     
+      !!               - e1,e2 Scale factors
+      !!                 Valid arguments: 
+      !! ** Inputs  : p_e1, p_e2  = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !! ** Outputs : p_e1_crs, p_e2_crs  = parent grid e1 or e2 (t,u,v,f)
+      !!
+      !! History.     4 Jun.  Write for WGT and scale factors only
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1)
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2)
+      CHARACTER(len=1)                    , INTENT(in)  :: cd_type  ! grid type U,V 
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_e1_crs ! Coarse grid box 2D quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_e2_crs ! Coarse grid box 2D quantity
+
+      !! Local variables
+      INTEGER :: ji, jj, jk     ! dummy loop indices
+      INTEGER :: ijie,ijis,ijje,ijjs,ijrs,ii,ij
+  
+      !!----------------------------------------------------------------
+      WRITE(numout,*) ' dimension'         , jpj_crs  
+      ! Initialize      
+      p_e1_crs(:,:) = 1.0
+      p_e2_crs(:,:) = 1.0
+      DO jk = 1, jpk    
+         DO ji = 2, nlei_crs
+            DO jj = 2, nlej_crs
+            
+               ijie =  mie_crs(ji)
+               ijje =  mje_crs(jj)
+               ijrs =  mje_crs(jj) - mjs_crs(jj)
+ 
+               ! Only for a factro 3 coarsening
+               SELECT CASE ( cd_type )
+                   CASE ( 'T' )
+                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
+                        ! Si à la frontière sud on a pas assez de maille de la grille mère
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
+                      ELSE
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje-1) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje-1) * nn_facty
+                      ENDIF
+                   CASE ( 'U' )
+                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
+                         ! Si à la frontière sud on a pas assez de maille de la grille mère
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
+                      ELSE
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje-1) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje-1) * nn_facty
+                      ENDIF
+                   CASE ( 'V' )
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
+                   CASE ( 'F' )
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
+               END SELECT
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0, pval=1.0 )
+
+   END SUBROUTINE crs_dom_hgr
+
+
+   SUBROUTINE crs_dom_facvol( p_mask, cd_type, p_e1, p_e2, p_e3, p_fld1_crs, p_fld2_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_wgt ***
+      !! ** Purpose :  Three applications.
+      !!               1) SUM. Get coarse grid horizontal scale factors and unmasked fraction
+      !!               2) VOL. Get coarse grid box volumes
+      !!               3) WGT. Weighting multiplier for volume-weighted and/or
+      !!                       area-weighted averages.
+      !!                       Weights (i.e. the denominator) calculated here 
+      !!                       to avoid IF-tests and division.
+      !! ** Method  :  1) SUM.  For grid types T,U,V,F (and W) the 2D scale factors of 
+      !!               the coarse grid are the sum of the east or north faces of the 
+      !!               parent grid subset comprising the coarse grid box.  
+      !!               The fractions of masked:total surface (3D) on the east, 
+      !!               north and top faces is, optionally, also output.
+      !!               - Top face area sum
+      !!                 Valid arguments: cd_type, cd_op='W', p_pmask, p_e1, p_e2 
+      !!               - Top face ocean surface fraction
+      !!                 Valid arguments: cd_type, cd_op='W', p_pmask, p_e1, p_e2       
+      !!               - e1,e2 Scale factors
+      !!                 Valid arguments: 
+      !!               2) VOL.  For grid types W and T, the coarse grid box
+      !!               volumes are output. Also optionally, the fraction of  
+      !!               masked:total volume of the parent grid subset is output (i.e. facvol).
+      !!               3) WGT. Based on the grid type, the denominator is pre-determined here to  
+      !!               perform area- or volume- weighted averages, 
+      !!               to avoid IF-tests and divisions.
+      !! ** Inputs  : p_e1, p_e2  = parent grid e1 or e2 (t,u,v,f)
+      !!              p_pmask     = parent grid mask (T,U,V,F) 
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              cd_op       = applied operation (SUM, VOL, WGT)
+      !!              p_fse3      = (Optional) parent grid vertical level thickness (fse3u or fse3v)
+      !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid
+      !!              p_cfield2d_2 = (Optional) 2D field on coarse grid
+      !!              p_cfield3d_1 = (Optional) 3D field on coarse grid
+      !!              p_cfield3d_2 = (Optional) 3D field on coarse grid
+      !!
+      !! History.     4 Jun.  Write for WGT and scale factors only
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      CHARACTER(len=1),                         INTENT(in)  :: cd_type  ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_mask  ! Parent grid U,V mask
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1)
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity 
+
+      !! Local variables
+      REAL(wp)                                :: zdAm
+      INTEGER                                 :: ji, jj, jk       ! dummy loop indices
+      INTEGER                                 :: ii, ij, ijie,ijje
+
+      REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol      
+      !!----------------------------------------------------------------  
+   
+      CALL wrk_alloc( jpi, jpj, jpk, zvol )
+      p_fld1_crs(:,:,:) = 0.0
+      p_fld2_crs(:,:,:) = 0.0
+      DO jk = 1, jpk
+         zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 
+      ENDDO
+
+      DO jk = 1, jpk           
+         DO ji = nistr, niend, nn_factx
+         
+            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+            IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+               IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                jj   = mje_crs(2)
+             
+                p_fld1_crs(ii,2,jk) =  zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  &
+                 &                + zvol(ji,jj-1,jk) + zvol(ji+1,jj-1,jk) + zvol(ji+2,jj-1,jk)
+                 
+                ENDIF 
+             ELSE
+             
+             jj   = mjs_crs(2)
+             p_fld1_crs(ii,2,jk) = zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  &
+                &                 + zvol(ji,jj+1,jk) + zvol(ji+1,jj+1,jk) + zvol(ji+2,jj+1,jk)  &
+                &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk) 
+                          
+             ENDIF  
+             
+
+            DO jj   = njstr, njend, nn_facty
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+               ij   = ( jj - njstr ) * rfacty_r + start
+               ijje = mje_crs(ij)
+               ijie = mie_crs(ii)
+               !
+               p_fld1_crs(ii,ij,jk) =  zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  &
+                   &                 + zvol(ji,jj+1,jk) + zvol(ji+1,jj+1,jk) + zvol(ji+2,jj+1,jk)  &
+                   &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk)  
+            ENDDO
+         ENDDO
+      ENDDO
+
+      IF( cd_type == 'T' ) THEN
+         DO jk = 1, jpk           
+            DO ji = nistr, niend, nn_factx
+            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+            IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+               IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                jj   = mje_crs(2)
+             
+                zdAm = zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk)  &
+                 &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk)  &
+                 &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)  
+              
+               IF( p_fld1_crs(ii,2,jk) /= 0._wp ) p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)
+               ENDIF
+            ELSE
+            
+            jj   = mjs_crs(2)
+            
+            zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk)  &
+                    &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk)  &
+                    &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)  &
+                    &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk)  &
+                    &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk)  &
+                    &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk)  &
+                    &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk)  &
+                    &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk)  &
+                    &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)
+            
+            IF( p_fld1_crs(ii,2,jk) /= 0._wp ) p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)
+            
+            ENDIF
+
+
+               DO jj   = njstr, njend, nn_facty
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij   = ( jj - njstr ) * rfacty_r + start
+                  ijje = mje_crs(ij)
+                  ijie = mie_crs(ii)
+                  !
+                  zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk)  &
+                    &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk)  &
+                    &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)  &
+                    &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk)  &
+                    &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk)  &
+                    &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk)  &
+                    &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk)  &
+                    &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk)  &
+                    &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)
+                    ! 
+                    !!cc le IF ne doit pas etre utile , a vérifier ! 
+                   IF( p_fld1_crs(ii,ij,jk) /= 0._wp ) p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk) 
+                   ! 
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      IF( cd_type == 'W' ) THEN
+         DO jk = 2, jpk           
+            DO ji = nistr, niend, nn_factx
+            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+            IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+               IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                jj   = mje_crs(2)
+             
+             
+                zdAm = zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1)  &
+                 &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1)  &
+                 &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)  
+              
+               IF( p_fld1_crs(ii,2,jk) /= 0._wp ) p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)
+            
+               ENDIF
+            ELSE 
+            
+            jj   = mjs_crs(2)
+  
+                  zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1)  &
+                    &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1)  &
+                    &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)  &
+                    &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1)  &
+                    &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1)  &
+                    &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1)  &
+                    &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1)  &
+                    &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1)  &
+                    &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1)
+                  !
+                  IF( p_fld1_crs(ii,2,jk) /= 0._wp ) p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)          
+            
+            ENDIF
+
+               DO jj   = njstr, njend, nn_facty
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij   = ( jj - njstr ) * rfacty_r + start
+                  ijje = mje_crs(ij)
+                  ijie = mie_crs(ii)
+                  !
+                  zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1)  &
+                    &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1)  &
+                    &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)  &
+                    &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1)  &
+                    &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1)  &
+                    &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1)  &
+                    &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1)  &
+                    &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1)  &
+                    &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1)
+                  !
+                  IF( p_fld1_crs(ii,ij,jk) /= 0._wp ) p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk) 
+                  !
+               ENDDO
+            ENDDO
+         ENDDO
+         DO ji = nistr, niend, nn_factx
+         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+            IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+               IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                  jj   = mje_crs(2)
+             
+             
+                  zdAm = zvol(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1)  &
+                  &    + zvol(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1)  &
+                  &    + zvol(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)  
+              
+                  IF( p_fld1_crs(ii,2,1) /= 0._wp ) p_fld2_crs(ii,2,1) = zdAm / p_fld1_crs(ii,2,1)
+               ENDIF
+            ELSE
+            jj   = mjs_crs(2)
+            
+               zdAm =  zvol(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1)  &
+                 &   + zvol(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1)  &
+                 &   + zvol(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)  &
+                 &   + zvol(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1)  &
+                 &   + zvol(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1)  &
+                 &   + zvol(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1)  &
+                 &   + zvol(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1)  &
+                 &   + zvol(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1)  &
+                 &   + zvol(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)
+               ! 
+               IF( p_fld1_crs(ii,2,1) /= 0._wp ) p_fld2_crs(ii,2,1) = zdAm / p_fld1_crs(ii,2 ,1) 
+            
+            
+            ENDIF
+
+            DO jj   = njstr, njend, nn_facty
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+               ij   = ( jj - njstr ) * rfacty_r + start
+               ijje = mje_crs(ij)
+               ijie = mie_crs(ii)
+               !
+               zdAm =  zvol(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1)  &
+                 &   + zvol(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1)  &
+                 &   + zvol(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)  &
+                 &   + zvol(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1)  &
+                 &   + zvol(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1)  &
+                 &   + zvol(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1)  &
+                 &   + zvol(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1)  &
+                 &   + zvol(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1)  &
+                 &   + zvol(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)
+               ! 
+               IF( p_fld1_crs(ii,ij,1) /= 0._wp ) p_fld2_crs(ii,ij,1) = zdAm / p_fld1_crs(ii,ij,1) 
+               ! 
+            ENDDO
+         ENDDO
+      ENDIF
+      
+      !                                             !  Retroactively add back the boundary halo cells.
+      CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 ) 
+      CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 ) 
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zvol )
+      !
+   END SUBROUTINE crs_dom_facvol
+
+
+   SUBROUTINE crs_dom_ope_3d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs, psgn )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_UV ***
+      !! ** Purpose :  Average, area-weighted, of U or V on the east and north faces 
+      !!
+      !! ** Method  :  The U and V velocities (3D) are determined as the area-weighted averages
+      !!               on the east and north faces, respectively,
+      !!               of the parent grid subset comprising the coarse grid box. 
+      !!               In the case of the V and F grid, the last jrow minus 1 is spurious.
+      !! ** Inputs  : p_e1_e2     = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              psgn        = sign change over north fold (See lbclnk.F90)
+      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
+      !!                                       for velocities (U or V)
+      !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v)
+      !!              p_pfield    = U or V on the parent grid
+      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
+      !! ** Outputs : p_cfield3d = 3D field on coarse grid
+      !!
+      !! History.  29 May.  completed draft.
+      !!            4 Jun.  Revision for WGT
+      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid
+      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN
+      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask
+      REAL(wp),                                 INTENT(in)           :: psgn    ! Coarse grid T,U,V mask
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
+
+      !! Local variables
+      INTEGER  :: ji, jj, jk                 ! dummy loop indices
+      INTEGER  :: ijie, ijje, ii, ij
+      REAL(wp) :: zflcrs, zsfcrs   
+      REAL(wp) :: zeps = 1.e20    
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf   
+
+      !!----------------------------------------------------------------  
+   
+      p_fld_crs(:,:,:) = 0.0
+      
+      SELECT CASE ( cd_op )
+      
+         CASE ( 'VOL' )
+      
+            CALL wrk_alloc( jpi, jpj, jpk, zsurf )
+            DO jk = 1, jpk
+              zsurf(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk)
+            ENDDO
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                    
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                        zflcrs = p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                         &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                         &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)
+                             
+                        zsfcrs = zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                         &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                         &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) 
+                             
+                        p_fld_crs(ii,2,jk) = zflcrs
+                        IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
+                        
+                        ENDIF
+                     ELSE
+                     
+                     jj   = mjs_crs(2)
+                     
+                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &     + zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &     + zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &     + zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &     + zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &     + zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &     + zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                           
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
+
+                     
+                        
+                     ENDIF
+                        
+
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &     + zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &     + zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &     + zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &     + zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &     + zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &     + zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
+
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                    
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                        zflcrs = p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                         &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                         &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)
+                             
+                        zsfcrs = zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                         &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                         &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) 
+                             
+                        p_fld_crs(ii,2,jk) = zflcrs
+                        IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
+                        
+                        ENDIF
+                     ELSE
+                        jj   = mjs_crs(2)
+                        
+                        zflcrs =     p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                             &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                             &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) &
+                             &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) &
+                             &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) &
+                             &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) &
+                             &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) &
+                             &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) &
+                             &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,jk) &
+                             &     + zsurf(ji+1,jj  ,jk) &
+                             &     + zsurf(ji+2,jj  ,jk) &
+                             &     + zsurf(ji  ,jj+1,jk) &
+                             &     + zsurf(ji+1,jj+1,jk) &
+                             &     + zsurf(ji+2,jj+1,jk) & 
+                             &     + zsurf(ji  ,jj+2,jk) &
+                             &     + zsurf(ji+1,jj+2,jk) &
+                             &     + zsurf(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
+                        
+                        
+                     ENDIF
+
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                             &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                             &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) &
+                             &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) &
+                             &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) &
+                             &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) &
+                             &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) &
+                             &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) &
+                             &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,jk) &
+                             &     + zsurf(ji+1,jj  ,jk) &
+                             &     + zsurf(ji+2,jj  ,jk) &
+                             &     + zsurf(ji  ,jj+1,jk) &
+                             &     + zsurf(ji+1,jj+1,jk) &
+                             &     + zsurf(ji+2,jj+1,jk) & 
+                             &     + zsurf(ji  ,jj+2,jk) &
+                             &     + zsurf(ji+1,jj+2,jk) &
+                             &     + zsurf(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
+
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+                  DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                        zflcrs = p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                         &     + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                         &     + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)
+                             
+                        zsfcrs = zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                         &     + zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                         &     + zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) 
+                             
+                        p_fld_crs(ii,2,1) = zflcrs
+                        IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,1) = zflcrs / zsfcrs
+                        ENDIF
+                    ELSE
+                        jj   = mjs_crs(2)
+                        
+                        zflcrs =     p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                             &     + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                             &     + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) &
+                             &     + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) &
+                             &     + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) &
+                             &     + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) &
+                             &     + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) &
+                             &     + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) &
+                             &     + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,1) &
+                             &     + zsurf(ji+1,jj  ,1) &
+                             &     + zsurf(ji+2,jj  ,1) &
+                             &     + zsurf(ji  ,jj+1,1) &
+                             &     + zsurf(ji+1,jj+1,1) &
+                             &     + zsurf(ji+2,jj+1,1) &
+                             &     + zsurf(ji  ,jj+2,1) &
+                             &     + zsurf(ji+1,jj+2,1) &
+                             &     + zsurf(ji+2,jj+2,1) 
+                         
+                        p_fld_crs(ii,2,1) = zflcrs
+                        IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,1) = zflcrs / zsfcrs
+                        
+                        
+                        
+                     ENDIF
+
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+
+                          zflcrs =   p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                             &     + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                             &     + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) &
+                             &     + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) &
+                             &     + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) &
+                             &     + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) &
+                             &     + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) &
+                             &     + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) &
+                             &     + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,1) &
+                             &     + zsurf(ji+1,jj  ,1) &
+                             &     + zsurf(ji+2,jj  ,1) &
+                             &     + zsurf(ji  ,jj+1,1) &
+                             &     + zsurf(ji+1,jj+1,1) &
+                             &     + zsurf(ji+2,jj+1,1) &
+                             &     + zsurf(ji  ,jj+2,1) &
+                             &     + zsurf(ji+1,jj+2,1) &
+                             &     + zsurf(ji+2,jj+2,1) 
+                         
+                        p_fld_crs(ii,ij,1) = zflcrs
+                        IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,1) = zflcrs / zsfcrs
+
+                     ENDDO      
+                  ENDDO
+
+              END SELECT
+
+              CALL wrk_dealloc( jpi, jpj, jpk, zsurf )
+
+         CASE ( 'SUM' )
+         
+            CALL wrk_alloc( jpi, jpj, jpk, zsurf )
+            IF( PRESENT(p_e3) ) THEN
+               DO jk = 1, jpk
+                 zsurf(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk)
+               ENDDO
+            ELSE
+               DO jk = 1, jpk
+                 zsurf(:,:,jk) =  p_e12(:,:) 
+               ENDDO
+            ENDIF
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                        zflcrs  = p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                         &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                         &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)
+                         
+                         p_fld_crs(ii,2,jk) = zflcrs 
+                        ENDIF 
+                      ELSE
+                         jj   = mjs_crs(2)
+                         
+                         zflcrs  =    p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                         
+                         
+                      ENDIF
+                      
+                        
+
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                     DO ji = nistr, niend, nn_factx
+                        
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                        IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                        zflcrs  = p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                         &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                         &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)
+                         
+                         p_fld_crs(ii,2,jk) = zflcrs 
+                         ENDIF
+                      ELSE
+                      
+                         jj   = mjs_crs(2) 
+                         
+                         zflcrs  =    p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                             &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                             &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) &
+                             &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) &
+                             &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) &
+                             &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) &
+                             &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) &
+                             &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) &
+                             &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                      
+                         
+                      ENDIF
+                      
+                      DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                             &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                             &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) &
+                             &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) &
+                             &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) &
+                             &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) &
+                             &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) &
+                             &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) &
+                             &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+                  DO ji = nistr, niend, nn_factx
+                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                      IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                        zflcrs  = p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                         &      + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                         &      + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)
+                         
+                         p_fld_crs(ii,2,1) = zflcrs 
+                         ENDIF
+                      ELSE
+                      
+                      jj   = mjs_crs(2)
+                      
+                      zflcrs  =   p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                           &      + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                           &      + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) &
+                           &      + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) &
+                           &      + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) &
+                           &      + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) &
+                           &      + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) &
+                           &      + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) &
+                           &      + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
+                        !
+                        p_fld_crs(ii,2,1) = zflcrs
+                         
+                      ENDIF
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        !
+                        zflcrs  =   p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                           &      + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                           &      + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) &
+                           &      + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) &
+                           &      + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) &
+                           &      + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) &
+                           &      + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) &
+                           &      + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) &
+                           &      + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
+                        !
+                        p_fld_crs(ii,ij,1) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+           
+               CASE( 'V' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                        zflcrs  = p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                         &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                         &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)
+                         
+                         p_fld_crs(ii,2,jk) = zflcrs 
+                         ENDIF
+                      ELSE
+                      
+                      ijje   = mje_crs(2)
+                      
+                      zflcrs  =  p_fld(ji  ,ijje,jk) * zsurf(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) &
+                             &      + p_fld(ji+1,ijje,jk) * zsurf(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) &
+                             &      + p_fld(ji+2,ijje,jk) * zsurf(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) 
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                              
+                      ENDIF
+                      
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurf(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) &
+                             &      + p_fld(ji+1,ijje,jk) * zsurf(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) &
+                             &      + p_fld(ji+2,ijje,jk) * zsurf(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                         ENDDO      
+                     ENDDO
+                  ENDDO   
+
+            
+               CASE( 'U' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     ijie = mie_crs(ii)
+                      IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                      
+                        jj   = mje_crs(2)
+                        
+                        
+                        
+                        zflcrs  = p_fld(ijie,jj  ,jk) * zsurf(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk)
+                         
+                        p_fld_crs(ii,2,jk) = zflcrs 
+                        
+                        ENDIF
+                     ELSE
+                     jj   = mjs_crs(2)
+                     
+                     zflcrs =        p_fld(ijie,jj  ,jk) * zsurf(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) &
+                             &     + p_fld(ijie,jj+1,jk) * zsurf(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) &
+                             &     + p_fld(ijie,jj+2,jk) * zsurf(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk)
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                     
+                         
+                      ENDIF
+                      
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs =  p_fld(ijie,jj  ,jk) * zsurf(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) &
+                             &     + p_fld(ijie,jj+1,jk) * zsurf(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) &
+                             &     + p_fld(ijie,jj+2,jk) * zsurf(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk)
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+              END SELECT
+
+              IF( PRESENT( p_surf_crs ) ) THEN
+                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:,:) = p_fld_crs(:,:,:) / p_surf_crs(:,:,:)
+              ENDIF
+
+              CALL wrk_dealloc( jpi, jpj, jpk, zsurf )
+
+         CASE ( 'MAX' )
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                         zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                             &          p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                             &          p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk))
+                             
+                         p_fld_crs(ii,2,jk) = zflcrs
+                         ENDIF
+                      ELSE
+                      jj   = mjs_crs(2)
+                      
+                      zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                             &       p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                             &       p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                             &       p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
+                             &       p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
+                             &       p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                             &       p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                             &       p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                             &       p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)   )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                      
+                         
+                      ENDIF
+
+
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                             &            p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                             &            p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                             &            p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
+                             &            p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
+                             &            p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                             &            p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                             &            p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                             &            p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                         zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                             &          p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                             &          p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1))
+                             
+                         p_fld_crs(ii,2,jk) = zflcrs
+                        ENDIF 
+                     ELSE
+                     jj   = mjs_crs(2)
+                     
+                     zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                             &            p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                             &            p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
+                             &            p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
+                             &            p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
+                             &            p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
+                             &            p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
+                             &            p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
+                             &            p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                       
+                     ENDIF
+                     
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                             &            p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                             &            p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
+                             &            p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
+                             &            p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
+                             &            p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
+                             &            p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
+                             &            p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
+                             &            p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+                  DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                         zflcrs =  MAX( p_fld(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                             &          p_fld(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                             &          p_fld(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1))
+                             
+                         p_fld_crs(ii,2,1) = zflcrs
+                        ENDIF 
+                     ELSE
+                     jj   = mjs_crs(2)
+                        zflcrs = MAX( p_fld(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                           &          p_fld(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                           &          p_fld(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
+                           &          p_fld(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
+                           &          p_fld(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
+                           &          p_fld(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
+                           &          p_fld(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
+                           &          p_fld(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
+                           &          p_fld(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)  ) 
+                         !
+                         p_fld_crs(ii,2,1) = zflcrs
+                         
+                     ENDIF
+                     
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        !
+                        zflcrs = MAX( p_fld(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                           &          p_fld(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                           &          p_fld(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
+                           &          p_fld(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
+                           &          p_fld(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
+                           &          p_fld(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
+                           &          p_fld(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
+                           &          p_fld(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
+                           &          p_fld(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)  ) 
+                         !
+                         p_fld_crs(ii,ij,1) = zflcrs
+                         !
+                     ENDDO      
+                  ENDDO
+           
+               CASE( 'V' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                        jj   = mje_crs(2)
+                        
+                        
+                         zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                             &          p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                             &          p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk))
+                             
+                         p_fld_crs(ii,2,jk) = zflcrs
+                         ENDIF
+                     ELSE
+                      jj   = mjs_crs(2) 
+                      
+                      zflcrs =      MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk),  &
+                             &           p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk),  &
+                             &           p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                     ENDIF
+                     
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs = MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk),  &
+                             &           p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk),  &
+                             &           p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+            
+               CASE( 'U' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     ijie = mie_crs(ii)
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+                        
+                        
+                         zflcrs =  p_fld(ijie  ,jj  ,jk) * p_mask(ijie  ,jj  ,jk)
+                             
+                         p_fld_crs(ii,ij,jk) = zflcrs
+                         ENDIF
+                     ELSE
+                     
+                     jj   = mjs_crs(2)
+                     
+                     zflcrs = MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk),  &
+                             &           p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk),  &
+                             &           p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) )
+                           !
+                      p_fld_crs(ii,2,jk) = zflcrs
+                         
+                     ENDIF
+                     
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs = MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk),  &
+                             &           p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk),  &
+                             &           p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+              END SELECT
+
+         CASE ( 'MIN' )
+            !   Search the min of masked grid cells
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+                        
+                        
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk) ) * zeps ))
+                             
+                             p_fld_crs(ii,2,jk) = zflcrs * p_mask_crs(ii,2,jk)
+                         ENDIF
+                       ELSE
+                       jj   = mjs_crs(2)
+                       
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs * p_mask_crs(ii,2,jk)
+                        
+                       ENDIF
+                        
+
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+           
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                      IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+                        
+                        
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk-1) ) * zeps ))
+                             
+                             p_fld_crs(ii,2,jk) = zflcrs * p_mask_crs(ii,2,jk)
+                         ENDIF
+                       ELSE
+                       jj   = mjs_crs(2)
+                       
+                       zflcrs =      MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs * p_mask_crs(ii,2,jk)
+                        
+                       ENDIF
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO  
+ 
+                  DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                        IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+                        
+                        
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ))
+                             
+                         p_fld_crs(ii,2,1) = zflcrs * p_mask_crs(ii,2,1)
+                         ENDIF
+                       ELSE
+                       jj   = mjs_crs(2)
+                       
+                       zflcrs =  MIN( p_fld(ji  ,jj  ,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj  ,1) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj  ,1) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+1,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+1,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+1,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+2,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+2,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+2,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,2,1) = zflcrs * p_mask_crs(ii,2,1)
+                       
+                        
+                       ENDIF
+                       
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ji  ,jj  ,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj  ,1) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj  ,1) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+1,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+1,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+1,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+2,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+2,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+2,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij,1) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+
+               CASE( 'V' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+                        
+                        
+                           zflcrs =  MIN( p_fld(ji  ,jj,jk) * ( 1. + ( 1. - p_mask(ji  ,jj,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj,jk) * ( 1. + ( 1. - p_mask(ji+1,jj,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj,jk) * ( 1. + ( 1. - p_mask(ji+2,jj,jk) ) * zeps )   )
+                        ENDIF
+                     ELSE
+                     jj   = mjs_crs(2)
+                     
+                     zflcrs =        MIN( p_fld(ji  ,jj,jk) * ( 1. + ( 1. - p_mask(ji  ,jj,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj,jk) * ( 1. + ( 1. - p_mask(ji+1,jj,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj,jk) * ( 1. + ( 1. - p_mask(ji+2,jj,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs * p_mask_crs(ii,2,jk)
+                             
+                     ENDIF
+                        
+                        
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ji  ,jj,jk) * ( 1. + ( 1. - p_mask(ji  ,jj,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj,jk) * ( 1. + ( 1. - p_mask(ji+1,jj,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj,jk) * ( 1. + ( 1. - p_mask(ji+2,jj,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO  
+
+
+               CASE( 'U' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                     ijie = mie_crs(ii)
+                     IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                        IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+            
+                        zflcrs =  p_fld(ji  ,ijje,jk) * ( 1. + ( 1. - p_mask(ji  ,ijje,jk) ) * zeps )
+                        ENDIF
+                     ELSE
+                     jj   = mjs_crs(2)
+                     
+                     zflcrs =  MIN( p_fld(ijie,jj  ,jk) * ( 1. + ( 1. - p_mask(ijie,jj  ,jk) ) * zeps ),  &
+                       &            p_fld(ijie,jj+1,jk) * ( 1. + ( 1. - p_mask(ijie,jj+1,jk) ) * zeps ),  &
+                       &            p_fld(ijie,jj+2,jk) * ( 1. + ( 1. - p_mask(ijie,jj+2,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs * p_mask_crs(ii,2,jk)
+                           
+                     ENDIF
+                     
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ijie,jj  ,jk) * ( 1. + ( 1. - p_mask(ijie,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ijie,jj+1,jk) * ( 1. + ( 1. - p_mask(ijie,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ijie,jj+2,jk) * ( 1. + ( 1. - p_mask(ijie,jj+2,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO  
+            END SELECT
+            !
+         END SELECT
+         !
+         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn )
+         !
+    END SUBROUTINE crs_dom_ope_3d
+
+    SUBROUTINE crs_dom_ope_2d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs, psgn )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_UV ***
+      !! ** Purpose :  Average, area-weighted, of U or V on the east and north faces 
+      !!
+      !! ** Method  :  The U and V velocities (3D) are determined as the area-weighted averages
+      !!               on the east and north faces, respectively,
+      !!               of the parent grid subset comprising the coarse grid box. 
+      !!               In the case of the V and F grid, the last jrow minus 1 is spurious.
+      !! ** Inputs  : p_e1_e2     = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              psgn        = sign change over north fold (See lbclnk.F90)
+      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
+      !!                                       for velocities (U or V)
+      !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v)
+      !!              p_pfield    = U or V on the parent grid
+      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
+      !! ** Outputs : p_cfield3d = 3D field on coarse grid
+      !!
+      !! History.  29 May.  completed draft.
+      !!            4 Jun.  Revision for WGT
+      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in)           :: p_fld   ! T, U, V or W on parent grid
+      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN
+      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask
+      REAL(wp),                                 INTENT(in)           :: psgn    ! Coarse grid T,U,V mask
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
+
+      !! Local variables
+      INTEGER  :: ji, jj, jk                 ! dummy loop indices
+      INTEGER  :: ijie, ijje, ii, ij
+      REAL(wp) :: zflcrs, zsfcrs   
+      REAL(wp) :: zeps = 1.e20    
+      REAL(wp), DIMENSION(:,:), POINTER :: zsurf   
+
+      !!----------------------------------------------------------------  
+      
+      p_fld_crs(:,:) = 0.0
+
+      SELECT CASE ( cd_op )
+      
+         CASE ( 'VOL' )
+      
+           CALL wrk_alloc( jpi, jpj, zsurf )
+           zsurf(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)
+                    
+           DO ji = nistr, niend, nn_factx
+           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+              IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                   jj   = mje_crs(2)
+                   
+                   
+                 zflcrs =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                   &     + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                   &     + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )
+                   
+                 zsfcrs =  zsurf(ji,jj  ) + zsurf(ji+1,jj  ) + zsurf(ji+2,jj  )  &
+                   &     + zsurf(ji,jj-1) + zsurf(ji+1,jj-1) + zsurf(ji+2,jj-1)
+                   
+                   p_fld_crs(ii,2) = zflcrs
+                   
+                 IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs
+                 ENDIF
+              ELSE
+              jj   = mjs_crs(2)
+              
+              zflcrs =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                &     + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                &     + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  &
+                &     + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  &
+                &     + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  &
+                &     + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  &
+                &     + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  &
+                &     + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  &
+                &     + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)  
+
+                 zsfcrs =  zsurf(ji,jj  ) + zsurf(ji+1,jj  ) + zsurf(ji+2,jj  )  &
+                   &     + zsurf(ji,jj+1) + zsurf(ji+1,jj+1) + zsurf(ji+2,jj+1)  &
+                   &     + zsurf(ji,jj+2) + zsurf(ji+1,jj+2) + zsurf(ji+2,jj+2)  
+                 !
+                 p_fld_crs(ii,2) = zflcrs
+                 IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs
+                 
+              ENDIF
+                   
+ 
+              DO jj = njstr, njend, nn_facty
+                 ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                 ij   = ( jj - njstr ) * rfacty_r + start
+                 ijje = mje_crs(ij)
+                 ijie = mie_crs(ii)                  
+ 
+                 zflcrs =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                   &     + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                   &     + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  &
+                   &     + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  &
+                   &     + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  &
+                   &     + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  &
+                   &     + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  &
+                   &     + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  &
+                   &     + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)  
+
+                 zsfcrs =  zsurf(ji,jj  ) + zsurf(ji+1,jj  ) + zsurf(ji+2,jj  )  &
+                   &     + zsurf(ji,jj+1) + zsurf(ji+1,jj+1) + zsurf(ji+2,jj+1)  &
+                   &     + zsurf(ji,jj+2) + zsurf(ji+1,jj+2) + zsurf(ji+2,jj+2)  
+                 !
+                 p_fld_crs(ii,ij) = zflcrs
+                 IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij) = zflcrs / zsfcrs
+
+              ENDDO      
+           ENDDO
+            
+           CALL wrk_dealloc( jpi, jpj, zsurf )
+
+         CASE ( 'SUM' )
+         
+            CALL wrk_alloc( jpi, jpj, zsurf )
+            IF( PRESENT( p_e3 ) ) THEN
+               zsurf(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)
+            ELSE
+               zsurf(:,:) =  p_e12(:,:) * p_mask(:,:,1)
+            ENDIF
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                   IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                      IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                         jj   = mje_crs(2)
+                   
+                   
+                         zflcrs  = p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                          &      + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                          &      + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )
+                    
+                         p_fld_crs(ii,2) = zflcrs
+                      ENDIF
+                 ELSE
+                 jj   = mjs_crs(2)
+                 
+                 zflcrs  =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                   &      + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                   &      + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  &
+                   &      + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  &
+                   &      + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  &
+                   &      + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  &
+                   &      + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  &
+                   &      + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  &
+                   &      + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)  
+                        !
+                  p_fld_crs(ii,2) = zflcrs
+                    
+                 ENDIF
+                          
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+
+                        zflcrs  =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                          &      + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                          &      + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  &
+                          &      + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  &
+                          &      + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  &
+                          &      + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  &
+                          &      + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  &
+                          &      + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  &
+                          &      + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)  
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'V' )
+         
+                 DO ji = nistr, niend, nn_factx
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                         jj   = mje_crs(2)
+                           
+                         zflcrs  = p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                          &      + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                          &      + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )
+                    
+                    p_fld_crs(ii,2) = zflcrs
+                    ENDIF              
+                 ELSE
+                   ijje   = mje_crs(2) 
+                    
+                   zflcrs  = p_fld(ji  ,ijje) * zsurf(ji  ,ijje)  &
+                     &     + p_fld(ji+1,ijje) * zsurf(ji+1,ijje)  &
+                     &     + p_fld(ji+2,ijje) * zsurf(ji+2,ijje)  
+                           !
+                    p_fld_crs(ii,2) = zflcrs
+                    
+                 ENDIF
+                 
+                    DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)
+                          !                  
+                        zflcrs  = p_fld(ji  ,ijje) * zsurf(ji  ,ijje)  &
+                         &      + p_fld(ji+1,ijje) * zsurf(ji+1,ijje)  &
+                         &      + p_fld(ji+2,ijje) * zsurf(ji+2,ijje)  
+                           !
+                           p_fld_crs(ii,ij) = zflcrs
+                           !
+                         ENDDO      
+                     ENDDO 
+
+            
+               CASE( 'U' )
+         
+               DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  ijie = mie_crs(ii)  
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+ 
+                        zflcrs  = p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  
+                    
+                        p_fld_crs(ii,2) = zflcrs
+                     ENDIF
+                 ELSE
+                   jj   = mjs_crs(2)
+                   
+                   zflcrs =  p_fld(ijie,jj  ) * zsurf(ijie,jj  )  &
+                     &     + p_fld(ijie,jj+1) * zsurf(ijie,jj+1)  &
+                     &     + p_fld(ijie,jj+2) * zsurf(ijie,jj+2) 
+                           !
+                           p_fld_crs(ii,2) = zflcrs
+                    
+                 ENDIF                  
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + start
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs =  p_fld(ijie,jj  ) * zsurf(ijie,jj  )  &
+                             &     + p_fld(ijie,jj+1) * zsurf(ijie,jj+1)  &
+                             &     + p_fld(ijie,jj+2) * zsurf(ijie,jj+2) 
+                           !
+                           p_fld_crs(ii,ij) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+
+              END SELECT
+
+              IF( PRESENT( p_surf_crs ) ) THEN
+                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:) = p_fld_crs(:,:) / p_surf_crs(:,:)
+              ENDIF
+
+              CALL wrk_dealloc( jpi, jpj, zsurf )
+
+         CASE ( 'MAX' )
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+ 
+                        zflcrs =  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1),  &
+                          &            p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1),  &
+                          &            p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1))
+                          
+                        p_fld_crs(ii,2) = zflcrs
+                      ENDIF
+                  ELSE
+                     jj   = mjs_crs(2)
+                  
+                     zflcrs =  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1),  &
+                       &            p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1),  &
+                       &            p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1),  &
+                       &            p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1),  &
+                       &            p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1),  &
+                       &            p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1),  &
+                       &            p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1),  &
+                       &            p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1),  &
+                       &            p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1)   )
+                        !
+                     p_fld_crs(ii,2) = zflcrs
+                  ENDIF
+
+                  
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+
+                        zflcrs =  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1),  &
+                          &            p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1),  &
+                          &            p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1),  &
+                          &            p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1),  &
+                          &            p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1),  &
+                          &            p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1),  &
+                          &            p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1),  &
+                          &            p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1),  &
+                          &            p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1)   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'V' )
+         
+                  DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+
+                        zflcrs =  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1),  &
+                          &            p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1),  &
+                          &            p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1))
+                          
+                        p_fld_crs(ii,2) = zflcrs
+                     ENDIF
+                  ELSE
+                  ijje   = mje_crs(2)
+                  
+                  zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1),  &
+                    &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1),  &
+                    &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) )
+                  ENDIF
+                                    
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)
+                        !                  
+                        zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1),  &
+                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1),  &
+                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'U' )
+         
+                  DO ji = nistr, niend, nn_factx
+                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                   ijie = mie_crs(ii)
+                   IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                      IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                         jj   = mje_crs(2)
+
+                         zflcrs =   p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1)
+                          
+                         p_fld_crs(ii,2) = zflcrs
+                      ENDIF
+                   ELSE
+                   
+                   jj   = mjs_crs(2)
+                   
+                   zflcrs = MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1),  &
+                     &           p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1),  &
+                     &           p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) )
+                        !
+                        p_fld_crs(ii,2) = zflcrs
+                  ENDIF
+                  
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)
+                        !                  
+                        zflcrs = MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1),  &
+                          &           p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1),  &
+                          &           p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+
+              END SELECT
+
+         CASE ( 'MIN' )
+            !   Search the min of masked grid cells
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  DO ji = nistr, niend, nn_factx
+                  
+                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                   IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+          
+                      IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                         jj   = mje_crs(2)
+         
+                         zflcrs =  MIN( p_fld(ji  ,jj  ) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                           &            p_fld(ji+1,jj  ) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                           &            p_fld(ji+2,jj  ) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ))
+                     
+                         p_fld_crs(ii,2) = zflcrs * p_mask_crs(ii,2,1)
+                      ENDIF
+                  ELSE
+                     jj   = mjs_crs(2) 
+                   
+                     zflcrs =  MIN( p_fld(ji  ,jj  ) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                       &            p_fld(ji+1,jj  ) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                       &            p_fld(ji+2,jj  ) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  &
+                       &            p_fld(ji  ,jj+1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                       &            p_fld(ji+1,jj+1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                       &            p_fld(ji+2,jj+1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  &
+                       &            p_fld(ji  ,jj+2) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                       &            p_fld(ji+1,jj+2) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                       &            p_fld(ji+2,jj+2) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   )
+                        !
+                     p_fld_crs(ii,2) = zflcrs * p_mask_crs(ii,2,1) 
+                  ENDIF
+                  
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ji  ,jj  ) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj  ) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj  ) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+2) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+2) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+2) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+ 
+               CASE( 'V' )
+         
+                  DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+
+                        zflcrs =  MIN( p_fld(ji  ,jj  ) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj  ) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj  ) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ))
+                     
+                        p_fld_crs(ii,2) = zflcrs * p_mask_crs(ii,2,1)
+                     ENDIF
+                  ELSE
+                     ijje   = mje_crs(2)
+                   
+                     zflcrs =  MIN( p_fld(ji  ,ijje) * ( 1. + ( 1. - p_mask(ji  ,ijje,1) ) * zeps ),  &
+                       &            p_fld(ji+1,ijje) * ( 1. + ( 1. - p_mask(ji+1,ijje,1) ) * zeps ),  &
+                       &            p_fld(ji+2,ijje) * ( 1. + ( 1. - p_mask(ji+2,ijje,1) ) * zeps )   )
+                        !
+                     p_fld_crs(ii,2) = zflcrs * p_mask_crs(ii,2,1) 
+                  ENDIF
+                  
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ji  ,ijje) * ( 1. + ( 1. - p_mask(ji  ,ijje,1) ) * zeps ),  &
+                          &            p_fld(ji+1,ijje) * ( 1. + ( 1. - p_mask(ji+1,ijje,1) ) * zeps ),  &
+                          &            p_fld(ji+2,ijje) * ( 1. + ( 1. - p_mask(ji+2,ijje,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+
+               CASE( 'U' )
+         
+                  DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  ijie = mie_crs(ii)
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        
+                        jj   = mje_crs(2)
+
+                        zflcrs =   p_fld(ji  ,jj  ) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps )
+                     
+                        p_fld_crs(ii,2) = zflcrs * p_mask_crs(ii,2,1)
+                     ENDIF
+                  ELSE
+                     jj   = mjs_crs(2)
+                     
+                     zflcrs =  MIN( p_fld(ijie,jj  ) * ( 1. + ( 1. - p_mask(ijie,jj  ,1) ) * zeps ),  &
+                       &            p_fld(ijie,jj+1) * ( 1. + ( 1. - p_mask(ijie,jj+1,1) ) * zeps ),  &
+                       &            p_fld(ijie,jj+2) * ( 1. + ( 1. - p_mask(ijie,jj+2,1) ) * zeps )   )
+                        !
+                     p_fld_crs(ii,2) = zflcrs * p_mask_crs(ii,2,1)
+                  ENDIF
+                  
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + start
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ijie,jj  ) * ( 1. + ( 1. - p_mask(ijie,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ijie,jj+1) * ( 1. + ( 1. - p_mask(ijie,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ijie,jj+2) * ( 1. + ( 1. - p_mask(ijie,jj+2,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+            END SELECT
+            !
+         END SELECT
+         !
+         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn )
+         !
+   END SUBROUTINE crs_dom_ope_2d
+
+
+   SUBROUTINE crs_dom_e3_max( p_e1, p_e2, p_e3, p_sfc_crs, cd_type, p_mask, p_e3_crs, p_e3_men_crs)
+   
+   
+      !!  Arguments
+      CHARACTER(len=1),                         INTENT(in) :: cd_type      ! grid type T, W ( U, V, F)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_mask       ! Parent grid T mask
+      REAL(wp), DIMENSION(jpi,jpj)    ,         INTENT(in) :: p_e1, p_e2   ! 2D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_e3         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: p_sfc_crs ! Coarse grid box east or north face quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout):: p_e3_crs, p_e3_men_crs ! Coarse grid box east or north face quantity 
+
+      !! Local variables
+      INTEGER ::  ji, jj, jk                   ! dummy loop indices
+      INTEGER ::  ijie, ijje, ii, ij
+      REAL(wp) :: ze3crs  
+      !!----------------------------------------------------------------  
+      ! Initialize
+      p_e3_crs(:,:,:)     = 1.0
+      p_e3_men_crs(:,:,:) = 0.0
+ 
+      SELECT CASE ( cd_type )
+      
+         CASE ('T')
+         
+            DO jk = 1 , jpk
+               DO ji = nistr, niend, nn_factx
+               
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                    jj = mje_crs(2)
+                    
+                    
+                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk))
+                                          
+                    p_e3_crs(ii,2,jk) = ze3crs
+                     
+                    ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
+                        &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
+                        &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
+
+                        
+                     p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
+                     ENDIF
+                  ELSE
+                     jj = mjs_crs(2)
+                     
+                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
+                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
+                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
+                    
+                     p_e3_crs(ii,2,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
+                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
+                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
+                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  &
+                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  &
+                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
+                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
+                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                        
+                       p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)       
+                  ENDIF
+
+                  DO jj = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                     ij   = ( jj - njstr ) * rfacty_r + start
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     !  
+                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
+                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
+                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
+                    
+                     p_e3_crs(ii,ij,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
+                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
+                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
+                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  &
+                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  &
+                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
+                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
+                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                        
+                       p_e3_men_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+                   WRITE(numout,*) ' ij ' ,  ij
+                  ENDDO
+               ENDDO
+            ENDDO
+            
+         CASE ('U')
+         
+         DO jk = 1 , jpk
+               DO ji = nistr, niend, nn_factx
+               
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                    jj = mje_crs(2)
+                    
+                    
+                    ze3crs = p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)
+                                          
+                    p_e3_crs(ii,2,jk) = ze3crs
+                     
+                    ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
+
+                        
+                     p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
+                     ENDIF
+                  ELSE
+                     jj = mjs_crs(2)
+                     
+                     ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                                   p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                                   p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
+                    
+                     p_e3_crs(ii,2,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
+                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                        
+                       p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)       
+                  ENDIF
+
+                  DO jj = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                     ij   = ( jj - njstr ) * rfacty_r + start
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     !  
+                     ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
+                    
+                     p_e3_crs(ii,ij,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
+                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                        
+                       p_e3_men_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+                   WRITE(numout,*) ' ij ' ,  ij
+                  ENDDO
+               ENDDO
+            ENDDO
+
+         CASE ('V')
+         DO jk = 1 , jpk
+               DO ji = nistr, niend, nn_factx
+               
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                    jj = mje_crs(2)
+                    
+                    
+                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk))
+                                          
+                    p_e3_crs(ii,2,jk) = ze3crs
+                     
+                    ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
+                        &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
+                        &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
+
+                        
+                     p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
+                     ENDIF
+                  ELSE
+                     jj = mjs_crs(2)
+                     
+                     ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
+                    
+                     p_e3_crs(ii,2,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
+                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                        
+                       p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)       
+                  ENDIF
+
+                  DO jj = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                     ij   = ( jj - njstr ) * rfacty_r + start
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     !  
+                     ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
+                    
+                     p_e3_crs(ii,ij,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
+                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                        
+                       p_e3_men_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+                   WRITE(numout,*) ' ij ' ,  ij
+                  ENDDO
+               ENDDO
+            ENDDO
+
+         CASE ('W')
+
+            DO jk = 2 , jpk
+               DO ji = nistr, niend, nn_factx
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+               IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                    jj = mje_crs(2)
+                    
+                    
+                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1))
+                                          
+                     p_e3_crs(ii,2,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  &
+                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  &
+                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) 
+
+                        
+                       p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
+                  ENDIF
+               ELSE
+                  jj = mjs_crs(2)  
+                  
+                  ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                     &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                     &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
+                     &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
+                     &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
+                     &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
+                     &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
+                     &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
+                     &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
+                    
+                  p_e3_crs(ii,2,jk) = ze3crs
+                     
+                  ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  &
+                     &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  &
+                     &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  &
+                     &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  &
+                     &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  &
+                     &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  &
+                     &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  &
+                     &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  &
+                     &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1)
+                        
+                  p_e3_men_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)      
+               ENDIF
+               
+                  
+                  DO jj = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                     ij   = ( jj - njstr ) * rfacty_r + start
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     !  
+                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
+                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
+                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
+                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
+                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
+                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
+                    
+                     p_e3_crs(ii,ij,jk) = ze3crs
+                     
+                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  &
+                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  &
+                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  &
+                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  &
+                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  &
+                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  &
+                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  &
+                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1)
+                        
+                       p_e3_men_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+
+                  ENDDO
+               ENDDO
+            ENDDO
+             
+            DO ji = nistr, niend, nn_factx
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+               IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+                 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               
+                    jj = mje_crs(2)
+  
+                    ze3crs = MAX(  p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                        &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                        &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1))
+                                          
+                    p_e3_crs(ii,2,1) = ze3crs
+                     
+                    ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  &
+                        &      p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  &
+                        &      p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) 
+    
+                    p_e3_men_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1)
+                  ENDIF
+               ELSE     
+                  jj = mjs_crs(2)
+                  
+                  ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                     &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                     &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
+                     &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
+                     &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
+                     &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
+                     &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
+                     &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
+                     &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) )
+                 
+                  p_e3_crs(ii,2,1) = ze3crs
+                  
+                  ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  &
+                        &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  &
+                        &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  &
+                        &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  &
+                        &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  &
+                        &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  &
+                        &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  &
+                        &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  &
+                        &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1)
+                        
+                   p_e3_men_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1) 
+                    
+               ENDIF
+               DO jj = njstr, njend, nn_facty
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij   = ( jj - njstr ) * rfacty_r + start
+                  ijje = mje_crs(ij)
+                  ijie = mie_crs(ii)
+                  !  
+                  ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                     &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                     &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
+                     &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
+                     &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
+                     &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
+                     &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
+                     &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
+                     &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) )
+                 
+                  p_e3_crs(ii,ij,1) = ze3crs
+                  
+                   ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  &
+                        &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  &
+                        &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  &
+                        &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  &
+                        &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  &
+                        &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  &
+                        &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  &
+                        &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  &
+                        &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1)
+                        
+                       p_e3_men_crs(ii,ij,1) = ze3crs / p_sfc_crs(ii,ij,1)
+
+               ENDDO
+            ENDDO
+            
+         END SELECT 
+         !              
+         
+         CALL crs_lbc_lnk( p_e3_crs, cd_type, 1.0, pval=1.0 )
+         CALL crs_lbc_lnk( p_e3_men_crs, cd_type, 1.0, pval=1.0 )  
+         
+         !              
+   END SUBROUTINE crs_dom_e3_max
+
+   SUBROUTINE crs_dom_sfc( p_mask, cd_type, p_surf_crs, p_surf_crs_msk,  p_e1, p_e2, p_e3 )
+
+      !!  Arguments
+      CHARACTER(len=1),                 INTENT(in) :: cd_type      ! grid type T, W ( U, V, F)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask       ! Parent grid T mask
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in), OPTIONAL :: p_e1, p_e2         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out):: p_surf_crs ! Coarse grid box east or north face quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out):: p_surf_crs_msk ! Coarse grid box east or north face quantity 
+
+      !! Local variables
+      INTEGER  :: ji, jj, jk                   ! dummy loop indices
+      INTEGER  :: ijie, ijje, ii, ij
+      REAL(wp) :: zsurf     
+      REAL(wp) :: zsfcrs_msk
+      !!----------------------------------------------------------------  
+      ! Initialize
+
+
+      !
+      SELECT CASE ( cd_type )
+      
+         CASE ('W')
+      
+            IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+              IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               DO jk = 1, jpk
+                 DO ji = nistr, niend, nn_factx
+                    jj = mje_crs(2)
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                    
+                    zsurf  =      p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) +  &
+                        &         p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) +  &
+                        &         p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) +  &
+                        &         p_e1(ji  ,jj-1) * p_e2(ji  ,jj-1) +  &
+                        &         p_e1(ji+1,jj-1) * p_e2(ji+1,jj-1) +  &
+                        &         p_e1(ji+2,jj-1) * p_e2(ji+2,jj-1) 
+                        
+                    !
+                    zsfcrs_msk  = p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
+                        &         p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
+                        &         p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
+
+                    !
+                    p_surf_crs    (ii,2,jk) = zsurf
+                    p_surf_crs_msk(ii,2,jk) = zsfcrs_msk
+                  ENDDO      
+                ENDDO
+              ENDIF
+           ELSE
+              DO jk = 1, jpk
+                 DO ji = nistr, niend, nn_factx
+                    jj = mjs_crs(2)
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+                    
+                    zsurf =       p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) +  &
+                        &         p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) +  &
+                        &         p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) +  &
+                        &         p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) +  &
+                        &         p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) +  &
+                        &         p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) +  &
+                        &         p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) +  &
+                        &         p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) +  &
+                        &         p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) 
+                        
+                     zsfcrs_msk =  p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk)  &
+                       &         + p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk)  &
+                       &         + p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk)  &
+                       &         + p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk)  &
+                       &         + p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk)  &
+                       &         + p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk)  &
+                       &         + p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk)  &
+                       &         + p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk)  &
+                       &         + p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                       !
+                       p_surf_crs(ii,2,jk) = zsurf
+                       p_surf_crs_msk(ii,2,jk) = zsfcrs_msk
+                       !
+                   ENDDO
+                ENDDO
+           ENDIF  
+
+
+            DO jk = 1, jpk
+               !
+               !
+               DO ji = nistr, niend, nn_factx
+                  DO jj   = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! coordinate in parent grid
+                     ij   = ( jj - njstr ) * rfacty_r + start
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     !
+                     zsurf =      p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) +  &
+                        &         p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) +  &
+                        &         p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) +  &
+                        &         p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) +  &
+                        &         p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) +  &
+                        &         p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) +  &
+                        &         p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) +  &
+                        &         p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) +  &
+                        &         p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) 
+                        
+                     zsfcrs_msk =  p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk)  &
+                       &         + p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk)  &
+                       &         + p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk)  &
+                       &         + p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk)  &
+                       &         + p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk)  &
+                       &         + p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk)  &
+                       &         + p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk)  &
+                       &         + p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk)  &
+                       &         + p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+                       !
+                       p_surf_crs(ii,ij,jk) = zsurf
+                       p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk
+                       !
+                   ENDDO
+                ENDDO
+            ENDDO
+          
+         CASE( 'V' )
+                 
+           IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+             IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               DO jk = 1, jpk
+                 DO ji = nistr, niend, nn_factx
+                    jj = mje_crs(2)
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                    
+                    zsurf  =      p_e1(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) +  &
+                        &         p_e1(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) +  &
+                        &         p_e1(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) +  &
+                        &         p_e1(ji  ,jj-1) * p_e3(ji  ,jj-1,jk) +  &
+                        &         p_e1(ji+1,jj-1) * p_e3(ji+1,jj-1,jk) +  &
+                        &         p_e1(ji+2,jj-1) * p_e3(ji+2,jj-1,jk)
+                        
+                    !
+                    zsfcrs_msk  = p_e1(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) +  &
+                        &         p_e1(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) +  &
+                        &         p_e1(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) 
+
+                    !
+                    p_surf_crs    (ii,2,jk) = zsurf
+                    p_surf_crs_msk(ii,2,jk) = zsfcrs_msk
+                  ENDDO      
+              ENDDO
+             ENDIF
+           ELSE 
+              DO jk = 1, jpk
+                 DO ji = nistr, niend, nn_factx
+                    jj = mje_crs(2)
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
+                    
+                    zsurf  =      p_e1(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) +  &
+                        &         p_e1(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) +  &
+                        &         p_e1(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) +  &
+                        &         p_e1(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) +  &
+                        &         p_e1(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) +  &
+                        &         p_e1(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) +  &
+                        &         p_e1(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) +  &
+                        &         p_e1(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) +  &
+                        &         p_e1(ji+2,jj+2) * p_e3(ji+2,jj+2,jk)
+                        
+                    !
+                    zsfcrs_msk  = p_e1(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) +  &
+                        &         p_e1(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) +  &
+                        &         p_e1(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) +  &
+                        &         p_e1(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) +  &
+                        &         p_e1(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) +  &
+                        &         p_e1(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) +  &
+                        &         p_e1(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) +  &
+                        &         p_e1(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) +  &
+                        &         p_e1(ji+2,jj+2) * p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)
+                    !
+                    p_surf_crs    (ii,2,jk) = zsurf
+                    p_surf_crs_msk(ii,2,jk) = zsfcrs_msk
+                 ENDDO      
+              ENDDO         
+           ENDIF  
+
+      
+           DO jk = 1, jpk
+              DO ji = nistr, niend, nn_factx
+                 DO jj = njstr, njend, nn_facty
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                    ij   = ( jj - njstr ) * rfacty_r + start
+                    ijje = mje_crs(ij)
+                    ijie = mie_crs(ii)
+                    !                  
+                    zsurf  =      p_e1(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) +  &
+                        &         p_e1(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) +  &
+                        &         p_e1(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) +  &
+                        &         p_e1(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) +  &
+                        &         p_e1(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) +  &
+                        &         p_e1(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) +  &
+                        &         p_e1(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) +  &
+                        &         p_e1(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) +  &
+                        &         p_e1(ji+2,jj+2) * p_e3(ji+2,jj+2,jk)
+                        
+                    !
+                    zsfcrs_msk  = p_e1(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) +  &
+                        &         p_e1(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) +  &
+                        &         p_e1(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) +  &
+                        &         p_e1(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) +  &
+                        &         p_e1(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) +  &
+                        &         p_e1(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) +  &
+                        &         p_e1(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) +  &
+                        &         p_e1(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) +  &
+                        &         p_e1(ji+2,jj+2) * p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)
+                    !
+                    p_surf_crs    (ii,ij,jk) = zsurf
+                    p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk
+                    !
+                  ENDDO      
+              ENDDO
+           ENDDO    
+            
+         CASE( 'U' )
+         
+           IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2
+         
+             IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+               DO jk = 1, jpk
+                 DO ji = nistr, niend, nn_factx
+                    jj = mje_crs(2)
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                    
+                    zsurf  =      p_e2(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) +  &
+                        &         p_e2(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) +  &
+                        &         p_e2(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) +  &
+                        &         p_e2(ji  ,jj-1) * p_e3(ji  ,jj-1,jk) +  &
+                        &         p_e2(ji+1,jj-1) * p_e3(ji+1,jj-1,jk) +  &
+                        &         p_e2(ji+2,jj-1) * p_e3(ji+2,jj-1,jk)
+                        
+                    !
+                    zsfcrs_msk  = p_e2(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) +  &
+                        &         p_e2(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) +  &
+                        &         p_e2(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) 
+
+                    !
+                    p_surf_crs    (ii,2,jk) = zsurf
+                    p_surf_crs_msk(ii,2,jk) = zsfcrs_msk
+                  ENDDO      
+              ENDDO
+             ENDIF
+           ELSE
+              DO jk = 1, jpk
+                 DO ji = nistr, niend, nn_factx
+                 jj = mje_crs(2)
+                 ii   = ( ji - mis_crs(2) ) * rfactx_r + 2
+              
+                 zsurf  =      p_e2(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) +  &
+                        &         p_e2(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) +  &
+                        &         p_e2(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) +  &
+                        &         p_e2(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) +  &
+                        &         p_e2(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) +  &
+                        &         p_e2(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) +  &
+                        &         p_e2(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) +  &
+                        &         p_e2(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) +  &
+                        &         p_e2(ji+2,jj+2) * p_e3(ji+2,jj+2,jk)
+                        
+                    !
+                    zsfcrs_msk  = p_e2(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) +  &
+                        &         p_e2(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) +  &
+                        &         p_e2(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) +  &
+                        &         p_e2(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) +  &
+                        &         p_e2(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) +  &
+                        &         p_e2(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) +  &
+                        &         p_e2(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) +  &
+                        &         p_e2(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) +  &
+                        &         p_e2(ji+2,jj+2) * p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)
+                    !
+                    p_surf_crs    (ii,2,jk) = zsurf
+                    p_surf_crs_msk(ii,2,jk) = zsfcrs_msk
+                 ENDDO
+              ENDDO 
+           ENDIF  
+!!cc
+                  
+           DO jk = 1, jpk
+              DO ji = nistr, niend, nn_factx
+                 DO jj = njstr, njend, nn_facty
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                    ij   = ( jj - njstr ) * rfacty_r + start
+                    ijje = mje_crs(ij)
+                    ijie = mie_crs(ii)
+                    
+                    zsurf  =      p_e2(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) +  &
+                        &         p_e2(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) +  &
+                        &         p_e2(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) +  &
+                        &         p_e2(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) +  &
+                        &         p_e2(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) +  &
+                        &         p_e2(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) +  &
+                        &         p_e2(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) +  &
+                        &         p_e2(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) +  &
+                        &         p_e2(ji+2,jj+2) * p_e3(ji+2,jj+2,jk)
+                        
+                    !
+                    zsfcrs_msk  = p_e2(ji  ,jj  ) * p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) +  &
+                        &         p_e2(ji+1,jj  ) * p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) +  &
+                        &         p_e2(ji+2,jj  ) * p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) +  &
+                        &         p_e2(ji  ,jj+1) * p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) +  &
+                        &         p_e2(ji+1,jj+1) * p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) +  &
+                        &         p_e2(ji+2,jj+1) * p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) +  &
+                        &         p_e2(ji  ,jj+2) * p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) +  &
+                        &         p_e2(ji+1,jj+2) * p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) +  &
+                        &         p_e2(ji+2,jj+2) * p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)
+                    !
+                    p_surf_crs    (ii,ij,jk) = zsurf
+                    p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk
+                  ENDDO      
+              ENDDO
+           ENDDO  
+
+      END SELECT
+      
+      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 )
+
+
+   END SUBROUTINE crs_dom_sfc
+   
+   SUBROUTINE crs_dom_def
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_def ***
+      !! ** Purpose :  Three applications.
+      !!               1) Define global domain indice of the croasening grid
+      !!               2) Define local domain indice of the croasening grid
+      !!               3) Define the processor domain indice for a croasening grid
+      !!----------------------------------------------------------------
+      !! 
+      !!  local variables
+   
+      INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices
+      INTEGER  :: ierr                                ! allocation error status
+   
+     ! 1.a. Define global domain indices
+      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2
+  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj
+  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3  ! the -2 removes j=1, j=jpj
+      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3
+      jpiglo_crsm1 = jpiglo_crs - 1
+      jpjglo_crsm1 = jpjglo_crs - 1  
+
+     ! 1.b. Define local domain indices
+      jpi_crs = ( jpiglo_crs-2 * jpreci + (jpni-1) ) / jpni + 2*jpreci
+      jpj_crs = ( jpjglo_crsm1-2 * jprecj + (jpnj-1) ) / jpnj + 2*jprecj   
+       
+       
+      IF( noso < 0 ) jpj_crs = jpj_crs + 1
+      
+       
+
+      jpi_crsm1   = jpi_crs - 1
+      jpj_crsm1   = jpj_crs - 1
+      nperio_crs  = jperio
+      npolj_crs   = npolj
+      
+      ierr = crs_dom_alloc()          ! allocate most coarse grid arrays
+     ! 2.a Define processor domain
+      IF( .NOT. lk_mpp ) THEN
+         nimpp_crs  = 1
+         njmpp_crs  = 1
+         nlci_crs   = jpi_crs
+         nlcj_crs   = jpj_crs
+         nldi_crs   = 1
+         nldj_crs   = 1
+         nlei_crs   = jpi_crs
+         nlej_crs   = jpj_crs
+
+      ELSE
+         ! Initialisation of most local variables -
+         nimpp_crs  = 1
+         njmpp_crs  = 1
+         nlci_crs   = jpi_crs
+         nlcj_crs   = jpj_crs
+         nldi_crs   = 1
+         nldj_crs   = 1
+         nlei_crs   = jpi_crs
+         nlej_crs   = jpj_crs
+         reste = mod(jpjglo, nn_facty) - 1
+        ! Calculs suivant une découpage en j
+        DO jn = 1, jpnij, jpni
+           IF( jn < (jpnij-jpni + 1)) THEN
+              nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) &
+                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) )
+           ELSE                                             
+              nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1            
+           ENDIF
+           WRITE(numout,*) 'ibonjt(nproc + 1)'   , ibonjt(nproc + 1)
+           IF( noso < 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1        !!cc bande de 0 pour le continant arctique
+           SELECT CASE( ibonjt(jn) )
+              CASE ( -1 )
+                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )    nlejt_crs(jn) = nlejt_crs(jn) + 1
+                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
+                nldjt_crs(jn) = nldjt(jn) 
+              
+              CASE ( 0 )
+                nldjt_crs(jn) = nldjt(jn)
+                IF( nldjt(jn) == 1 )     nlejt_crs(jn) = nlejt_crs(jn) + 1
+                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
+                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
+                
+                
+              CASE ( 1, 2 )
+              
+                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
+                nlcjt_crs(jn) = nlejt_crs(jn)
+                nldjt_crs(jn) = nldjt(jn)
+                
+              CASE DEFAULT
+                 STOP
+           END SELECT
+           IF( nlcjt_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1
+           !!cc revoir le njmppt pour les autres cas que ORCA2
+           IF(nldjt_crs(jn) == 1 ) THEN
+              njmppt_crs(jn) = 1
+           ELSE
+              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) ) 
+           ENDIF
+           
+           DO jj = jn + 1, jn + jpni - 1
+              nlejt_crs(jj) = nlejt_crs(jn) 
+              nlcjt_crs(jj) = nlcjt_crs(jn)
+              nldjt_crs(jj) = nldjt_crs(jn)
+              njmppt_crs(jj)= njmppt_crs(jn)
+           ENDDO
+        ENDDO 
+        nlej_crs  = nlejt_crs(nproc + 1) 
+        nlcj_crs  = nlcjt_crs(nproc + 1)
+        nldj_crs  = nldjt_crs(nproc + 1)
+        
+        njmpp_crs = njmppt_crs(nproc + 1)
+
+         !!!! Calcul suivant un decoupage en i
+         
+           DO jn = 1, jpni
+
+        !      IF( jn < jpni ) THEN
+        ! 
+        !         nleit_crs(jn) = AINT( REAL( ( jpiglo - (nimppt(jn  ) - 1) ) / nn_factx, wp ) ) &
+        !                 &     - AINT( REAL( ( jpiglo - (nimppt(jn+1) - 1) ) / nn_factx, wp ) )
+        !      ELSE
+        !         nleit_crs(jn) = AINT( REAL( ( jpiglo - (nimppt(jn  ) - 1) ) / nn_factx, wp ) )
+        !      ENDIF
+   
+           IF( jn == 1 ) THEN
+           
+              nleit_crs(jn) = AINT( REAL((nimppt(jn  ) - 1 + nlcit(jn  ))  / nn_factx, wp))
+           ELSE
+              nleit_crs(jn) = AINT( REAL((nimppt(jn  ) - 1 + nlcit(jn  ))  / nn_factx, wp)) &
+                 &          - AINT( REAL((nimppt(jn-1) - 1 + nlcit(jn-1))  / nn_factx, wp))
+           ENDIF
+
+              SELECT CASE( ibonit(jn) )
+           
+                 CASE ( -1 )
+                   nleit_crs(jn) = nleit_crs(jn) + jpreci           
+                   nlcit_crs(jn) = nleit_crs(jn) + jpreci
+                   nldit_crs(jn) = nldit(jn) 
+              
+                 CASE ( 0 )
+                   nleit_crs(jn) = nleit_crs(jn) + jpreci
+                   nlcit_crs(jn) = nleit_crs(jn) + jpreci
+                   nldit_crs(jn) = nldit(jn) 
+                
+                 CASE ( 1, 2 )
+                   IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )    nleit_crs(jn) = nleit_crs(jn) + 1
+                   nleit_crs(jn) = nleit_crs(jn) + jpreci
+                   nlcit_crs(jn) = nleit_crs(jn)
+                   nldit_crs(jn) = nldit(jn) 
+                
+                 CASE DEFAULT
+                    STOP
+              END SELECT
+
+              nimppt_crs(jn) =ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1
+ !             IF (jn == jpni) nldit_crs(jn) = nldit_crs(jn) + 1               ! rajoue d'une maille a l'est pour la périodicité est ouest
+              DO jj = jn+jpni , jpnij, jpni
+                 nleit_crs(jj) = nleit_crs(jn) 
+                 nlcit_crs(jj) = nlcit_crs(jn)
+                 nldit_crs(jj) = nldit_crs(jn)
+                 nimppt_crs(jj)= nimppt_crs(jn)
+              ENDDO
+           ENDDO 
+        
+         nlei_crs  = nleit_crs(nproc + 1) 
+         nlci_crs  = nlcit_crs(nproc + 1)
+         nldi_crs  = nldit_crs(nproc + 1)
+         nimpp_crs = nimppt_crs(nproc + 1)
+
+         ! rajouter la condition stop
+         IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP
+          
+         DO ji = 1, jpi_crs
+            mig_crs(ji) = ji + jpizoom - 1 + nimpp_crs - 1
+         ENDDO
+         DO jj = 1, jpj_crs
+            mjg_crs(jj) = jj + jpjzoom - 1 + njmpp_crs - 1 !
+         ENDDO
+         
+         DO ji = 1, jpiglo_crs
+            mi0_crs(ji) = MAX( 1, MIN(ji - jpizoom +1 - nimpp_crs +1 , jpi_crs+1 ) )
+            mi1_crs(ji) = MAX( 0, MIN(ji - jpizoom +1 - nimpp_crs +1 , jpi_crs   ) )
+         ENDDO
+         WRITE(numout,*) 'mig_crs', mig_crs
+         WRITE(numout,*) 'mjg_crs', mjg_crs
+         
+         DO jj = 1, jpjglo_crs
+            mj0_crs(jj) = MAX( 1, MIN(jj - jpjzoom +1 - njmpp_crs +1 , jpj_crs+1 ) )
+            mj1_crs(jj) = MAX( 0, MIN(jj - jpjzoom +1 - njmpp_crs +1 , jpj_crs   ) )
+         ENDDO
+
+      ENDIF
+      
+      !                         Save the parent grid information
+      jpi_full    = jpi
+      jpj_full    = jpj
+      jpim1_full  = jpim1
+      jpjm1_full  = jpjm1
+      nperio_full = nperio
+
+      npolj_full  = npolj
+      jpiglo_full = jpiglo
+      jpjglo_full = jpjglo
+
+      nlcj_full   = nlcj
+      nlci_full   = nlci
+      nldi_full   = nldi
+      nldj_full   = nldj
+      nlei_full   = nlei
+      nlej_full   = nlej
+      nimpp_full  = nimpp     
+      njmpp_full  = njmpp
+      
+      nlcit_full(:)  = nlcit(:)
+      nldit_full(:)  = nldit(:)
+      nleit_full(:)  = nleit(:)
+      nimppt_full(:) = nimppt(:)
+      nlcjt_full(:)  = nlcjt(:)
+      nldjt_full(:)  = nldjt(:)
+      nlejt_full(:)  = nlejt(:)
+      njmppt_full(:) = njmppt(:)
+      
+      CALL dom_grid_crs  !swich de grille
+     
+
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'crs_init : coarse grid dimensions'
+         WRITE(numout,*) '~~~~~~~   coarse domain global j-dimension           jpjglo = ', jpjglo
+         WRITE(numout,*) '~~~~~~~   coarse domain global i-dimension           jpiglo = ', jpiglo
+         WRITE(numout,*) '~~~~~~~   coarse domain local  i-dimension              jpi = ', jpi
+         WRITE(numout,*) '~~~~~~~   coarse domain local  j-dimension              jpj = ', jpj
+         WRITE(numout,*)
+         WRITE(numout,*) ' nproc  = '     , nproc
+         WRITE(numout,*) ' nlci   = '     , nlci
+         WRITE(numout,*) ' nlcj   = '     , nlcj
+         WRITE(numout,*) ' nldi   = '     , nldi
+         WRITE(numout,*) ' nldj   = '     , nldj
+         WRITE(numout,*) ' nlei   = '     , nlei
+         WRITE(numout,*) ' nlej   = '     , nlej
+         WRITE(numout,*) ' nlei_full='    , nlei_full
+         WRITE(numout,*) ' nldi_full='    , nldi_full
+         WRITE(numout,*) ' nimpp  = '     , nimpp
+         WRITE(numout,*) ' njmpp  = '     , njmpp
+         WRITE(numout,*) ' njmpp_full  = ', njmpp_full
+         WRITE(numout,*) ' nreci'         , nreci 
+         WRITE(numout,*) ' nlejt'         , nlejt
+         WRITE(numout,*) ' nldjt'         , nldjt
+         WRITE(numout,*) ' nlcjt'         , nlcjt
+         WRITE(numout,*) ' njmppt'        , njmppt
+         WRITE(numout,*) ' nleit'         , nleit
+         WRITE(numout,*) ' nldit'         , nldit
+         WRITE(numout,*) ' nlcit'         , nlcit         
+         WRITE(numout,*) ' nimppt'        , nimppt
+         WRITE(numout,*) ' nleit_full'    , nleit_full
+         WRITE(numout,*)
+      ENDIF
+   !      PRINT *, nlcit,  nlcit(1), nlcit(nproc + 1), nproc + 1 
+   !      PRINT *, nimppt 
+   !      PRINT *, nlcit(1)
+   !      PRINT *, nlcit(nproc + 1)
+          PRINT *, jpjglo_crs, nldj, nlej, ibonjt(1)
+      
+
+      CALL dom_grid_glo
+      
+      mxbinctr   = INT( nn_factx * 0.5 )
+      mybinctr   = INT( nn_facty * 0.5 )
+
+      nrestx = MOD( nn_factx, 2 )   ! check if even- or odd- numbered reduction factor
+      nresty = MOD( nn_facty, 2 )
+
+      IF ( nrestx == 0 ) THEN
+         mxbinctr = mxbinctr - 1
+      ENDIF
+
+      IF ( nresty == 0 ) THEN
+         mybinctr = mybinctr - 1
+         IF ( jperio == 3 .OR. jperio == 4 )  nperio_crs = jperio + 2
+         IF ( jperio == 5 .OR. jperio == 6 )  nperio_crs = jperio - 2 
+
+         IF ( npolj == 3 ) npolj_crs = 5
+         IF ( npolj == 5 ) npolj_crs = 3
+      ENDIF     
+      
+      rfactxy = nn_factx * nn_facty
+      
+      ! 2.b. Set up bins for coarse grid, horizontal only.
+      ierr = crs_dom_alloc2()
+      mis2_crs(:) = 0; mie2_crs(:) = 0
+      mjs2_crs(:) = 0; mje2_crs(:) = 0
+
+      
+      SELECT CASE ( cn_binref )
+
+      CASE ( 'NORTH' ) 
+
+         SELECT CASE ( nperio )
+     
+ 
+        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold
+        
+            DO ji = 2, jpiglo_crsm1
+               ijie = (ji*nn_factx)-nn_factx   !cc
+               ijis = ijie-nn_factx+1
+               mis2_crs(ji) = ijis
+               mie2_crs(ji) = ijie
+            ENDDO
+            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1)  = jpiglo-2  
+
+            ! Handle first the northernmost bin
+            IF ( nn_facty == 2 ) THEN   ;    ijjgloT = jpjglo - 1 
+            ELSE                        ;    ijjgloT = jpjglo
+            ENDIF
+
+            DO jj = 2, jpjglo_crsm1
+        !     DO jj = 3, jpjglo_crs
+           !     ijje = ijjgloT-nn_facty*(jj-2)      !cc
+                ijje = ijjgloT-nn_facty*(jj-3)
+                ijjs = ijje-nn_facty+1                   
+         !       mjs2_crs(jpjglo_crs-jj+1) = ijjs
+         !       mje2_crs(jpjglo_crs-jj+1) = ijje
+                mjs2_crs(jpjglo_crs-jj+2) = ijjs
+                mje2_crs(jpjglo_crs-jj+2) = ijje
+
+            ENDDO
+
+         CASE ( 2 ) 
+            WRITE(numout,*)  'crs_init, jperio=2 not supported' 
+        
+         CASE ( 5, 6 )    ! F-pivot at North Fold
+
+            DO ji = 2, jpiglo_crsm1
+               ijie = (ji*nn_factx)-nn_factx 
+               ijis = ijie-nn_factx+1
+               mis2_crs(ji) = ijis
+               mie2_crs(ji) = ijie
+            ENDDO
+            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1)  = jpiglo-2 
+
+            ! Treat the northernmost bin separately.
+            jj = 2
+            ijje = jpj-nn_facty*(jj-2)
+            IF ( nn_facty == 3 ) THEN   ;  ijjs = ijje - 1 
+            ELSE                        ;  ijjs = ijje - nn_facty + 1
+            ENDIF
+            mjs2_crs(jpj_crs-jj+1) = ijjs
+            mje2_crs(jpj_crs-jj+1) = ijje
+
+            ! Now bin the rest, any remainder at the south is lumped in the southern bin
+            DO jj = 3, jpjglo_crsm1
+                ijje = jpjglo-nn_facty*(jj-2)
+                ijjs = ijje-nn_facty+1                  
+                IF ( ijjs <= nn_facty )   ijjs = 2
+                mjs2_crs(jpj_crs-jj+1) = ijjs
+                mje2_crs(jpj_crs-jj+1) = ijje
+            ENDDO
+
+         CASE DEFAULT
+            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4, 5, 6 supported' 
+ 
+         END SELECT
+
+      CASE ( 'EQUAT' )
+         WRITE(numout,*) 'crs_init.  Equator-centered bins option not yet available' 
+
+      END SELECT
+
+     ! Pad the boundaries, do not know if it is necessary
+      mis2_crs(2) = 1             ; mis2_crs(jpiglo_crs) = mie2_crs(jpiglo_crs - 1) + 1   
+      mie2_crs(2) = nn_factx      ; mie2_crs(jpiglo_crs) = jpiglo                         
+      mje2_crs(2) = mjs2_crs(3)-1 ; mje2_crs(jpjglo_crs) = jpjglo
+      mjs2_crs(2) = 1             ; mjs2_crs(jpjglo_crs) = mje2_crs(jpjglo_crs) - nn_facty + 1                                              
+      mjs2_crs(1) = 1
+      mje2_crs(1) = 1
+                   
+      
+ 
+      IF( .NOT. lk_mpp ) THEN     
+        mis_crs(:) = mis2_crs(:) 
+        mie_crs(:) = mie2_crs(:)
+        mjs_crs(:) = mjs2_crs(:) 
+        mje_crs(:) = mje2_crs(:) 
+      ELSE
+        DO jj = 1, nlej_crs
+           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1
+           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1
+        ENDDO
+        DO ji = 1, nlei_crs
+           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1
+           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1
+        ENDDO
+      ENDIF
+      njstr = mjs_crs(3)
+      start = 3
+      njend = mjs_crs(nlcj_crs - 1)     !! cc peut etre modification du njstr
+      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1)
+      IF(lwp) THEN
+      WRITE(numout,*) 'crs_init. coarse grid bounds on parent grid'
+      WRITE(numout,*) 'mjg_crs='  , mjg_crs
+      WRITE(numout,*) 'mig_crs='  , mig_crs
+      WRITE(numout,*) 'nimpp_crs=', nimpp_crs
+      WRITE(numout,*) 'njmpp_crs=', njmpp_crs
+      WRITE(numout,*) 'njend='    , njend
+      WRITE(numout,*) 'mis_crs='  , mis_crs
+      WRITE(numout,*) 'mie_crs='  , mie_crs
+      WRITE(numout,*) 'mjs_crs='  , mjs_crs
+      WRITE(numout,*) 'mje_crs='  , mje_crs
+      WRITE(numout,*) 'mjs2_crs='  , mjs2_crs
+      WRITE(numout,*) 'mje2_crs='  , mje2_crs
+
+      WRITE(numout,*) 'njend'  , njend
+      WRITE(numout,*) ' njstr' , njstr
+
+      ENDIF
+      !
+      
+   END SUBROUTINE crs_dom_def
+   
+   SUBROUTINE crs_dom_bat
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_bat ***
+      !! ** Purpose :  coarsenig bathy
+      !!----------------------------------------------------------------
+      !! 
+      !!  local variables
+      INTEGER  :: ji,jj,jk      ! dummy indices
+      REAL(wp), DIMENSION(:,:)  , POINTER :: zmbk
+      !!----------------------------------------------------------------
+   
+      CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )
+   
+      mbathy_crs(:,:) = jpkm1
+      mbkt_crs(:,:) = 1
+      mbku_crs(:,:) = 1
+      mbkv_crs(:,:) = 1
+
+
+      DO jj = 1, jpj_crs
+         DO ji = 1, jpi_crs
+            jk = 0
+            DO WHILE( tmask_crs(ji,jj,jk+1) > 0.)
+               jk = jk + 1
+            ENDDO
+            mbathy_crs(ji,jj) =  jk 
+         ENDDO
+      ENDDO
+     
+      CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )
+
+      zmbk(:,:) = 0.0
+      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) )
+
+
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    crsini : mbkt is ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt_crs(:,:) = MAX( mbathy_crs(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+      !                                     ! bottom k-index of W-level = mbkt+1
+
+      DO jj = 1, jpj_crsm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpi_crsm1
+            mbku_crs(ji,jj) = MIN(  mbkt_crs(ji+1,jj  ) , mbkt_crs(ji,jj)  )
+            mbkv_crs(ji,jj) = MIN(  mbkt_crs(ji  ,jj+1) , mbkt_crs(ji,jj)  )
+         END DO
+      END DO
+
+      ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
+      zmbk(:,:) = 1.e0;    
+      zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
+      zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
+      !
+      CALL wrk_dealloc( jpi_crs, jpj_crs, zmbk )
+      !
+   END SUBROUTINE crs_dom_bat
+
+
+END MODULE crsdom
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdomwri.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdomwri.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsdomwri.F90	(revision 4056)
@@ -0,0 +1,371 @@
+MODULE crsdomwri
+   !!======================================================================
+   !! Coarse Ocean initialization : write the coarse ocean domain mesh and mask files
+   !!======================================================================
+   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
+   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
+   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!                 ! 2012-06  (J. Simeon)  Reduced and modified for coarse grid
+   !!                 ! 2012-10  (C. Calone)  Reduced and modified for coarse grid
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   crs_dom_wri    : create and write mesh and mask file(s)
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE par_kind, ONLY: wp
+   USE lib_mpp         ! MPP library
+!   USE wrk_nemo        ! Memory allocation
+   USE iom_def
+   USE iom
+   USE crs         ! coarse grid domain
+   USE crsdom         ! coarse grid domain
+   USE crsiom         ! crs mediator to I/O library
+   USE crslbclnk       ! crs mediator to lbclnk
+
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC crs_dom_wri        ! routine called by crsini.F90
+
+CONTAINS
+
+   SUBROUTINE crs_dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_dom_wri  ***
+      !!
+      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
+      !!      ocean domain informations (mesh and mask arrays). This (these)
+      !!      file(s) is (are) used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   Write in a file all the arrays generated in routines
+      !!      crsini for meshes and mask. In three separate files: 
+      !!      domain size, horizontal grid-point position,
+      !!      masks, depth and vertical scale factors
+      !!      
+      !! ** Output files :   mesh_hgr_crs.nc, mesh_zgr_crs.nc, mesh_mask.nc
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file
+      INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file
+      INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file
+      INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file
+      INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file
+      INTEGER           ::   iif, iil, ijf, ijl
+      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
+      CHARACTER(len=21) ::   clnam1   ! filename (mesh informations)
+      CHARACTER(len=21) ::   clnam2   ! filename (mask informations)
+      CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations)
+      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations)
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      !                                   !  workspaces
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zprt, zprw 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdepu, zdepv
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: ze3tp, ze3wp
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_dom_wri')
+      !
+      ALLOCATE( zprt  (jpi_crs,jpj_crs)   , zprw(jpi_crs,jpj_crs) )
+      ALLOCATE( zdepu(jpi_crs,jpj_crs,jpk), zdepv(jpi_crs,jpj_crs,jpk) )
+      ALLOCATE( ze3tp(jpi_crs,jpj_crs)    , ze3wp(jpi_crs,jpj_crs) )
+
+      ze3tp(:,:) = 0.0
+      ze3wp(:,:) = 0.0
+
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'crs_dom_wri : create NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      
+      clnam0 = 'mesh_mask_crs'  ! filename (mesh and mask informations)
+      clnam1 = 'mesh_crs'       ! filename (mesh informations)
+      clnam2 = 'mask_crs'       ! filename (mask informations)
+      clnam3 = 'mesh_hgr_crs'   ! filename (horizontal mesh informations)
+      clnam4 = 'mesh_zgr_crs'   ! filename (vertical   mesh informations)
+      
+
+      SELECT CASE ( MOD(nn_msh_crs, 3) )
+         !                                  ! ============================
+      CASE ( 1 )                            !  create 'mesh_mask.nc' file
+         !                                  ! ============================
+         CALL crs_iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         inum2 = inum0                                            ! put all the informations
+         inum3 = inum0                                            ! in unit inum0
+         inum4 = inum0
+         
+         !                                  ! ============================
+      CASE ( 2 )                            !  create 'mesh.nc' and 
+         !                                  !         'mask.nc' files
+         !                                  ! ============================
+         CALL crs_iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL crs_iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         inum3 = inum1                                            ! put mesh informations 
+         inum4 = inum1                                            ! in unit inum1 
+         !                                  ! ============================
+      CASE ( 0 )                            !  create 'mesh_hgr.nc'
+         !                                  !         'mesh_zgr.nc' and
+         !                                  !         'mask.nc'     files
+         !                                  ! ============================
+         CALL crs_iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL crs_iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL crs_iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
+         !
+      END SELECT
+ 
+      !========================================================
+      !                                                         ! masks (inum2) 
+      CALL crs_iom_rstput( 0, 0, inum2, 'tmask', pv_r3d=tmask_crs, ktype = jp_i1 )     !    ! land-sea mask
+      CALL crs_iom_rstput( 0, 0, inum2, 'umask', pv_r3d=umask_crs, ktype = jp_i1 )
+      CALL crs_iom_rstput( 0, 0, inum2, 'vmask', pv_r3d=vmask_crs, ktype = jp_i1 )
+      CALL crs_iom_rstput( 0, 0, inum2, 'fmask', pv_r3d=fmask_crs, ktype = jp_i1 )
+      
+  !    CALL crs_dom_uniq( zprw, 'T' )
+  !    tmask_i_crs(:,:) = tmask_crs(:,:,1) * zprw
+      
+      tmask_i_crs(:,:) = tmask_crs(:,:,1)
+      iif = jpreci
+      iil = nlci_crs - jpreci + 1
+      ijf = jpreci
+      ijl = nlcj_crs - jprecj + 1
+     
+      tmask_i_crs( 1:iif ,    :  ) = 0._wp
+      tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp
+      tmask_i_crs(   :   , 1:ijf ) = 0._wp
+      tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp
+      
+     
+
+      !!! north fold mask_crs
+      
+      tpol_crs(1:jpiglo_crs,:) = 1._wp
+      fpol_crs(1:jpiglo_crs,:) = 1._wp
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp
+         fpol_crs(       1      :jpiglo_crs,:) = 0._wp
+         IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN
+            DO ji = iif+1, iil-1
+               tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) &
+               & * tpol_crs(mig_crs(ji),1)
+            ENDDO
+         ENDIF
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         tpol_crs(      1       :jpiglo_crs,:)=0._wp
+         fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp
+      ENDIF
+      
+ !     CALL crs_iom_rstput( 0, 0, inum2, 'tpol', pv_r2d=tpol_crs, ktype = jp_i1 )  
+ !     CALL crs_iom_rstput( 0, 0, inum2, 'fpol', pv_r2d=fpol_crs, ktype = jp_i1 )  
+
+      !!!
+      CALL crs_iom_rstput( 0, 0, inum2, 'tmaskutil', pv_r2d=tmask_i_crs, ktype = jp_i1 )
+                                   !    ! unique point mask
+      CALL crs_dom_uniq( zprw, 'U' )
+      zprt = umask_crs(:,:,1) * zprw
+      CALL crs_iom_rstput( 0, 0, inum2, 'umaskutil', pv_r2d=zprt, ktype = jp_i1 )  
+      CALL crs_dom_uniq( zprw, 'V' )
+      zprt = vmask_crs(:,:,1) * zprw
+      CALL crs_iom_rstput( 0, 0, inum2, 'vmaskutil', pv_r2d=zprt, ktype = jp_i1 )  
+      CALL crs_dom_uniq( zprw, 'F' )
+      zprt = fmask_crs(:,:,1) * zprw
+      CALL crs_iom_rstput( 0, 0, inum2, 'fmaskutil', pv_r2d=zprt, ktype = jp_i1 )  
+      !========================================================
+      !                                                         ! horizontal mesh (inum3)
+      CALL crs_iom_rstput( 0, 0, inum3, 'glamt', pv_r2d=glamt_crs, ktype = jp_r4 )     !    ! latitude
+      CALL crs_iom_rstput( 0, 0, inum3, 'glamu', pv_r2d=glamu_crs, ktype = jp_r4 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'glamv', pv_r2d=glamv_crs, ktype = jp_r4 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'glamf', pv_r2d=glamf_crs, ktype = jp_r4 )
+      
+      CALL crs_iom_rstput( 0, 0, inum3, 'gphit', pv_r2d=gphit_crs, ktype = jp_r4 )     !    ! longitude
+      CALL crs_iom_rstput( 0, 0, inum3, 'gphiu', pv_r2d=gphiu_crs, ktype = jp_r4 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'gphiv', pv_r2d=gphiv_crs, ktype = jp_r4 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'gphif', pv_r2d=gphif_crs, ktype = jp_r4 )
+      
+      CALL crs_iom_rstput( 0, 0, inum3, 'e1t', pv_r2d=e1t_crs, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL crs_iom_rstput( 0, 0, inum3, 'e1u', pv_r2d=e1u_crs, ktype = jp_r8 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'e1v', pv_r2d=e1v_crs, ktype = jp_r8 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'e1f', pv_r2d=e1f_crs, ktype = jp_r8 )
+      
+      CALL crs_iom_rstput( 0, 0, inum3, 'e2t', pv_r2d=e2t_crs, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL crs_iom_rstput( 0, 0, inum3, 'e2u', pv_r2d=e2u_crs, ktype = jp_r8 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'e2v', pv_r2d=e2v_crs, ktype = jp_r8 )
+      CALL crs_iom_rstput( 0, 0, inum3, 'e2f', pv_r2d=e2f_crs, ktype = jp_r8 )
+      
+      CALL crs_iom_rstput( 0, 0, inum3, 'ff', pv_r2d=ff_crs, ktype = jp_r8 )           !    ! coriolis factor
+
+      !========================================================
+      !                                                         ! vertical mesh (inum4) 
+!     ! note that mbkt is set to 1 over land ==> use surface tmask_crs
+      zprt(:,:) = tmask_crs(:,:,1) * REAL( mbkt_crs(:,:) , wp )
+      CALL crs_iom_rstput( 0, 0, inum4, 'mbathy', pv_r2d=zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
+
+   !   IF( ln_zps ) THEN                       ! z-coordinate - partial steps
+
+            
+         IF ( nn_msh_crs <= 6 ) THEN
+            CALL crs_iom_rstput( 0, 0, inum4, 'e3t', pv_r3d=e3t_max_crs )      
+            CALL crs_iom_rstput( 0, 0, inum4, 'e3w', pv_r3d=e3w_max_crs )      
+            CALL crs_iom_rstput( 0, 0, inum4, 'e3u', pv_r3d=e3u_max_crs )      
+            CALL crs_iom_rstput( 0, 0, inum4, 'e3v', pv_r3d=e3v_max_crs )      
+         ELSE
+            DO jj = 1,jpj_crs   
+               DO ji = 1,jpi_crs
+                  ze3tp(ji,jj) = fse3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+                  ze3wp(ji,jj) = fse3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+               END DO
+            END DO
+
+            CALL crs_lbc_lnk( ze3tp,'T', 1.0 )
+            CALL crs_lbc_lnk( ze3wp,'W', 1.0 )
+  
+            CALL crs_iom_rstput( 0, 0, inum4, 'e3t_ps', pv_r2d=ze3tp )      
+            CALL crs_iom_rstput( 0, 0, inum4, 'e3w_ps', pv_r2d=ze3wp )
+         ENDIF
+
+         IF ( nn_msh_crs <= 3 ) THEN
+            CALL crs_iom_rstput( 0, 0, inum4, 'gdept', pv_r3d=gdept_crs, ktype = jp_r4 ) 
+            DO jk = 1,jpk   
+               DO jj = 1, jpj_crsm1   
+                  DO ji = 1, jpi_crsm1  ! jes what to do for fs_jpim1??vector opt.
+                     zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk)
+                     zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk)
+                  END DO   
+               END DO   
+            END DO
+
+            CALL crs_lbc_lnk( zdepu,'U', 1. )   ;   CALL crs_lbc_lnk( zdepv,'V', 1. ) 
+            CALL crs_iom_rstput( 0, 0, inum4, 'gdepu', pv_r3d=zdepu, ktype = jp_r4 )
+            CALL crs_iom_rstput( 0, 0, inum4, 'gdepv', pv_r3d=zdepv, ktype = jp_r4 )
+            CALL crs_iom_rstput( 0, 0, inum4, 'gdepw', pv_r3d=gdepw_crs, ktype = jp_r4 )
+         ELSE
+            DO jj = 1,jpj_crs   
+               DO ji = 1,jpi_crs
+                  zprt(ji,jj) = gdept(ji,jj,mbkt(ji,jj)  ) * tmask(ji,jj,1)
+                  zprw(ji,jj) = gdepw(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1)
+               END DO
+            END DO
+            CALL crs_iom_rstput( 0, 0, inum4, 'hdept', pv_r2d=zprt, ktype = jp_r4 )     
+            CALL crs_iom_rstput( 0, 0, inum4, 'hdepw', pv_r2d=zprw, ktype = jp_r4 ) 
+         ENDIF
+
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! reference z-coord.
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
+         CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )
+         CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   )
+
+         CALL crs_iom_rstput(  0, 0, inum4, 'ocean_volume_t', pv_r3d=ocean_volume_crs_t ) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'facvol_t' , pv_r3d=facvol_t ) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'facvol_w' , pv_r3d=facvol_w ) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'facsurfu' , pv_r3d=facsurfu ) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'facsurfv' , pv_r3d=facsurfv ) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'e1e2w_msk', pv_r3d=e1e2w_msk) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'e2e3u_msk', pv_r3d=e2e3u_msk) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'e1e3v_msk', pv_r3d=e1e3v_msk)
+         CALL crs_iom_rstput(  0, 0, inum4, 'e1e2w'    , pv_r3d=e1e2w_crs    ) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'e2e3u'    , pv_r3d=e2e3u_crs    ) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'e1e3v'    , pv_r3d=e1e3v_crs    )
+         CALL crs_iom_rstput(  0, 0, inum4, 'bt'       , pv_r3d=bt_crs   )
+         CALL crs_iom_rstput(  0, 0, inum4, 'r1_bt'    , pv_r3d=r1_bt_crs)
+
+         CALL crs_iom_rstput(  0, 0, inum4, 'crs_surfu_wgt', pv_r3d=crs_surfu_wgt) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'crs_surfv_wgt', pv_r3d=crs_surfv_wgt) 
+         CALL crs_iom_rstput(  0, 0, inum4, 'crs_volt_wgt', pv_r3d=crs_volt_wgt) 
+
+
+
+    !  ENDIF
+      
+     IF( ln_zco ) THEN
+         !                                                      ! z-coordinate - full steps
+        CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! depth
+        CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
+        CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )     !    ! scale factors
+        CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   )
+     ENDIF
+      !                                     ! ============================
+      !                                     !        close the files 
+      !                                     ! ============================
+      SELECT CASE ( MOD(nn_msh_crs, 3) )
+      CASE ( 1 )                
+         CALL crs_iom_close( inum0 )
+      CASE ( 2 )
+         CALL crs_iom_close( inum1 )
+         CALL crs_iom_close( inum2 )
+      CASE ( 0 )
+         CALL crs_iom_close( inum2 )
+         CALL crs_iom_close( inum3 )
+         CALL crs_iom_close( inum4 )
+      END SELECT
+      !
+      !
+      DEALLOCATE( zprt  , zprw )
+      DEALLOCATE( zdepu , zdepv )
+      DEALLOCATE( ze3tp , ze3wp )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_wri')
+      !
+      
+   END SUBROUTINE crs_dom_wri
+
+
+   SUBROUTINE crs_dom_uniq( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_dom_uniq  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** Method  :   1) apply crs_lbc_lnk on an array with different values for each element
+      !!                2) check which elements have been changed
+      !!----------------------------------------------------------------------
+      !
+      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp) ::  zshift   ! shift value link to the process number
+      INTEGER  ::  ji       ! dummy loop indices
+      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
+!      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztstref
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_dom_uniq')
+      !
+!      CALL wrk_alloc( jpi_crs, jpj_crs, ztstref )
+      ALLOCATE( ztstref(jpi_crs,jpj_crs) )
+      !
+      ! build an array with different values for each element 
+      ! in mpp: make sure that these values are different even between process
+      ! -> apply a shift value according to the process number
+      zshift = jpi_crs * jpj_crs * ( narea - 1 )
+      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi_crs*jpj_crs) /), (/ jpi_crs, jpj_crs /) )
+      !
+      puniq(:,:) = ztstref(:,:)                   ! default definition
+      CALL crs_lbc_lnk( puniq,cdgrd, 1. )            ! apply boundary conditions
+      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
+      !
+      puniq(:,:) = 1.                             ! default definition
+      ! fill only the inner part of the cpu with llbl converted into real 
+      puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp )
+      !
+!      CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref )
+
+      DEALLOCATE( ztstref )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_uniq')
+      !
+      
+   END SUBROUTINE crs_dom_uniq
+
+   !!======================================================================
+
+END MODULE crsdomwri
+
+
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsini.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsini.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsini.F90	(revision 4056)
@@ -0,0 +1,294 @@
+MODULE crsini   
+   !!======================================================================
+   !!                         ***  MODULE crsini  ***
+   !!            Manage the grid coarsening module initialization
+   !!======================================================================
+   !!  History     2012-05   (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
+   !!----------------------------------------------------------------------
+
+   USE timing                   ! Timing
+   USE par_oce                  ! For parameter jpi,jpj,jphgr_msh
+   USE dom_oce                  ! For parameters in par_oce (jperio, lk_vvl)
+   USE crs                  ! Coarse grid domain
+   USE phycst, ONLY: omega, rad ! physical constants
+   USE wrk_nemo 
+   USE in_out_manager
+   USE par_kind, ONLY: wp
+   USE crsdom
+   USE crsdomwri
+   USE crslbclnk
+   USE lib_mpp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  crs_init
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+
+CONTAINS
+   
+   SUBROUTINE crs_init 
+      !!-------------------------------------------------------------------
+      !!                     *** SUBROUTINE crs_init
+      !!  ** Purpose : Initialization of the grid coarsening module  
+      !!               1. Read namelist
+      !!               X2. MOVE TO crs_dom.F90 Set the domain definitions for coarse grid
+      !!                 a. Define the coarse grid starting/ending indices on parent grid
+      !!                    Here is where the T-pivot or F-pivot grids are discerned
+      !!                 b. TODO.  Include option for north-centric or equator-centric binning.
+      !!                 (centered only for odd reduction factors; even reduction bins bias equator to the south)
+      !!               3. Mask and mesh creation. => calls to crsfun
+      !!                  a. Use crsfun_mask to generate tmask,umask, vmask, fmask.
+      !!                  b. Use crsfun_coordinates to get coordinates
+      !!                  c. Use crsfun_UV to get horizontal scale factors
+      !!                  d. Use crsfun_TW to get initial vertical scale factors   
+      !!               4. Volumes and weights jes.... TODO. Updates for vvl? Where to do this? crsstp.F90?
+      !!                  a. Calculate initial coarse grid box volumes: pvol_T, pvol_W
+      !!                  b. Calculate initial coarse grid surface-averaging weights
+      !!                  c. Calculate initial coarse grid volume-averaging weights
+      !!                  
+      !!               X5. MOVE TO crs_dom_wri.F90 Using iom_rstput output the initial meshmask.
+      !!               ?. Another set of "masks" to generate
+      !!                  are the u- and v- surface areas for U- and V- area-weighted means.
+      !!                  Need to put this somewhere in section 3?
+      !! jes. What do to about the vvl?  GM.  could separate the weighting (denominator), so
+      !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output.
+      !! As is, crsfun takes into account vvl.   
+      !!      Talked about pre-setting the surface array to avoid IF/ENDIFS and division.
+      !!      But have then to make that preset array here and elsewhere.
+      !!      that is called every timestep...
+      !! 
+      !!               - Read in pertinent data ?
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER  :: ji,jj,jk      ! dummy indices
+      INTEGER  :: ierr                                ! allocation error status
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w
+
+      NAMELIST/namcrs/ nn_factx, nn_facty, cn_binref, nn_fcrs, nn_msh_crs, cn_ocerstcrs, ln_crs_top
+
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'crs_init : Initializing the grid coarsening module '
+      ENDIF
+
+     !---------------------------------------------------------
+     ! 1. Read Namelist file
+     !---------------------------------------------------------
+      !
+      READ( numnam, namcrs )        ! Namelist namcrs : Grid-coarsening utility namelist
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'crs_init: Namelist namcrs '
+         WRITE(numout,*) '          nn_factx   = ' , nn_factx
+         WRITE(numout,*) '          nn_facty   = ' , nn_facty
+         WRITE(numout,*) '          cn_binref  = ' , cn_binref
+         WRITE(numout,*) '          nn_fcrs    = ' , nn_fcrs
+         WRITE(numout,*) '          nn_msh_crs = ' , nn_msh_crs
+         WRITE(numout,*) '          njmppt     = ' , njmppt
+      ENDIF
+              
+     rfactx_r = 1. / nn_factx
+     rfacty_r = 1. / nn_facty
+
+     !---------------------------------------------------------
+     ! 2. Define Global Dimensions of the coarsened grid
+     !---------------------------------------------------------
+     CALL crs_dom_def      
+
+     !---------------------------------------------------------
+     ! 3. Mask and Mesh
+     !---------------------------------------------------------
+
+     !     Set up the masks and meshes     
+
+     !  3.a. Get the masks   
+ 
+     CALL crs_dom_msk
+
+
+     WRITE(numout,*) 'crsini. Finished masks'
+
+     !  3.b. Get the coordinates
+     !      Odd-numbered reduction factor, center coordinate on T-cell
+     !      Even-numbered reduction factor, center coordinate on U-,V- faces or f-corner.
+     !      
+     IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
+        CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 
+        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )       
+        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
+     ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
+        CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
+        CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ELSE 
+        CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ENDIF
+     IF(lwp) THEN
+        WRITE(numout,*) 'crsini. Finished coordinates'
+     ENDIF
+
+     !  3.c. Get the horizontal mesh
+
+     !      3.c.1 Horizontal scale factors
+
+     CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs )
+     CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs )
+     CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
+     CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
+
+     e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
+     IF(lwp) THEN
+        WRITE(numout,*) 'crsini. Finished horizontal scale factors'
+     ENDIF
+     
+     !      3.c.2 Coriolis factor  
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+
+      CASE ( 0, 1, 4 )           ! mesh on the sphere
+
+         ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) )
+
+      CASE DEFAULT 
+         IF(lwp) THEN
+            WRITE(numout,*) 'crsini.F90. crs_init. Only jphgr_msh = 0, 1 or 4 supported' 
+         ENDIF
+ 
+      END SELECT 
+
+     !    3.d.1 mbathy ( vertical k-levels of bathymetry )     
+
+     CALL crs_dom_bat
+     
+     !    3.d.2   Vertical scale factors
+     CALL wrk_alloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
+     !
+     zfse3t(:,:,:) = fse3t(:,:,:)
+     zfse3u(:,:,:) = fse3u(:,:,:)
+     zfse3v(:,:,:) = fse3v(:,:,:)
+     zfse3w(:,:,:) = fse3w(:,:,:)
+   
+     !    3.d.3   Surfaces 
+     
+     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t )
+     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u )
+     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v )
+   
+     facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)
+     facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:)
+
+
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'crs_init : beginning section 3.d.2 ! '
+      ENDIF
+      
+     CALL crs_dom_e3_max( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_max_crs, e3t_crs)
+     CALL crs_dom_e3_max( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_max_crs, e3w_crs)
+     CALL crs_dom_e3_max( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_max_crs, e3u_crs)
+     CALL crs_dom_e3_max( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_max_crs, e3v_crs)
+     
+    DO jk = 1, jpk
+     e3u_crs(:,:,jk) = e2e3u_msk(:,:,jk) / e2u_crs(:,:)
+     e3v_crs(:,:,jk) = e1e3v_msk(:,:,jk) / e1v_crs(:,:)
+    END DO
+       
+     IF(lwp) THEN
+        WRITE(numout,*) 'crs_init : crs_e3_max '
+     ENDIF 
+     
+     ! Reset 0 to e3t_0 or e3w_0
+     DO jk = 1, jpk
+        DO ji = 1, jpi_crs
+           DO jj = 1, jpj_crs
+              IF ( e3t_crs(ji,jj,jk) == 0 ) e3t_crs(ji,jj,jk) = e3t_0(jk)
+              IF ( e3w_crs(ji,jj,jk) == 0 ) e3w_crs(ji,jj,jk) = e3w_0(jk)
+              IF ( e3f_crs(ji,jj,jk) == 0 ) e3f_crs(ji,jj,jk) = e3t_0(jk)
+           ENDDO
+        ENDDO
+     ENDDO
+      DO jk = 1, jpk
+        DO ji = 2, jpi_crsm1
+           DO jj = 2, jpj_crsm1
+              IF ( e3u_crs(ji,jj,jk) == 0 ) e3u_crs(ji,jj,jk) = & 
+              &  (1._wp - umask_crs(ji,jj,jk)) * MIN(e3t_crs(ji+1,jj,jk),e3t_crs(ji,jj,jk))
+              IF ( e3v_crs(ji,jj,jk) == 0 ) e3v_crs(ji,jj,jk) = & 
+              &  (1._wp - vmask_crs(ji,jj,jk)) * MIN(e3t_crs(ji,jj+1,jk),e3t_crs(ji,jj,jk))
+           ENDDO
+        ENDDO
+     ENDDO
+     CALL crs_lbc_lnk(e3u_crs, 'U', 1.0, pval=1.0 )
+     CALL crs_lbc_lnk(e3v_crs, 'V', 1.0, pval=1.0 )
+     
+     !    3.d.4   Vertical depth (meters) tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0
+     CALL crs_dom_ope( gdept, 'VOL', 'T', tmask, gdept_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
+     CALL crs_dom_ope( gdepw, 'VOL', 'W', tmask, gdepw_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
+
+     !    3.d.5   mkb?_crs 
+     
+  !   mbkt_crs(:,:) = 1
+  !   mbku_crs(:,:) = 1
+  !   mbkv_crs(:,:) = 1
+  !   DO jk = 2, jpk-1
+  !      mbkt_crs(:,:) = mbkt_crs(:,:) + tmask_crs(:,:,jk)
+  !      mbku_crs(:,:) = mbku_crs(:,:) + umask_crs(:,:,jk)
+  !      mbkv_crs(:,:) = mbkv_crs(:,:) + vmask_crs(:,:,jk)
+  !   ENDDO
+  !   IF(lwp) THEN
+  !      WRITE(numout,*) 'mbkt_crs ', mbkt_crs
+   !     WRITE(numout,*) 'mbku_crs ', mbku_crs
+  !      WRITE(numout,*) 'mbkv_crs ', mbkv_crs
+  !   ENDIF 
+     !---------------------------------------------------------
+     ! 4.  Coarse grid ocean volume and averaging weights
+     !---------------------------------------------------------
+     ! 4.a. Ocean volume or area unmasked and masked
+
+!!     ! jes. May not need ocean_volume_crs_t, ocean_volume_crs_w as calculated already in trc_init as cvol
+     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t )
+     !
+     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)
+     !
+     r1_bt_crs(:,:,:) = 0._wp 
+     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
+
+     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w )
+     !
+     !---------------------------------------------------------
+     ! 5.  Write out coarse meshmask  (see OPA_SRC/DOM/domwri.F90 for ideas later)
+     !---------------------------------------------------------
+     IF ( nn_msh_crs > 0 ) CALL crs_dom_wri
+     
+     IF(lwp) THEN
+        WRITE(numout,*) ' minimum e1T', MINVAL(e1t_crs)
+        WRITE(numout,*) 'crs_init done'
+     ENDIF
+     !---------------------------------------------------------
+     ! 7. Finish and clean-up
+     !---------------------------------------------------------
+     CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
+     !e3t_crs=bt_crs(:,:,:)/e1e2w_crs(:,:,:)
+ 
+
+   END SUBROUTINE crs_init
+    
+   !!======================================================================
+
+END MODULE crsini
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsiom.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsiom.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crsiom.F90	(revision 4056)
@@ -0,0 +1,188 @@
+MODULE crsiom
+   !!=====================================================================
+   !!                    ***  MODULE  crs_iom ***
+   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
+   !!====================================================================
+   !! History :  9.0  ! 12 06  (J. Simeon) Original code
+   !!                 ! 12 10  (C. Calone) Modified to finish code
+   !!
+   !!
+   !!            kdompar_crs(1,1) = global x-dimension, jpiglo_crs
+   !!            kdompar_crs(2,1) = global y-dimension, jpjglo_crs
+   !!            kdompar_crs(:,2)  
+   !!  from dom_oce INTEGER nimpp, njmpp      !: i- & j-indexes for mpp-subdomain left bottom
+   !!
+   !!  From LBC/mppini.F90      
+   !!  ! No mpp computation
+   !!   nimpp  = 1
+   !!   njmpp  = 1
+   !!   nlci   = jpi
+   !!   nlcj   = jpj
+   !!   nldi   = 1
+   !!   nldj   = 1
+   !!   nlei   = jpi
+   !!   nlej   = jpj
+   !!   nperio = jperio
+   !!   nbondi = 2
+   !!   nbondj = 2
+   !!   nidom  = FLIO_DOM_NONE
+   !!   npolj = jperio
+   !!
+   !! jes. 28 Jun 2012. TODO. make sure of variable declarations to be placed here or crs_dom.F90
+   !!--------------------------------------------------------------------
+   USE timing
+   USE crs
+   USE dom_oce         ! ocean space and time domain
+   USE iom_def         ! iom variables definitions
+   USE netcdf          ! NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE iom             ! I/O library
+   USE par_kind, ONLY: wp   
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC crs_iom_open, crs_iom_close, crs_iom_rstput, crs_iom_put
+
+!   PUBLIC crs_iom_varid, crs_iom_get, crs_iom_gettime
+
+
+   INTEGER, PARAMETER ::   jpdomcrs_data          = 1   !: ( 1  :jpiglo_crs, 1  :jpjglo_crs)
+   INTEGER, PARAMETER ::   jpdomcrs_global        = 2   !: ( 1  :jpiglo_crs, 1  :jpjglo_crs)
+   INTEGER, PARAMETER ::   jpdomcrs_local         = 3   !: One of the 3 following cases
+   INTEGER, PARAMETER ::   jpdomcrs_local_full    = 4   !: ( 1  :jpi_crs   , 1  :jpj_crs   )
+   INTEGER, PARAMETER ::   jpdomcrs_local_noextra = 5   !: ( 1  :nlci_crs  , 1  :nlcj_crs  )
+   INTEGER, PARAMETER ::   jpdomcrs_local_noovlap = 6   !: (nldi_crs:nlei_crs  ,nldj_crs:nlej_crs  )
+   INTEGER, PARAMETER ::   jpdomcrs_unknown       = 7   !: No dimension checking
+   INTEGER, PARAMETER ::   jpdomcrs_autoglo       = 8   !:
+   INTEGER, PARAMETER ::   jpdomcrs_autodta       = 9   !:
+   INTEGER            ::   ipdomcrs_local_noovlap_crs, ipdomcrs_local_full_crs, idomcrs_local_noextra_crs
+
+   INTEGER                 ::   idomcrs     ! Type of domain to be written (default = jpdom_local_noovlap)
+   INTEGER, DIMENSION(2,5) ::   idompar_crs ! domain parameters:    
+   LOGICAL                 ::   llnoov      ! local definition to read overlap
+
+
+CONTAINS
+
+   SUBROUTINE crs_iom_open( cdname, kiomid, ldwrt, kdom, kiolib )
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE crs_iom_open  ***
+      !!
+      !! ** Purpose : open an input file with NF90 on coarsened grid
+      !!---------------------------------------------------------------------
+      !! Arguments
+      CHARACTER(len=*)       , INTENT(in)           ::   cdname   ! File name
+      INTEGER                , INTENT(inout)        ::   kiomid   ! nf90 identifier of the opened file
+      LOGICAL                , INTENT(in)           ::   ldwrt    ! read or write the file?
+      INTEGER                , INTENT(in), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
+      INTEGER                , INTENT(in), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90)
+
+
+      CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+
+      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+      IF( llnoov ) THEN   ;   idomcrs = jpdomcrs_local_noovlap   ! default definition
+      ELSE                ;   idomcrs = jpdomcrs_local_full      ! default definition
+      ENDIF
+      IF ( PRESENT(kdom) ) idomcrs = kdom
+
+      CALL iom_open( cdname, kiomid, ldwrt, idomcrs, kiolib )
+      
+      WRITE(numout,*) 'dim_crs', jpdomcrs_local_noovlap
+
+      WRITE(numout,*) 'crs_iom_open. after iom_open call kiomid=', kiomid
+
+      CALL dom_grid_glo   ! Return to parent grid domain
+
+   END SUBROUTINE crs_iom_open
+
+
+   SUBROUTINE crs_iom_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE crs_iom_open  ***
+      !!
+      !! ** Purpose : open an input file with NF90 on coarsened grid
+      !!---------------------------------------------------------------------
+      !! Arguments
+      INTEGER                , INTENT(inout)           ::   kiomid      ! nf90 identifier of the opened file
+      !! Local variable
+      CHARACTER(LEN=100)  ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      WRITE(numout,*) 'crs_iom_close. kiomid=', kiomid
+
+      CALL iom_close( kiomid )
+      WRITE(numout,*) 'crs_iom_close. after iom_open call kiomid=', kiomid
+
+      !    
+   END SUBROUTINE crs_iom_close
+
+
+   SUBROUTINE crs_iom_rstput( kt, kwrite, kiomid, cdvar, pv_r0d, pv_r1d, pv_r1d1, pv_r2d, pv_r3d, ktype )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  crs_iom_rp0d  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      ! Arguments
+      INTEGER          ,                                  INTENT(in) :: kt       ! ocean time-step
+      INTEGER          ,                                  INTENT(in) :: kwrite   ! writing time-step
+      INTEGER          ,                                  INTENT(in) :: kiomid   ! Identifier of the file 
+      CHARACTER(len=*) ,                                  INTENT(in) :: cdvar    ! variable name
+      REAL(wp), OPTIONAL,                                 INTENT(in) :: pv_r0d   ! written Od field
+      REAL(wp), OPTIONAL, DIMENSION(jpk),                 INTENT(in) :: pv_r1d   ! written 1d field
+      REAL(wp), OPTIONAL, DIMENSION(jpiglo_crs),          INTENT(in) :: pv_r1d1   ! written 1d field !cc
+      REAL(wp), OPTIONAL, DIMENSION(jpi_crs,jpj_crs) ,    INTENT(in) :: pv_r2d   ! written 2d field
+      REAL(wp), OPTIONAL, DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: pv_r3d   ! written 3d field
+      INTEGER,  OPTIONAL,                                 INTENT(in) :: ktype    ! variable type (default R8)
+
+      ! Local
+      INTEGER               :: ivid     ! variable id
+      INTEGER               :: itype    ! variable type
+
+      CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+
+      IF(     PRESENT(pv_r0d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r0d, ktype )
+      ELSEIF( PRESENT(pv_r1d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r1d, ktype )
+      ELSEIF( PRESENT(pv_r1d1)) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r1d1, ktype ) !cc
+      ELSEIF( PRESENT(pv_r2d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r2d, ktype )
+      ELSEIF( PRESENT(pv_r3d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r3d, ktype )
+      ENDIF
+
+      CALL dom_grid_glo   ! Return to parent grid domain
+ 
+   END SUBROUTINE crs_iom_rstput
+
+   SUBROUTINE crs_iom_put( cdvar , pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_put  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      ! Arguments
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+
+      ! Local
+      INTEGER               :: ivid     ! variable id
+      INTEGER               :: itype    ! variable type
+
+      CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+
+      ! variable definition
+      IF(     PRESENT(pv_r0d) ) THEN   ;  CALL iom_put( cdvar, pv_r0d )
+      ELSEIF( PRESENT(pv_r1d) ) THEN   ;  CALL iom_put( cdvar, pv_r1d )
+      ELSEIF( PRESENT(pv_r2d) ) THEN   ;  CALL iom_put( cdvar, pv_r2d )
+      ELSEIF( PRESENT(pv_r3d) ) THEN   ;  CALL iom_put( cdvar, pv_r3d )
+      ENDIF
+      CALL dom_grid_glo   ! Return to parent grid domain
+
+   END SUBROUTINE crs_iom_put
+
+END MODULE crsiom
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crslbclnk.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crslbclnk.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/crslbclnk.F90	(revision 4056)
@@ -0,0 +1,139 @@
+MODULE crslbclnk
+
+   !!======================================================================
+   !!                       ***  MODULE  crslbclnk  ***
+   !!               A temporary solution for lbclnk for coarsened grid.
+   !! Ocean        : lateral boundary conditions for grid coarsening
+   !!=====================================================================
+   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code
+
+   USE dom_oce
+   USE crs
+   USE lbclnk
+   USE par_kind, ONLY: wp
+   USE in_out_manager
+
+   
+   
+   INTERFACE crs_lbc_lnk
+      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d
+   END INTERFACE
+   
+   PUBLIC crs_lbc_lnk
+   
+CONTAINS
+
+   SUBROUTINE crs_lbc_lnk_3d( pt3d1, cd_type1, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  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.
+      !!----------------------------------------------------------------------
+      !! Arguments
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type
+      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1 ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      
+      !! local vairables
+      LOGICAL                                                   ::   ll_grid_crs
+      REAL(wp)                                                  ::   zval     ! valeur sur les halo
+
+      !!----------------------------------------------------------------------
+      
+      ll_grid_crs = ( jpi == jpi_crs )
+      
+      IF( PRESENT(pval) ) THEN  ;  zval = pval
+      ELSE                      ;  zval = 0.0
+      ENDIF
+      
+      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( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
+      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  )
+      ENDIF
+
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+
+   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.
+      !!----------------------------------------------------------------------
+      !! Arguments
+      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
+      
+      !! local vairables
+      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
+
+   
+   
+   SUBROUTINE crs_lbc_lnk_2d(pt2d, cd_type, psgn, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      !!                  ***  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.
+      !!----------------------------------------------------------------------
+      !! Arguments
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type  ! grid type
+      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs),     INTENT(inout)   ::   pt2d     ! 2D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp   ! MPP only (here do nothing)
+      !! local variables
+      
+      LOGICAL                                                   ::   ll_grid_crs
+      REAL(wp)                                                  ::   zval     ! valeur sur les halo
+
+      !!----------------------------------------------------------------------
+      
+      ll_grid_crs = ( jpi == jpi_crs )
+      
+      IF( PRESENT(pval) ) THEN  ;  zval = pval
+      ELSE                      ;  zval = 0.0
+      ENDIF
+      
+      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  )
+      ENDIF
+
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+
+   END SUBROUTINE crs_lbc_lnk_2d
+
+
+END MODULE crslbclnk
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/dom_oce.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/dom_oce.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/dom_oce.F90	(revision 4056)
@@ -0,0 +1,323 @@
+MODULE dom_oce
+   !!======================================================================
+   !!                       ***  MODULE dom_oce  ***
+   !!       
+   !! ** Purpose :   Define in memory all the ocean space domain variables
+   !!======================================================================
+   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!                 ! 2012-06  (J. Simeon) Add ln_crs to dom_nam
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   Agrif_Root    : dummy function used when lk_agrif=F
+   !!   Agrif_CFixed  : dummy function used when lk_agrif=F
+   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   dom_oce_alloc   ! Called from nemogcm.F90
+   
+#if ! defined key_agrif
+   PUBLIC   Agrif_Root      ! Call in many modules
+   PUBLIC   Agrif_CFixed    !   -      -     -
+#endif
+   
+
+   !!----------------------------------------------------------------------
+   !! time & space domain namelist
+   !! ----------------------------
+   !                                              !!* Namelist namdom : time & space domain *
+   INTEGER , PUBLIC ::   nn_bathy     =    0       !: = 0/1 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   rn_hmin      =   -3.0_wp  !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
+   REAL(wp), PUBLIC ::   rn_e3zps_min =    5.0_wp  !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   rn_e3zps_rat =    0.1_wp  !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nn_msh       =    0       !: = 1 create a mesh-mask file
+   INTEGER , PUBLIC ::   nn_acc       =    0       !: = 0/1 use of the acceleration of convergence technique
+   REAL(wp), PUBLIC ::   rn_atfp      =    0.1_wp  !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rn_rdt       = 3600._wp   !: time step for the dynamics (and tracer if nacc=0)
+   REAL(wp), PUBLIC ::   rn_rdtmin    = 3600._wp   !: minimum time step on tracers
+   REAL(wp), PUBLIC ::   rn_rdtmax    = 3600._wp   !: maximum time step on tracers
+   REAL(wp), PUBLIC ::   rn_rdth      =  800._wp   !: depth variation of tracer step
+   INTEGER , PUBLIC ::   nn_baro      =   64       !: number of barotropic time steps (key_dynspg_ts)
+   INTEGER , PUBLIC ::   nn_closea    =    0       !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+   LOGICAL , PUBLIC ::   ln_crs       = .FALSE.    !: Apply grid coarsening to dynamical model output or online passive tracers
+   INTEGER , PUBLIC ::   nn_crs_kz    =    0
+
+   !                                    !! old non-DOCTOR names still used in the model
+   INTEGER , PUBLIC ::   ntopo           !: = 0/1 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   e3zps_min       !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file
+   INTEGER , PUBLIC ::   nacc            !: = 0/1 use of the acceleration of convergence technique
+   REAL(wp), PUBLIC ::   atfp            !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics (and tracer if nacc=0)
+   REAL(wp), PUBLIC ::   rdtmin          !: minimum time step on tracers
+   REAL(wp), PUBLIC ::   rdtmax          !: maximum time step on tracers
+   REAL(wp), PUBLIC ::   rdth            !: depth variation of tracer step
+   INTEGER , PUBLIC ::   nclosea         !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+
+   !                                                  !!! associated variables
+   INTEGER , PUBLIC                 ::   neuler  = 0   !: restart euler forward option (0=Euler)
+   REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttra  !: vertical profile of tracer time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dtra  !: = 2*rdttra except at nit000 (=rdttra) if neuler=0
+
+   !                                         !!* Namelist namcla : cross land advection
+   INTEGER, PUBLIC ::   nn_cla = 0            !: =1 cross land advection for exchanges through some straits (ORCA2)
+
+   !!----------------------------------------------------------------------
+   !! space domain parameters
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   lzoom      =  .FALSE.   !: zoom flag
+   LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.   !: East  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.   !: West  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.   !: South zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.   !: North zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_arct =  .FALSE.   !: ORCA    arctic zoom flag
+   LOGICAL, PUBLIC ::   lzoom_anta =  .FALSE.   !: ORCA antarctic zoom flag
+
+   !                                     !!! domain parameters linked to mpp
+   INTEGER, PUBLIC ::   nperio            !: type of lateral boundary condition
+   INTEGER, PUBLIC ::   nimpp, njmpp      !: i- & j-indexes for mpp-subdomain left bottom
+   INTEGER, PUBLIC ::   nreci, nrecj      !: overlap region in i and j
+   INTEGER, PUBLIC ::   nproc             !: number for local processor
+   INTEGER, PUBLIC ::   narea             !: number for local area
+   INTEGER, PUBLIC ::   nbondi, nbondj    !: mark of i- and j-direction local boundaries
+   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
+   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
+   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
+   INTEGER, PUBLIC ::   npne, npnw        !: index of north east and north west processor
+   INTEGER, PUBLIC ::   npse, npsw        !: index of south east and south west processor
+   INTEGER, PUBLIC ::   nbne, nbnw        !: logical of north east & north west processor
+   INTEGER, PUBLIC ::   nbse, nbsw        !: logical of south east & south west processor
+   INTEGER, PUBLIC ::   nidom             !: ???
+
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index
+   INTEGER, PUBLIC,               DIMENSION(jpidta) ::   mi0, mi1   !: global ==> local  domain i-index    !!bug ==> other solution?
+   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
+   INTEGER, PUBLIC,               DIMENSION(jpjdta) ::   mj0, mj1   !: global ==> local  domain j-index     !!bug ==> other solution?
+   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamt, glamu   !: longitude of t-, u-, v- and f-points (degre)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamv, glamf   !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1)
+
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   !                                           !!* Namelist namzgr : vertical coordinate *
+   LOGICAL, PUBLIC ::   ln_zco     =  .TRUE.    !: z-coordinate - full step
+   LOGICAL, PUBLIC ::   ln_zps     =  .FALSE.   !: z-coordinate - partial step
+   LOGICAL, PUBLIC ::   ln_sco     =  .FALSE.   !: s-coordinate or hybrid z-s coordinate
+
+   !! All coordinates
+   !! ---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w          !: depth of T-points (sum of e3w) (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept , gdepw   !: analytical depth at T-W  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v   , e3f     !: analytical vertical scale factors at  V--F
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t   , e3u     !:                                       T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw            !: analytical vertical scale factors at  VW--
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w   , e3uw    !:                                        W--UW  points (m)
+#if defined key_vvl
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag
+
+   !! All coordinates
+   !! ---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_1           !: depth of T-points (sum of e3w) (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_1, gdepw_1   !: analytical depth at T-W  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_1  , e3f_1     !: analytical vertical scale factors at  V--F
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_1  , e3u_1     !:                                       T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_1             !: analytical vertical scale factors at  VW--
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_1  , e3uw_1    !:                                       W--UW  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_b              !: before         -      -      -    -   T      points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_b  , e3v_b     !:   -            -      -      -    -   U--V   points (m)
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag
+#endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu   , hv     !: depth at u- and v-points (meters)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters)
+
+   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
+   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
+
+   !! z-coordinate with full steps (also used in the other cases as reference z-coordinate)
+   !! =-----------------====------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: e3t_0  , e3w_0   !: reference vertical scale factors at T- and W-pts (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp   , e3wp    !: ocean bottom level thickness at T and W points
+
+   !! s-coordinate and hybrid z-s-coordinate
+   !! =----------------======---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsi3w          !: model level depth coefficient at w-level (sum of gsigw)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   esigt, esigw   !: vertical scale factor coef. at t-, w-levels
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf    !: ocean depth at the vertical of  V--F
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu    !:                                 T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot   !: ocean surface and bottom topographies 
+   !                                        !  (if deviating from coordinate surfaces in HYBRID)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff     !: interface depth between stretching at  V--F
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu     !: and quasi-uniform spacing              T--U  points (m)
+
+   !!----------------------------------------------------------------------
+   !! masks, bathymetry
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy       !: number of ocean level (=0, 1, ... , jpk-1)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt         !: vertical index of the bottom last T- ocean level
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv   !: vertical index of the bottom last U- and W- ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy        !: ocean depth (meters)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i      !: interior domain T-point mask
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask        !: land/ocean mask of barotropic stream function
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+
+   REAL(wp), PUBLIC, DIMENSION(jpidta) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+
+#if defined key_noslip_accurate
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: npcoa        !: ???
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nicoa, njcoa !: ???
+#endif
+
+   !!----------------------------------------------------------------------
+   !! calendar variables
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
+   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
+   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
+   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
+   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
+   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
+   !                                   !: (cumulative duration of previous runs that may have used different time-step size)
+   INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months
+   INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
+
+   !!----------------------------------------------------------------------
+   !! mpp reproducibility
+   !!----------------------------------------------------------------------
+#if defined key_mpp_rep
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .FALSE.   !: agrif flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! agrif domain
+   !!----------------------------------------------------------------------
+#if defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: dom_oce.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NOT 'key_agrif'      dummy function                     No AGRIF zoom
+   !!----------------------------------------------------------------------
+   LOGICAL FUNCTION Agrif_Root()
+      Agrif_Root = .TRUE.
+   END FUNCTION Agrif_Root
+
+   CHARACTER(len=3) FUNCTION Agrif_CFixed()
+      Agrif_CFixed = '0' 
+   END FUNCTION Agrif_CFixed
+#endif
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(11) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     &
+         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     &
+         &                                      nleit(jpnij) , nlejt(jpnij) , STAT=ierr(2) )
+         !
+      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) ,                      & 
+         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) ,                      &  
+         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) ,     &  
+         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )     
+         !
+      ALLOCATE( gdep3w(jpi,jpj,jpk) , e3v(jpi,jpj,jpk) , e3f (jpi,jpj,jpk) ,                         &
+         &      gdept (jpi,jpj,jpk) , e3t(jpi,jpj,jpk) , e3u (jpi,jpj,jpk) ,                         &
+         &      gdepw (jpi,jpj,jpk) , e3w(jpi,jpj,jpk) , e3vw(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+#if defined key_vvl
+      ALLOCATE( gdep3w_1(jpi,jpj,jpk) , e3v_1(jpi,jpj,jpk) , e3f_1 (jpi,jpj,jpk) ,                           &
+         &      gdept_1 (jpi,jpj,jpk) , e3t_1(jpi,jpj,jpk) , e3u_1 (jpi,jpj,jpk) ,                           &
+         &      gdepw_1 (jpi,jpj,jpk) , e3w_1(jpi,jpj,jpk) , e3vw_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk) ,     &
+         &      e3t_b   (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk)                       , STAT=ierr(5) )
+#endif
+         !
+      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) ,     &
+         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) )
+         !
+      ALLOCATE( gdept_0(jpk) , gdepw_0(jpk) ,                                     &
+         &      e3t_0  (jpk) , e3w_0  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     &
+         &      gsigt  (jpk) , gsigw  (jpk) , gsi3w(jpk)    ,                     &
+         &      esigt  (jpk) , esigw  (jpk)                                 , STAT=ierr(7) )
+         !
+      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
+         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
+         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
+         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(8) )
+
+      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                     &
+         &     tmask_i(jpi,jpj) , bmask(jpi,jpj) ,                     &
+         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) )
+
+      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     & 
+         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(10) )
+
+#if defined key_noslip_accurate
+      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) )
+#endif
+      !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+
+   !!======================================================================
+END MODULE dom_oce
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domain.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domain.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domain.F90	(revision 4056)
@@ -0,0 +1,328 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!                 !  1992-01  (M. Imbard) insert time step initialization
+   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 !  1997-02  (G. Madec) creation of domwri.F
+   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!                 !  2012-06  (J. Simeon) Add crs logical to dom_nam
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean variables
+   USE dom_oce         ! domain: ocean
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE phycst          ! physical constants
+   USE closea          ! closed seas
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+
+   USE domhgr          ! domain: set the horizontal mesh
+   USE domzgr          ! domain: set the vertical mesh
+   USE domstp          ! domain: set the time-step
+   USE dommsk          ! domain: set the mask system
+   USE domwri          ! domain: write the meshmask file
+   USE domvvl          ! variable volume
+   USE c1d             ! 1D vertical configuration
+   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init   ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!-------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: domain.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
+   !!-------------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!              required to create the arrays which define the space 
+      !!              and time domain of the ocean model.
+      !!
+      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
+      !!              - dom_hgr: compute or read the horizontal grid-point position
+      !!                         and scale factors, and the coriolis factor
+      !!              - dom_zgr: define the vertical coordinate and the bathymetry
+      !!              - dom_stp: defined the model time step
+      !!              - dom_wri: create the meshmask file if nmsh=1
+      !!              - 1D configuration, move Coriolis, u and v at T-point
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk                ! dummy loop argument
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
+                             CALL dom_clo      ! Closed seas and lake
+                             CALL dom_hgr      ! Horizontal mesh
+                             CALL dom_zgr      ! Vertical mesh and bathymetry
+                             CALL dom_msk      ! Masks
+      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
+      !
+      IF( lk_c1d ) THEN                        ! 1D configuration 
+         CALL cor_c1d                          ! Coriolis set at T-point
+         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
+         vmask(:,:,:) = tmask(:,:,:)
+      END IF
+      !
+      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
+      hv(:,:) = 0.e0
+      DO jk = 1, jpk
+         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
+         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !                                        ! Inverse of the local depth
+      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
+      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
+
+                             CALL dom_stp      ! time step
+      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
+      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_init')
+      !
+   END SUBROUTINE dom_init
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namcla namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
+         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
+         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
+      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
+         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
+         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, nn_crs_kz
+      NAMELIST/namcla/ nn_cla
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )              ! Namelist namrun : parameters of the run
+      READ  ( numnam, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
+         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
+         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
+         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+      ENDIF
+
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nwrite = nn_write
+
+
+      !                             ! control of output frequency
+      IF ( nstock == 0 .OR. nstock > nitend ) THEN
+         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nstock = nitend
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nwrite = nitend
+      ENDIF
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#if defined key_agrif
+      ENDIF
+#endif
+
+      REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam, namdom )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      min number of ocean level (<0)       '
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
+         WRITE(numout,*) '           = 0   no file created           '
+         WRITE(numout,*) '           = 1   mesh_mask                 '
+         WRITE(numout,*) '           = 2   mesh and mask             '
+         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
+         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
+         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
+         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
+         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
+         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
+         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
+         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
+         WRITE(numout,*) '      grid coarsening of dynamical output or tracers = ', ln_crs
+      ENDIF
+
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      nacc      = nn_acc
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+      rdtmin    = rn_rdtmin
+      rdtmax    = rn_rdtmin
+      rdth      = rn_rdth
+      nclosea   = nn_closea
+
+      REWIND( numnam )              ! Namelist cross land advection
+      READ  ( numnam, namcla )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namcla'
+         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
+      ENDIF
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
+      READ  ( numnam, namnc4 )
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!----------------------------------------------------------------------
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc   ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+      !
+      IF(lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+   !!======================================================================
+END MODULE domain
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domngb.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domngb.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domngb.F90	(revision 4056)
@@ -0,0 +1,87 @@
+MODULE domngb
+   !!======================================================================
+   !!                       ***  MODULE  domngb  ***
+   !! Grid search:  find the closest grid point from a given on/lat position
+   !!======================================================================
+   !! History : 3.2  !  2009-11  (S. Masson)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_ngb       : find the closest grid point from a given lon/lat position
+   !!----------------------------------------------------------------------
+!   USE dom_oce        ! ocean space and time domain
+   USE dom_oce, ONLY : njmpp, nimpp, nldi, gphif, glamf, gphiv, glamv, gphiu, glamu, umask, nlei, vmask, gphit, fmask, tmask, &
+                     & glamt, nldj, nlej
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! for mppsum
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_ngb   ! routine called in iom.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: domngb.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_ngb  ***
+      !!
+      !! ** Purpose :   find the closest grid point from a given lon/lat position
+      !!
+      !! ** Method  :   look for minimum distance in cylindrical projection 
+      !!                -> not good if located at too high latitude...
+      !!----------------------------------------------------------------------
+      !
+      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
+      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
+      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
+      !
+      INTEGER , DIMENSION(2) ::   iloc
+      REAL(wp)               ::   zlon, zmini
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
+      !
+      CALL wrk_alloc( jpi, jpj, zglam, zgphi, zmask, zdist )
+      !
+      zmask(:,:) = 0._wp
+      SELECT CASE( cdgrid )
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1)
+      END SELECT
+
+      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
+      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
+      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
+      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
+
+      zglam(:,:) = zglam(:,:) - zlon
+      zgphi(:,:) = zgphi(:,:) - plat
+      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
+      
+      IF( lk_mpp ) THEN  
+         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
+      ELSE
+         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
+         kii = iloc(1) + nimpp - 1
+         kjj = iloc(2) + njmpp - 1
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zglam, zgphi, zmask, zdist )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
+      !
+   END SUBROUTINE dom_ngb
+
+   !!======================================================================
+END MODULE domngb
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domzgr.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domzgr.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/domzgr.F90	(revision 4056)
@@ -0,0 +1,1635 @@
+MODULE domzgr
+   !!==============================================================================
+   !!                       ***  MODULE domzgr   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
+   !!                 ! 1997-07  (G. Madec)  lbc_lnk call
+   !!                 ! 1997-04  (J.-O. Beismann) 
+   !!            8.5  ! 2002-09  (A. Bozec, G. Madec)  F90: Free form and module
+   !!             -   ! 2002-09  (A. de Miranda)  rigid-lid + islands
+   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
+   !!            2.0  ! 2006-04  (R. Benshila, G. Madec)  add zgr_zco
+   !!            3.0  ! 2008-06  (G. Madec)  insertion of domzgr_zps.h90 & conding style
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_zgr          : defined the ocean vertical coordinate system
+   !!       zgr_bat      : bathymetry fields (levels and meters)
+   !!       zgr_bat_zoom : modify the bathymetry field if zoom domain
+   !!       zgr_bat_ctl  : check the bathymetry files
+   !!       zgr_bot_level: deepest ocean level for t-, u, and v-points
+   !!       zgr_z        : reference z-coordinate 
+   !!       zgr_zco      : z-coordinate 
+   !!       zgr_zps      : z-coordinate with partial steps
+   !!       zgr_sco      : s-coordinate
+   !!       fssig        : sigma coordinate non-dimensional function
+   !!       dfssig       : derivative of the sigma coordinate function    !!gm  (currently missing!)
+   !!---------------------------------------------------------------------
+   USE oce               ! ocean variables
+   USE dom_oce           ! ocean domain
+   USE closea            ! closed seas
+   USE c1d               ! 1D vertical configuration
+   USE in_out_manager    ! I/O manager
+   USE iom               ! I/O library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_zgr        ! called by dom_init.F90
+
+   !                                       !!* Namelist namzgr_sco *
+   REAL(wp) ::   rn_sbot_min =  300._wp     ! minimum depth of s-bottom surface (>0) (m)
+   REAL(wp) ::   rn_sbot_max = 5250._wp     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   REAL(wp) ::   rn_theta    =    6.00_wp   ! surface control parameter (0<=rn_theta<=20)
+   REAL(wp) ::   rn_thetb    =    0.75_wp   ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_rmax     =    0.15_wp   ! maximum cut-off r-value allowed (0<rn_rmax<1)
+   LOGICAL  ::   ln_s_sigma  = .false.      ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T)
+   REAL(wp) ::   rn_bb       =    0.80_wp   ! stretching parameter for song and haidvogel stretching
+   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates
+
+  !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011)
+   !! $Id: domzgr.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS       
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :  set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate   
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio = 0   ! temporary integer
+      !
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_zgr')
+      !
+      REWIND( numnam )                 ! Read Namelist namzgr : vertical coordinate'
+      READ  ( numnam, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
+         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
+         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
+      ENDIF
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      IF( ln_zco ) ioptio = ioptio + 1
+      IF( ln_zps ) ioptio = ioptio + 1
+      IF( ln_sco ) ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+                          CALL zgr_z            ! Reference z-coordinate system (always called)
+                          CALL zgr_bat          ! Bathymetry fields (levels and meters)
+      IF( ln_zco      )   CALL zgr_zco          ! z-coordinate
+      IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate
+      IF( ln_sco      )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate
+      !
+      ! final adjustment of mbathy & check 
+      ! -----------------------------------
+      IF( lzoom       )   CALL zgr_bat_zoom     ! correct mbathy in case of zoom subdomain
+      IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isoated ocean points
+                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points
+      !
+      !
+
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ),   &
+            &                   ' w ',   MINVAL( fsdepw(:,:,:) ), '3w ', MINVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( fse3t(:,:,:) ), ' f ', MINVAL( fse3f(:,:,:) ),  &
+            &                   ' u ',   MINVAL( fse3u(:,:,:) ), ' u ', MINVAL( fse3v(:,:,:) ),  &
+            &                   ' uw',   MINVAL( fse3uw(:,:,:)), ' vw', MINVAL( fse3vw(:,:,:)),   &
+            &                   ' w ',   MINVAL( fse3w(:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ),   &
+            &                   ' w ',   MAXVAL( fsdepw(:,:,:) ), '3w ', MAXVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( fse3t(:,:,:) ), ' f ', MAXVAL( fse3f(:,:,:) ),  &
+            &                   ' u ',   MAXVAL( fse3u(:,:,:) ), ' u ', MAXVAL( fse3v(:,:,:) ),  &
+            &                   ' uw',   MAXVAL( fse3uw(:,:,:)), ' vw', MAXVAL( fse3vw(:,:,:)),   &
+            &                   ' w ',   MAXVAL( fse3w(:,:,:) )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_zgr')
+      !
+   END SUBROUTINE dom_zgr
+
+
+   SUBROUTINE zgr_z
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   z-coordinate system (use in all type of coordinate)
+      !!        The depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the scale factors.
+      !!        both depth and scale factors only depend on k (1d arrays).
+      !!              w-level: gdepw_0  = fsdep(k)
+      !!                       e3w_0(k) = dk(fsdep)(k)     = fse3(k)
+      !!              t-level: gdept_0  = fsdep(k+0.5)
+      !!                       e3t_0(k) = dk(fsdep)(k+0.5) = fse3(k+0.5)
+      !!
+      !! ** Action  : - gdept_0, gdepw_0 : depth of T- and W-point (m)
+      !!              - e3t_0  , e3w_0   : scale factors at T- and W-levels (m)
+      !!
+      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                     ! dummy loop indices
+      REAL(wp) ::   zt, zw                 ! temporary scalars
+      REAL(wp) ::   zsur, za0, za1, zkth   ! Values set from parameters in
+      REAL(wp) ::   zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90
+      REAL(wp) ::   zrefdep                ! depth of the reference level (~10m)
+      REAL(wp) ::   za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_z')
+      !
+      ! Set variables from parameters
+      ! ------------------------------
+       zkth = ppkth       ;   zacr = ppacr
+       zdzmin = ppdzmin   ;   zhmax = pphmax
+       zkth2 = ppkth2     ;   zacr2 = ppacr2   ! optional (ldbletanh=T) double tanh parameters
+
+      ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      IF(   ppa1  == pp_to_be_computed  .AND.  &
+         &  ppa0  == pp_to_be_computed  .AND.  &
+         &  ppsur == pp_to_be_computed           ) THEN
+         !
+         za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      &
+            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
+            &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+         za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr )
+         zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+      ELSE
+         za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur
+         za2 = ppa2                            ! optional (ldbletanh=T) double tanh parameter
+      ENDIF
+
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates'
+         WRITE(numout,*) '    ~~~~~~~'
+         IF(  ppkth == 0._wp ) THEN              
+              WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers'
+              WRITE(numout,*) '            Total depth    :', zhmax
+              WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1)
+         ELSE
+            IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
+               WRITE(numout,*) '         zsur, za0, za1 computed from '
+               WRITE(numout,*) '                 zdzmin = ', zdzmin
+               WRITE(numout,*) '                 zhmax  = ', zhmax
+            ENDIF
+            WRITE(numout,*) '           Value of coefficients for vertical mesh:'
+            WRITE(numout,*) '                 zsur = ', zsur
+            WRITE(numout,*) '                 za0  = ', za0
+            WRITE(numout,*) '                 za1  = ', za1
+            WRITE(numout,*) '                 zkth = ', zkth
+            WRITE(numout,*) '                 zacr = ', zacr
+            IF( ldbletanh ) THEN
+               WRITE(numout,*) ' (Double tanh    za2  = ', za2
+               WRITE(numout,*) '  parameters)    zkth2= ', zkth2
+               WRITE(numout,*) '                 zacr2= ', zacr2
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid       
+         za1 = zhmax / FLOAT(jpk-1) 
+         DO jk = 1, jpk
+            zw = FLOAT( jk )
+            zt = FLOAT( jk ) + 0.5_wp
+            gdepw_0(jk) = ( zw - 1 ) * za1
+            gdept_0(jk) = ( zt - 1 ) * za1
+            e3w_0  (jk) =  za1
+            e3t_0  (jk) =  za1
+         END DO
+      ELSE                                ! Madec & Imbard 1996 function
+         IF( .NOT. ldbletanh ) THEN
+            DO jk = 1, jpk
+               zw = REAL( jk , wp )
+               zt = REAL( jk , wp ) + 0.5_wp
+               gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               e3w_0  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               e3t_0  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+            END DO
+         ELSE
+            DO jk = 1, jpk
+               zw = FLOAT( jk )
+               zt = FLOAT( jk ) + 0.5_wp
+               ! Double tanh function
+               gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               e3w_0  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )    &
+                  &                            + za2        * TANH(       (zw-zkth2) / zacr2 )
+               e3t_0  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )    &
+                  &                            + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         gdepw_0(1) = 0._wp                    ! force first w-level to be exactly at zero
+      ENDIF
+
+!!gm BUG in s-coordinate this does not work!
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_0 )                    ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
+      ENDIF
+      DO jk = 1, jpk                      ! control positivity
+         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w or e3t =< 0 '    )
+         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw or gdept < 0 ' )
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_z')
+      !
+   END SUBROUTINE zgr_z
+
+
+   SUBROUTINE zgr_bat
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat  ***
+      !! 
+      !! ** Purpose :   set bathymetry both in levels and meters
+      !!
+      !! ** Method  :   read or define mbathy and bathy arrays
+      !!       * level bathymetry:
+      !!      The ocean basin geometry is given by a two-dimensional array,
+      !!      mbathy, which is defined as follow :
+      !!            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
+      !!                              at t-point (ji,jj).
+      !!                            = 0  over the continental t-point.
+      !!      The array mbathy is checked to verified its consistency with
+      !!      model option. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      ntopo=-1 :   rectangular channel or bassin with a bump 
+      !!      ntopo= 0 :   flat rectangular channel or basin 
+      !!      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file
+      !!                   bathy  is read in 'bathy_meter.nc' NetCDF file
+      !!
+      !! ** Action  : - mbathy: level bathymetry (in level index)
+      !!              - bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jk            ! dummy loop indices
+      INTEGER  ::   inum                      ! temporary logical unit
+      INTEGER  ::   ii_bump, ij_bump, ih      ! bump center position
+      INTEGER  ::   ii0, ii1, ij0, ij1, ik    ! local indices
+      REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics 
+      REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars
+      INTEGER , POINTER, DIMENSION(:,:) ::   idta   ! global domain integer data
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdta   ! global domain scalar data
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_bat')
+      !
+      CALL wrk_alloc( jpidta, jpjdta, idta )
+      CALL wrk_alloc( jpidta, jpjdta, zdta )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~'
+
+      !                                               ! ================== ! 
+      IF( ntopo == 0 .OR. ntopo == -1 ) THEN          !   defined by hand  !
+         !                                            ! ================== !
+         !                                            ! global domain level and meter bathymetry (idta,zdta)
+         !
+         IF( ntopo == 0 ) THEN                        ! flat basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin'
+            idta(:,:) = jpkm1                            ! before last level
+            zdta(:,:) = gdepw_0(jpk)                     ! last w-point depth
+            h_oce     = gdepw_0(jpk)
+         ELSE                                         ! bump centered in the basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin with a bump'
+            ii_bump = jpidta / 2                           ! i-index of the bump center
+            ij_bump = jpjdta / 2                           ! j-index of the bump center
+            r_bump  = 50000._wp                            ! bump radius (meters)       
+            h_bump  =  2700._wp                            ! bump height (meters)
+            h_oce   = gdepw_0(jpk)                         ! background ocean depth (meters)
+            IF(lwp) WRITE(numout,*) '            bump characteristics: '
+            IF(lwp) WRITE(numout,*) '               bump center (i,j)   = ', ii_bump, ii_bump
+            IF(lwp) WRITE(numout,*) '               bump height         = ', h_bump , ' meters'
+            IF(lwp) WRITE(numout,*) '               bump radius         = ', r_bump , ' index'
+            IF(lwp) WRITE(numout,*) '            background ocean depth = ', h_oce  , ' meters'
+            !                                        
+            DO jj = 1, jpjdta                              ! zdta :
+               DO ji = 1, jpidta
+                  zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump
+                  zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump
+                  zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) )
+               END DO
+            END DO
+            !                                              ! idta :
+            IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk
+               idta(:,:) = jpkm1
+            ELSE                                                ! z-coordinate (zco or zps): step-like topography
+               idta(:,:) = jpkm1
+               DO jk = 1, jpkm1
+                  WHERE( gdept_0(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_0(jk+1) )   idta(:,:) = jk
+               END DO
+            ENDIF
+         ENDIF
+         !                                            ! set GLOBAL boundary conditions 
+         !                                            ! Caution : idta on the global domain: use of jperio, not nperio
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1._wp
+            idta( :    ,jpjdta) =  0                ;      zdta( :    ,jpjdta) =  0._wp
+         ELSEIF( jperio == 2 ) THEN
+            idta( :    , 1    ) = idta( : ,  3  )   ;      zdta( :    , 1    ) = zdta( : ,  3  )
+            idta( :    ,jpjdta) = 0                 ;      zdta( :    ,jpjdta) =  0._wp
+            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp
+            idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0._wp
+         ELSE
+            ih = 0                                  ;      zh = 0._wp
+            IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce
+            idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh
+            idta( :    ,jpjdta) = ih                ;      zdta( :    ,jpjdta) =  zh
+            idta( 1    , :    ) = ih                ;      zdta( 1    , :    ) =  zh
+            idta(jpidta, :    ) = ih                ;      zdta(jpidta, :    ) =  zh
+         ENDIF
+
+         !                                            ! local domain level and meter bathymetries (mbathy,bathy)
+         mbathy(:,:) = 0                                   ! set to zero extra halo points
+         bathy (:,:) = 0._wp                               ! (require for mpp case)
+         DO jj = 1, nlcj                                   ! interior values
+            DO ji = 1, nlci
+               mbathy(ji,jj) = idta( mig(ji), mjg(jj) )
+               bathy (ji,jj) = zdta( mig(ji), mjg(jj) )
+            END DO
+         END DO
+         !
+         !                                            ! ================ !
+      ELSEIF( ntopo == 1 ) THEN                       !   read in file   ! (over the local domain)
+         !                                            ! ================ !
+         !
+         IF( ln_zco )   THEN                          ! zco : read level bathymetry 
+            CALL iom_open ( 'bathy_level.nc', inum )  
+            CALL iom_get  ( inum, jpdom_data, 'Bathy_level', bathy )
+            CALL iom_close( inum )
+            mbathy(:,:) = INT( bathy(:,:) )
+            !                                                ! =====================
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !                                             ! =====================
+               IF( nn_cla == 0 ) THEN
+                  ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+                  ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     DO jj = mj0(ij0), mj1(ij1)
+                        mbathy(ji,jj) = 15
+                     END DO
+                  END DO
+                  IF(lwp) WRITE(numout,*)
+                  IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+                  !
+                  ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+                  ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     DO jj = mj0(ij0), mj1(ij1)
+                        mbathy(ji,jj) = 12
+                     END DO
+                  END DO
+                  IF(lwp) WRITE(numout,*)
+                  IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+                 !!cc modif min 300m
+    !             IF(lwp) WRITE(numout,*) '             orca_r2: caution bathy min = 300m'
+    !          DO jj = 1, jpj
+    !             DO ji = 1, jpi
+    !                IF( mbathy(ji,jj) > 0 ) THEN
+    !                   mbathy(ji,jj) = MAX( mbathy(ji,jj), 18 ) 
+    !                ENDIF
+    !             END DO
+    !          END DO 
+              !!cc modif min 300m                  
+               ENDIF
+               !
+            ENDIF
+            !
+         ENDIF
+         IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry
+            CALL iom_open ( 'bathy_meter.nc', inum ) 
+            CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy )
+            CALL iom_close( inum )
+            !                                                ! =====================
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !                                             ! =====================
+              IF( nn_cla == 0 ) THEN
+                 ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+                 ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+                 DO ji = mi0(ii0), mi1(ii1)
+                    DO jj = mj0(ij0), mj1(ij1)
+                       bathy(ji,jj) = 284._wp
+                    END DO
+                 END DO
+                 IF(lwp) WRITE(numout,*)
+                 IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+                 !
+                 ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+                 ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+                 DO ji = mi0(ii0), mi1(ii1)
+                    DO jj = mj0(ij0), mj1(ij1)
+                       bathy(ji,jj) = 137._wp
+                    END DO
+                 END DO
+                 IF(lwp) WRITE(numout,*)
+                 IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+                 !!cc modif min 300m
+!                 IF(lwp) WRITE(numout,*) '             orca_r2: caution bathy min = 300m'
+!              DO jj = 1, jpj
+!                 DO ji = 1, jpi
+!                    IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( bathy(ji,jj), 300._wp ) 
+!                 END DO
+!              END DO 
+              !!cc modif min 300m
+              ENDIF
+              
+
+              !
+           ENDIF
+            !
+        ENDIF
+         !                                            ! =============== !
+      ELSE                                            !      error      !
+         !                                            ! =============== !
+         WRITE(ctmp1,*) 'parameter , ntopo = ', ntopo
+         CALL ctl_stop( '    zgr_bat : '//trim(ctmp1) )
+      ENDIF
+      !
+      !                                               ! =========================== !
+      IF( nclosea == 0 ) THEN                         !   NO closed seas or lakes   !
+         DO jl = 1, jpncs                             ! =========================== !
+            DO jj = ncsj1(jl), ncsj2(jl)
+               DO ji = ncsi1(jl), ncsi2(jl)
+                  mbathy(ji,jj) = 0                   ! suppress closed seas and lakes from bathymetry
+                  bathy (ji,jj) = 0._wp               
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+      !                                               ! =========================== !
+      !                                               !     set a minimum depth     !
+      !                                               ! =========================== !
+      IF ( .not. ln_sco ) THEN
+         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level
+         ELSE                          ;   ik = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
+         ENDIF
+         zhmin = gdepw_0(ik+1)                                                         ! minimum depth = ik+1 w-levels 
+         WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands
+         ELSE WHERE                     ;   bathy(:,:) = MAX(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans
+         END WHERE
+         IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
+      ENDIF
+      !
+      CALL wrk_dealloc( jpidta, jpjdta, idta )
+      CALL wrk_dealloc( jpidta, jpjdta, zdta )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_bat')
+      !
+   END SUBROUTINE zgr_bat
+
+
+   SUBROUTINE zgr_bat_zoom
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_zoom  ***
+      !!
+      !! ** Purpose : - Close zoom domain boundary if necessary
+      !!              - Suppress Med Sea from ORCA R2 and R05 arctic zoom
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integers
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_zoom : modify the level bathymetry for zoom domain'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~'
+      !
+      ! Zoom domain
+      ! ===========
+      !
+      ! Forced closed boundary if required
+      IF( lzoom_s )   mbathy(  : , mj0(jpjzoom):mj1(jpjzoom) )      = 0
+      IF( lzoom_w )   mbathy(      mi0(jpizoom):mi1(jpizoom) , :  ) = 0
+      IF( lzoom_e )   mbathy(      mi0(jpiglo+jpizoom-1):mi1(jpiglo+jpizoom-1) , :  ) = 0
+      IF( lzoom_n )   mbathy(  : , mj0(jpjglo+jpjzoom-1):mj1(jpjglo+jpjzoom-1) )      = 0
+      !
+      ! Configuration specific domain modifications
+      ! (here, ORCA arctic configuration: suppress Med Sea)
+      IF( cp_cfg == "orca" .AND. lzoom_arct ) THEN
+         SELECT CASE ( jp_cfg )
+         !                                        ! =======================
+         CASE ( 2 )                               !  ORCA_R2 configuration
+            !                                     ! =======================
+            IF(lwp) WRITE(numout,*) '                   ORCA R2 arctic zoom: suppress the Med Sea'
+            ii0 = 141   ;   ii1 = 162      ! Sea box i,j indices
+            ij0 =  98   ;   ij1 = 110
+            !                                     ! =======================
+         CASE ( 05 )                              !  ORCA_R05 configuration
+            !                                     ! =======================
+            IF(lwp) WRITE(numout,*) '                   ORCA R05 arctic zoom: suppress the Med Sea'
+            ii0 = 563   ;   ii1 = 642      ! zero over the Med Sea boxe
+            ij0 = 314   ;   ij1 = 370 
+         END SELECT
+         !
+         mbathy( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0   ! zero over the Med Sea boxe
+         !
+      ENDIF
+      !
+   END SUBROUTINE zgr_bat_zoom
+
+
+   SUBROUTINE zgr_bat_ctl
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_ctl  ***
+      !!
+      !! ** Purpose :   check the bathymetry in levels
+      !!
+      !! ** Method  :   The array mbathy is checked to verified its consistency
+      !!      with the model options. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      C A U T I O N : mbathy will be modified during the initializa-
+      !!      tion phase to become the number of non-zero w-levels of a water
+      !!      column, with a minimum value of 1.
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!              - update bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER ::   ji, jj, jl                    ! dummy loop indices
+      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zbathy
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_bat_ctl')
+      !
+      CALL wrk_alloc( jpi, jpj, zbathy )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_ctl : check the bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+
+      !                                          ! Suppress isolated ocean grid points
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points'
+      IF(lwp) WRITE(numout,*)'                   -----------------------------------'
+      icompt = 0
+      DO jl = 1, 2
+         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN
+            mbathy( 1 ,:) = mbathy(jpim1,:)           ! local domain is cyclic east-west
+            mbathy(jpi,:) = mbathy(  2  ,:)
+         ENDIF
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtest = MAX(  mbathy(ji-1,jj), mbathy(ji+1,jj),   &
+                  &           mbathy(ji,jj-1), mbathy(ji,jj+1)  )
+               IF( ibtest < mbathy(ji,jj) ) THEN
+                  IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   &
+                     &   'grid-point (i,j) =  ',ji,jj,' is changed from ', mbathy(ji,jj),' to ', ibtest
+                  mbathy(ji,jj) = ibtest
+                  icompt = icompt + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+      IF( icompt == 0 ) THEN
+         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
+      ELSE
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed'
+      ENDIF
+      IF( lk_mpp ) THEN
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+      ENDIF
+
+      !                                          ! East-west cyclic boundary conditions
+      IF( nperio == 0 ) THEN
+         IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: nperio = ', nperio
+         IF( lk_mpp ) THEN
+            IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(1,:) = 0
+            ENDIF
+            IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(nlci,:) = 0
+            ENDIF
+         ELSE
+            IF( ln_zco .OR. ln_zps ) THEN
+               mbathy( 1 ,:) = 0
+               mbathy(jpi,:) = 0
+            ELSE
+               mbathy( 1 ,:) = jpkm1
+               mbathy(jpi,:) = jpkm1
+            ENDIF
+         ENDIF
+      ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio ==  6 ) THEN
+         IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: nperio = ', nperio
+         mbathy( 1 ,:) = mbathy(jpim1,:)
+         mbathy(jpi,:) = mbathy(  2  ,:)
+      ELSEIF( nperio == 2 ) THEN
+         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions on mbathy: nperio = ', nperio
+      ELSE
+         IF(lwp) WRITE(numout,*) '    e r r o r'
+         IF(lwp) WRITE(numout,*) '    parameter , nperio = ', nperio
+         !         STOP 'dom_mba'
+      ENDIF
+
+      !  Boundary condition on mbathy
+      IF( .NOT.lk_mpp ) THEN 
+!!gm     !!bug ???  think about it !
+         !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+      ENDIF
+
+      ! Number of ocean level inferior or equal to jpkm1
+      ikmax = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikmax = MAX( ikmax, mbathy(ji,jj) )
+         END DO
+      END DO
+!!gm  !!! test to do:   ikmax = MAX( mbathy(:,:) )   ???
+      IF( ikmax > jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+         IF(lwp) WRITE(numout,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+      ELSE IF( ikmax < jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+         IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1
+      ENDIF
+
+      IF( lwp .AND. nprint == 1 ) THEN      ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' bathymetric field :   number of non-zero T-levels '
+         WRITE(numout,*) ' ------------------'
+         CALL prihin( mbathy, jpi, jpj, 1, jpi, 1, 1, jpj, 1, 3, numout )
+         WRITE(numout,*)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zbathy )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_bat_ctl')
+      !
+   END SUBROUTINE zgr_bat_ctl
+
+
+   SUBROUTINE zgr_bot_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bot_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
+      !!
+      !! ** Method  :   computes from mbathy with a minimum value of 1 over land
+      !!
+      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1 over land)
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zmbk
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_bot_level')
+      !
+      CALL wrk_alloc( jpi, jpj, zmbk )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+      !                                     ! bottom k-index of W-level = mbkt+1
+      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpim1
+            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
+            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      !
+      CALL wrk_dealloc( jpi, jpj, zmbk )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_bot_level')
+      !
+   END SUBROUTINE zgr_bot_level
+
+
+   SUBROUTINE zgr_zco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zco  ***
+      !!
+      !! ** Purpose :   define the z-coordinate system
+      !!
+      !! ** Method  :   set 3D coord. arrays to reference 1D array 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_zco')
+      !
+      DO jk = 1, jpk
+            gdept(:,:,jk) = gdept_0(jk)
+            gdepw(:,:,jk) = gdepw_0(jk)
+            gdep3w(:,:,jk) = gdepw_0(jk)
+            e3t (:,:,jk) = e3t_0(jk)
+            e3u (:,:,jk) = e3t_0(jk)
+            e3v (:,:,jk) = e3t_0(jk)
+            e3f (:,:,jk) = e3t_0(jk)
+            e3w (:,:,jk) = e3w_0(jk)
+            e3uw(:,:,jk) = e3w_0(jk)
+            e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zco')
+      !
+   END SUBROUTINE zgr_zco
+
+
+   SUBROUTINE zgr_zps
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zps  ***
+      !!                     
+      !! ** Purpose :   the depth and vertical scale factor in partial step
+      !!      z-coordinate case
+      !!
+      !! ** Method  :   Partial steps : computes the 3D vertical scale factors
+      !!      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+      !!      a partial step representation of bottom topography.
+      !!
+      !!        The reference depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the reference vertical
+      !!      scale factors.
+      !!        From  depth and scale factors reference, we compute there new value
+      !!      with partial steps  on 3d arrays ( i, j, k ).
+      !!
+      !!              w-level: gdepw(i,j,k)  = fsdep(k)
+      !!                       e3w(i,j,k) = dk(fsdep)(k)     = fse3(i,j,k)
+      !!              t-level: gdept(i,j,k)  = fsdep(k+0.5)
+      !!                       e3t(i,j,k) = dk(fsdep)(k+0.5) = fse3(i,j,k+0.5)
+      !!
+      !!        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+      !!      we find the mbathy index of the depth at each grid point.
+      !!      This leads us to three cases:
+      !!
+      !!              - bathy = 0 => mbathy = 0
+      !!              - 1 < mbathy < jpkm1    
+      !!              - bathy > gdepw(jpk) => mbathy = jpkm1  
+      !!
+      !!        Then, for each case, we find the new depth at t- and w- levels
+      !!      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+      !!      and f-points.
+      !! 
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!         c a u t i o n : gdept_0, gdepw_0 and e3._0 are positives
+      !!         - - - - - - -   gdept, gdepw and e3. are positives
+      !!      
+      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      INTEGER  ::   ik, it           ! temporary integers
+      LOGICAL  ::   ll_print         ! Allow  control print for debugging
+      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zmax             ! Maximum depth
+      REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp) ::   zrefdep          ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_zps')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zprt )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
+      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
+
+      ll_print = .FALSE.                   ! Local variable for debugging
+      
+      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)'
+         CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
+      ENDIF
+
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      zmax = gdepw_0(jpk) + e3t_0(jpk)          ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_0(jpkm1) )
+      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0
+      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_0 (where
+      ! e3t_0 is the reference level thickness
+      DO jk = jpkm1, 1, -1
+         zdepth = gdepw_0(jk) + MIN( e3zps_min, e3t_0(jk)*e3zps_rat )
+         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
+      END DO
+
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
+         gdept(:,:,jk) = gdept_0(jk)
+         gdepw(:,:,jk) = gdepw_0(jk)
+         e3t  (:,:,jk) = e3t_0  (jk)
+         e3w  (:,:,jk) = e3w_0  (jk)
+      END DO
+      ! 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == jpkm1 ) THEN
+                  zdepwp = bathy(ji,jj)
+                  ze3tp  = bathy(ji,jj) - gdepw_0(ik)
+                  ze3wp = 0.5_wp * e3w_0(ik) * ( 1._wp + ( ze3tp/e3t_0(ik) ) )
+                  e3t(ji,jj,ik  ) = ze3tp
+                  e3t(ji,jj,ik+1) = ze3tp
+                  e3w(ji,jj,ik  ) = ze3wp
+                  e3w(ji,jj,ik+1) = ze3tp
+                  gdepw(ji,jj,ik+1) = zdepwp
+                  gdept(ji,jj,ik  ) = gdept_0(ik-1) + ze3wp
+                  gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( bathy(ji,jj) <= gdepw_0(ik+1) ) THEN   ;   gdepw(ji,jj,ik+1) = bathy(ji,jj)
+                  ELSE                                       ;   gdepw(ji,jj,ik+1) = gdepw_0(ik+1)
+                  ENDIF
+!gm Bug?  check the gdepw_0
+                  !       ... on ik
+                  gdept(ji,jj,ik) = gdepw_0(ik) + ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   &
+                     &                          * ((gdept_0(      ik  ) - gdepw_0(ik) )   &
+                     &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) ))
+                  e3t  (ji,jj,ik) = e3t_0  (ik) * ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   & 
+                     &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) ) 
+                  e3w  (ji,jj,ik) = 0.5_wp * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2._wp * gdepw_0(ik) )   &
+                     &                     * ( e3w_0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) )
+                  !       ... on ik+1
+                  e3w  (ji,jj,ik+1) = e3t  (ji,jj,ik)
+                  e3t  (ji,jj,ik+1) = e3t  (ji,jj,ik)
+                  gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               e3tp (ji,jj) = e3t(ji,jj,ik  )
+               e3wp (ji,jj) = e3w(ji,jj,ik  )
+               ! test
+               zdiff= gdepw(ji,jj,ik+1) - gdept(ji,jj,ik  )
+               IF( zdiff <= 0._wp .AND. lwp ) THEN 
+                  it = it + 1
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                  WRITE(numout,*) ' gdept = ', gdept(ji,jj,ik), ' gdepw = ', gdepw(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp  = ', e3t  (ji,jj,ik), ' e3wp  = ', e3w  (ji,jj,ik  )
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u (:,:,jk) = e3t_0(jk)
+         e3v (:,:,jk) = e3t_0(jk)
+         e3uw(:,:,jk) = e3w_0(jk)
+         e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )
+               e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )
+               e3uw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji+1,jj,jk) )
+               e3vw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( e3u , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( e3v , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw, 'V', 1._wp )
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u (:,:,jk) == 0._wp )   e3u (:,:,jk) = e3t_0(jk)
+         WHERE( e3v (:,:,jk) == 0._wp )   e3v (:,:,jk) = e3t_0(jk)
+         WHERE( e3uw(:,:,jk) == 0._wp )   e3uw(:,:,jk) = e3w_0(jk)
+         WHERE( e3vw(:,:,jk) == 0._wp )   e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f(:,:,jk) = e3t_0(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3f(ji,jj,jk) = MIN( e3v(ji,jj,jk), e3v(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( e3f, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f(:,:,jk) == 0._wp )   e3f(:,:,jk) = e3t_0(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t(:,mj0(1),:) = e3t(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w(:,mj0(1),:) = e3w(:,mj0(2),:) 
+      e3u(:,mj0(1),:) = e3u(:,mj0(2),:) 
+      e3v(:,mj0(1),:) = e3v(:,mj0(2),:) 
+      e3f(:,mj0(1),:) = e3f(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t   <= 0' )
+      IF( MINVAL( e3w  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w   <= 0' )
+      IF( MINVAL( gdept(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
+      IF( MINVAL( gdepw(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
+     
+      ! Compute gdep3w (vertical sum of e3w)
+      gdep3w(:,:,1) = 0.5_wp * e3w(:,:,1)
+      DO jk = 2, jpk
+         gdep3w(:,:,jk) = gdep3w(:,:,jk-1) + e3w(:,:,jk) 
+      END DO
+        
+      !                                               ! ================= !
+      IF(lwp .AND. ll_print) THEN                     !   Control print   !
+         !                                            ! ================= !
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX( mbathy(ji,jj), 1 )
+               zprt(ji,jj,1) = e3t   (ji,jj,ik)
+               zprt(ji,jj,2) = e3w   (ji,jj,ik)
+               zprt(ji,jj,3) = e3u   (ji,jj,ik)
+               zprt(ji,jj,4) = e3v   (ji,jj,ik)
+               zprt(ji,jj,5) = e3f   (ji,jj,ik)
+               zprt(ji,jj,6) = gdep3w(ji,jj,ik)
+            END DO
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF  
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zprt )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps')
+      !
+   END SUBROUTINE zgr_zps
+
+
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!       
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!          
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              &
+         & / ( 2._wp * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+
+
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  )  &
+            &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+
+
+   SUBROUTINE zgr_sco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_sco  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute gsigt, gsigw, esigt, esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            gsigt(k) = fssig (k    )
+      !!            gsigw(k) = fssig (k-0.5)
+      !!            esigt(k) = fsdsig(k    )
+      !!            esigw(k) = fsdsig(k-0.5)
+      !!      This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order a!!uracy
+      !!      schemes.
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper   ! temporary scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: gsigw3, gsigt3, gsi3w3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3           
+
+      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_sco')
+      !
+      CALL wrk_alloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat                           )
+      CALL wrk_alloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3                                      )
+      CALL wrk_alloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+      !
+      REWIND( numnam )                       ! Read Namelist namzgr_sco : sigma-stretching parameters
+      READ  ( numnam, namzgr_sco )
+
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom:zgr_sco : s-coordinate or hybrid z-s-coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr_sco'
+         WRITE(numout,*) '      sigma-stretching coeffs '
+         WRITE(numout,*) '      maximum depth of s-bottom surface (>0)       rn_sbot_max   = ' ,rn_sbot_max
+         WRITE(numout,*) '      minimum depth of s-bottom surface (>0)       rn_sbot_min   = ' ,rn_sbot_min
+         WRITE(numout,*) '      surface control parameter (0<=rn_theta<=20)  rn_theta      = ', rn_theta
+         WRITE(numout,*) '      bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ', rn_thetb
+         WRITE(numout,*) '      maximum cut-off r-value allowed              rn_rmax       = ', rn_rmax
+         WRITE(numout,*) '      Hybrid s-sigma-coordinate                    ln_s_sigma    = ', ln_s_sigma
+         WRITE(numout,*) '      stretching parameter (song and haidvogel)    rn_bb         = ', rn_bb
+         WRITE(numout,*) '      Critical depth                               rn_hc         = ', rn_hc
+      ENDIF
+
+      gsigw3  = 0._wp   ;   gsigt3  = 0._wp   ;   gsi3w3  = 0._wp
+      esigt3  = 0._wp   ;   esigw3  = 0._wp 
+      esigtu3 = 0._wp   ;   esigtv3 = 0._wp   ;   esigtf3 = 0._wp
+      esigwu3 = 0._wp   ;   esigwv3 = 0._wp
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      hifu(:,:) = rn_sbot_min
+      hifv(:,:) = rn_sbot_min
+      hiff(:,:) = rn_sbot_min
+
+      !                                        ! set maximum ocean depth
+      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+         END DO
+      END DO
+      !                                        ! =============================
+      !                                        ! Define the envelop bathymetry   (hbatt)
+      !                                        ! =============================
+      ! use r-value to create hybrid coordinates
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( bathy(ji,jj), rn_sbot_min )
+         END DO
+      END DO
+      ! 
+      ! Smooth the bathymetry (if required)
+      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1._wp
+      !                                                     ! ================ !
+      DO WHILE( jl <= 10000 .AND. zrmax > rn_rmax )         !  Iterative loop  !
+         !                                                  ! ================ !
+         jl = jl + 1
+         zrmax = 0._wp
+         zmsk(:,:) = 0._wp
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
+               ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
+               zri(ji,jj) = ABS( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               zrj(ji,jj) = ABS( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               zrmax = MAX( zrmax, zri(ji,jj), zrj(ji,jj) )
+               IF( zri(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp
+               IF( zri(ji,jj) > rn_rmax )   zmsk(iip1,jj  ) = 1._wp
+               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp
+               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,ijp1) = 1._wp
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain
+         ! lateral boundary condition on zmsk: keep 1 along closed boundary (use of MAX)
+         ztmp(:,:) = zmsk(:,:)   ;   CALL lbc_lnk( zmsk, 'T', 1._wp )
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+                zmsk(ji,jj) = MAX( zmsk(ji,jj), ztmp(ji,jj) )
+            END DO
+         END DO
+         !
+         IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax, ' nb of pt= ', INT( SUM(zmsk(:,:) ) )
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               iip1 = MIN( ji+1, nlci )     ! last  line (ji=nlci)
+               ijp1 = MIN( jj+1, nlcj )     ! last  raw  (jj=nlcj)
+               iim1 = MAX( ji-1,  1  )      ! first line (ji=nlci)
+               ijm1 = MAX( jj-1,  1  )      ! first raw  (jj=nlcj)
+               IF( zmsk(ji,jj) == 1._wp ) THEN
+                  ztmp(ji,jj) =   (                                                                                   &
+             &      zenv(iim1,ijp1)*zmsk(iim1,ijp1) + zenv(ji,ijp1)*zmsk(ji,ijp1) + zenv(iip1,ijp1)*zmsk(iip1,ijp1)   &
+             &    + zenv(iim1,jj  )*zmsk(iim1,jj  ) + zenv(ji,jj  )*    2._wp     + zenv(iip1,jj  )*zmsk(iip1,jj  )   &
+             &    + zenv(iim1,ijm1)*zmsk(iim1,ijm1) + zenv(ji,ijm1)*zmsk(ji,ijm1) + zenv(iip1,ijm1)*zmsk(iip1,ijm1)   &
+             &                    ) / (                                                                               &
+             &                      zmsk(iim1,ijp1) +               zmsk(ji,ijp1) +                 zmsk(iip1,ijp1)   &
+             &    +                 zmsk(iim1,jj  ) +                   2._wp     +                 zmsk(iip1,jj  )   &
+             &    +                 zmsk(iim1,ijm1) +               zmsk(ji,ijm1) +                 zmsk(iip1,ijm1)   &
+             &                        )
+               ENDIF
+            END DO
+         END DO
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               IF( zmsk(ji,jj) == 1._wp )   zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) )
+            END DO
+         END DO
+         !
+         ! Apply lateral boundary condition   CAUTION: kept the value when the lbc field is zero
+         ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1._wp )
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               IF( zenv(ji,jj) == 0._wp )   zenv(ji,jj) = ztmp(ji,jj)
+            END DO
+         END DO
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      !
+      !                                        ! envelop bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:) 
+      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN
+         CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
+            END DO
+         END DO
+      ENDIF
+      !
+      IF(lwp) THEN                             ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'
+         WRITE(numout,*)
+         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout )
+         IF( nprint == 1 )   THEN        
+            WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) )
+            WRITE(numout,*) ' hbatt  MAX ', MAXVAL( hbatt(:,:) ), ' MIN ', MINVAL( hbatt(:,:) )
+         ENDIF
+      ENDIF
+
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      ENDIF
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+      ! 
+      ! Apply lateral boundary condition
+!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
+      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+
+!!bug:  key_helsinki a verifer
+      hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+      hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+      hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+      hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(numout,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(numout,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(numout,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      ENDIF
+!! helsinki
+
+      !                                            ! =======================
+      !                                            !   s-ccordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+      IF( ln_s_sigma ) THEN        ! Song and Haidvogel style stretched sigma for depths
+         !                         ! below rn_hc, with uniform sigma in shallower waters
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+
+               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+                  DO jk = 1, jpk
+                     gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                     gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+                  END DO
+               ELSE ! shallow water, uniform sigma
+                  DO jk = 1, jpk
+                     gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                     gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+                  END DO
+               ENDIF
+               IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw3 1 jpk    ', gsigw3(ji,jj,1), gsigw3(ji,jj,jpk)
+               !
+               DO jk = 1, jpkm1
+                  esigt3(ji,jj,jk  ) = gsigw3(ji,jj,jk+1) - gsigw3(ji,jj,jk)
+                  esigw3(ji,jj,jk+1) = gsigt3(ji,jj,jk+1) - gsigt3(ji,jj,jk)
+               END DO
+               esigw3(ji,jj,1  ) = 2._wp * ( gsigt3(ji,jj,1  ) - gsigw3(ji,jj,1  ) )
+               esigt3(ji,jj,jpk) = 2._wp * ( gsigt3(ji,jj,jpk) - gsigw3(ji,jj,jpk) )
+               !
+               ! Coefficients for vertical depth as the sum of e3w scale factors
+               gsi3w3(ji,jj,1) = 0.5_wp * esigw3(ji,jj,1)
+               DO jk = 2, jpk
+                  gsi3w3(ji,jj,jk) = gsi3w3(ji,jj,jk-1) + esigw3(ji,jj,jk)
+               END DO
+               !
+               DO jk = 1, jpk
+                  zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+                  zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+                  gdept (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+                  gdepw (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+                  gdep3w(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
+               END DO
+               !
+            END DO   ! for all jj's
+         END DO    ! for all ji's
+
+         DO ji = 1, jpim1
+            DO jj = 1, jpjm1
+               DO jk = 1, jpk
+                  esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji,jj+1)*esigt3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk)     &
+                     &                + hbatt(ji,jj+1)*esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*esigt3(ji+1,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+                  esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji+1,jj)*esigw3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji,jj+1)*esigw3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  !
+                  e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigt3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  !
+                  e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigw3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+               END DO
+            END DO
+         END DO
+
+         CALL lbc_lnk( e3t , 'T', 1._wp )
+         CALL lbc_lnk( e3u , 'U', 1._wp )
+         CALL lbc_lnk( e3v , 'V', 1._wp )
+         CALL lbc_lnk( e3f , 'F', 1._wp )
+         CALL lbc_lnk( e3w , 'W', 1._wp )
+         CALL lbc_lnk( e3uw, 'U', 1._wp )
+         CALL lbc_lnk( e3vw, 'V', 1._wp )
+
+         !
+      ELSE   ! not ln_s_sigma
+         !
+         DO jk = 1, jpk
+           gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
+           gsigt(jk) = -fssig( REAL(jk,wp)        )
+         END DO
+         IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw 1 jpk    ', gsigw(1), gsigw(jpk)
+         !
+         ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+         DO jk = 1, jpkm1
+            esigt(jk  ) = gsigw(jk+1) - gsigw(jk)
+            esigw(jk+1) = gsigt(jk+1) - gsigt(jk)
+         END DO
+         esigw( 1 ) = 2._wp * ( gsigt(1  ) - gsigw(1  ) ) 
+         esigt(jpk) = 2._wp * ( gsigt(jpk) - gsigw(jpk) )
+
+!!gm  original form
+!!org DO jk = 1, jpk
+!!org    esigt(jk)=fsdsig( FLOAT(jk)     )
+!!org    esigw(jk)=fsdsig( FLOAT(jk)-0.5 )
+!!org END DO
+!!gm
+         !
+         ! Coefficients for vertical depth as the sum of e3w scale factors
+         gsi3w(1) = 0.5_wp * esigw(1)
+         DO jk = 2, jpk
+            gsi3w(jk) = gsi3w(jk-1) + esigw(jk)
+         END DO
+!!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)
+         DO jk = 1, jpk
+            zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+            zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+            gdept (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigt(jk) + hift(:,:)*zcoeft )
+            gdepw (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigw(jk) + hift(:,:)*zcoefw )
+            gdep3w(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsi3w(jk) + hift(:,:)*zcoeft )
+         END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+                 e3t(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3u(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3v(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+                 e3f(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
+                 !
+                 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF ! ln_s_sigma
+
+
+      !
+      where (e3t   (:,:,:).eq.0.0)  e3t(:,:,:) = 1.0
+      where (e3u   (:,:,:).eq.0.0)  e3u(:,:,:) = 1.0
+      where (e3v   (:,:,:).eq.0.0)  e3v(:,:,:) = 1.0
+      where (e3f   (:,:,:).eq.0.0)  e3f(:,:,:) = 1.0
+      where (e3w   (:,:,:).eq.0.0)  e3w(:,:,:) = 1.0
+      where (e3uw  (:,:,:).eq.0.0)  e3uw(:,:,:) = 1.0
+      where (e3vw  (:,:,:).eq.0.0)  e3vw(:,:,:) = 1.0
+
+
+      fsdept(:,:,:) = gdept (:,:,:)
+      fsdepw(:,:,:) = gdepw (:,:,:)
+      fsde3w(:,:,:) = gdep3w(:,:,:)
+      fse3t (:,:,:) = e3t   (:,:,:)
+      fse3u (:,:,:) = e3u   (:,:,:)
+      fse3v (:,:,:) = e3v   (:,:,:)
+      fse3f (:,:,:) = e3f   (:,:,:)
+      fse3w (:,:,:) = e3w   (:,:,:)
+      fse3uw(:,:,:) = e3uw  (:,:,:)
+      fse3vw(:,:,:) = e3vw  (:,:,:)
+!!
+      ! HYBRID : 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
+               IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+      END DO
+      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
+         &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
+
+      !                                               ! =============
+      IF(lwp) THEN                                    ! Control print
+         !                                            ! =============
+         WRITE(numout,*) 
+         WRITE(numout,*) ' domzgr: vertical coefficients for model level'
+         WRITE(numout, "(9x,'  level    gsigt      gsigw      esigt      esigw      gsi3w')" )
+         WRITE(numout, "(10x,i4,5f11.4)" ) ( jk, gsigt(jk), gsigw(jk), esigt(jk), esigw(jk), gsi3w(jk), jk=1,jpk )
+      ENDIF
+      IF( nprint == 1  .AND. lwp )   THEN         ! min max values over the local domain
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)   ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ),   &
+            &                          ' w ', MINVAL( fsdepw(:,:,:) ), '3w '  , MINVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( fse3t (:,:,:) ), ' f '  , MINVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MINVAL( fse3u (:,:,:) ), ' u '  , MINVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MINVAL( fse3uw(:,:,:) ), ' vw'  , MINVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MINVAL( fse3w (:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fsdepw(:,:,:) ), '3w '  , MAXVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( fse3t (:,:,:) ), ' f '  , MAXVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MAXVAL( fse3u (:,:,:) ), ' u '  , MAXVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MAXVAL( fse3uw(:,:,:) ), ' vw'  , MAXVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fse3w (:,:,:) )
+      ENDIF
+      !
+      IF(lwp) THEN                                  ! selected vertical profiles
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1)
+         WRITE(numout,*) ' ~~~~~~  --------------------'
+         WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+         WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(1,1,jk), fsdepw(1,1,jk),     &
+            &                                 fse3t (1,1,jk), fse3w (1,1,jk), jk=1,jpk )
+         DO jj = mj0(20), mj1(20)
+            DO ji = mi0(20), mi1(20)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )
+            END DO
+         END DO
+         DO jj = mj0(74), mj1(74)
+            DO ji = mi0(100), mi1(100)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )
+            END DO
+         END DO
+      ENDIF
+
+!!gm bug?  no more necessary?  if ! defined key_helsinki
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN
+                  WRITE(ctmp1,*) 'zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                  CALL ctl_stop( ctmp1 )
+               ENDIF
+               IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN
+                  WRITE(ctmp1,*) 'zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
+                  CALL ctl_stop( ctmp1 )
+               ENDIF
+            END DO
+         END DO
+      END DO
+!!gm bug    #endif
+      !
+      CALL wrk_dealloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat                           )
+      CALL wrk_dealloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3                                      )
+      CALL wrk_dealloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_sco')
+      !
+   END SUBROUTINE zgr_sco
+
+   !!======================================================================
+END MODULE domzgr
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/eosbn2.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/eosbn2.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/eosbn2.F90	(revision 4056)
@@ -0,0 +1,754 @@
+MODULE eosbn2
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Ocean diagnostic variable : equation of state - in situ and potential density
+   !!                                               - Brunt-Vaisala frequency
+   !!==============================================================================
+   !! History :  OPA  ! 1989-03  (O. Marti)  Original code
+   !!            6.0  ! 1994-07  (G. Madec, M. Imbard)  add bn2
+   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos
+   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3
+   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass
+   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient
+   !!            8.2  ! 2001-09  (M. Ben Jelloul)  bugfix on linear eos
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  add eos_init
+   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
+   !!             -   ! 2003-08  (G. Madec)  F90, free form
+   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   eos            : generic interface of the equation of state
+   !!   eos_insitu     : Compute the in situ density
+   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
+   !!                    volumic mass
+   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
+   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
+   !!   eos_alpbet     : calculates the in situ thermal/haline expansion ratio
+   !!   tfreez         : Compute the surface freezing temperature
+   !!   eos_init       : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdfddm          ! vertical physics: double diffusion
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !                   !! * Interface
+   INTERFACE eos
+      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
+   END INTERFACE
+   INTERFACE bn2
+      MODULE PROCEDURE eos_bn2
+   END INTERFACE
+
+   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules
+   PUBLIC   eos_init   ! called by istate module
+   PUBLIC   bn2        ! called by step module
+   PUBLIC   eos_alpbet ! called by ldfslp module
+   PUBLIC   tfreez     ! called by sbcice_... modules
+
+   !                                          !!* Namelist (nameos) *
+   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4_wp !: thermal expension coeff. (linear equation of state)
+   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4_wp !: saline  expension coeff. (linear equation of state)
+
+   REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: eosbn2.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE eos_insitu( pts, prd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!       potential temperature and salinity using an equation of state
+      !!       defined through the namelist parameter nn_eos.
+      !!
+      !! ** Method  :   3 cases:
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                      ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-]
+      !!
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zt , zs , zh , zsr   ! local scalars
+      REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      -
+      REAL(wp) ::   zrhop, ze, zbw, zb   !   -      -
+      REAL(wp) ::   zd , zc , zaw, za    !   -      -
+      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      -
+      REAL(wp) ::   zrau0r               !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = fsdept(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   &
+                     &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        &
+                     &                      -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp
+                  za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation function of temperature only  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos')
+      !
+   END SUBROUTINE eos_insitu
+
+
+   SUBROUTINE eos_insitu_pot( pts, prd, prhop )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_pot  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
+      !!      potential volumic mass (Kg/m3) from potential temperature and
+      !!      salinity fields using an equation of state defined through the
+      !!     namelist parameter nn_eos.
+      !!
+      !! ** Method  :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!              rhop(t,s)  = rho(t,s,0)
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t
+      !!              rhop(t,s)  = rho(t,s)
+      !!
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0
+      !!                       = rn_beta * s - rn_alpha * tn - 1.
+      !!              rhop(t,s)  = rho(t,s)
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!                Brown and Campana, Mon. Weather Rev., 1978
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius]
+      !                                                                ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos-p')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = fsdept(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                     &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   &
+                     &                                         -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! save potential volumic mass
+                  prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk)
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp
+                  za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos-p')
+      !
+   END SUBROUTINE eos_insitu_pot
+
+
+   SUBROUTINE eos_insitu_2d( pts, pdep, prd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_2d  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!      potential temperature and salinity using an equation of state
+      !!      defined through the namelist parameter nn_eos. * 2D field case
+      !!
+      !! ** Method :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  : - prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                           ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
+      !!
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos2d')
+      !
+      CALL wrk_alloc( jpi, jpj, zws )
+      !
+
+      prd(:,:) = 0._wp
+
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+      !
+!CDIR NOVERRCHK
+         DO jj = 1, jpjm1
+!CDIR NOVERRCHK
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) )
+            END DO
+         END DO
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zmask = tmask(ji,jj,1)          ! land/sea bottom mask = surf. mask
+               zt    = pts  (ji,jj,jp_tem)            ! interpolated T
+               zs    = pts  (ji,jj,jp_sal)            ! interpolated S
+               zsr   = zws  (ji,jj)            ! square root of interpolated S
+               zh    = pdep (ji,jj)            ! depth at the partial step level
+               !
+               ! compute volumic mass pure water at atm pressure
+               zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                  &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+               ! seawater volumic mass atm pressure
+               zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   &
+                  &                                   -4.0899e-3_wp ) *zt+0.824493_wp
+               zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp
+               zr4 = 4.8314e-4_wp
+               !
+               ! potential volumic mass (reference to the surface)
+               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+               !
+               ! add the compression terms
+               ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+               zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+               zb = zbw + ze * zs
+               !
+               zd =    -2.042967e-2_wp
+               zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+               zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp
+               za = ( zd*zsr + zc ) *zs + zaw
+               !
+               zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp
+               za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp
+               zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   &
+                  &                             +2098.925_wp ) *zt+190925.6_wp
+               zk0= ( zb1*zsr + za1 )*zs + zkw
+               !
+               ! masked in situ density anomaly
+               prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         !
+      END SELECT
+
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+      !
+      CALL wrk_dealloc( jpi, jpj, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos2d')
+      !
+   END SUBROUTINE eos_insitu_2d
+
+
+   SUBROUTINE eos_bn2( pts, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
+      !!      step of the input arguments
+      !!
+      !! ** Method :
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!         The brunt-vaisala frequency is computed using the polynomial
+      !!      polynomial expression of McDougall (1987):
+      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
+      !!      computed and used in zdfddm module :
+      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w
+      !!      The use of potential density to compute N^2 introduces e r r o r
+      !!      in the sign of N^2 at great depths. We recommand the use of
+      !!      nn_eos = 0, except for academical studies.
+      !!        Macro-tasked on horizontal slab (jk-loop)
+      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
+      !!      and is never used at this level.
+      !!
+      !! ** Action  : - pn2 : the brunt-vaisala frequency
+      !!
+      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1]
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars
+#if defined key_zdfddm
+      REAL(wp) ::   zds   ! local scalars
+#endif
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bn2')
+      !
+      ! pn2 : interior points only (2=< jk =< jpkm1 )
+      ! --------------------------
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = grav / fse3w(ji,jj,jk)
+                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt
+                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt
+                  zh = fsdepw(ji,jj,jk)                                                ! depth in meters  at w-point
+                  !
+                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   +         0.665157e-01_wp                                 &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+                     !
+                  zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta
+                     &                               - 0.301985e-05_wp ) * zt      &
+                     &   +       0.785567e-03_wp                                   &
+                     &   + (     0.515032e-08_wp * zs                              &
+                     &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     &
+                     &   + ( (   0.121551e-17_wp * zh                              &
+                     &         - 0.602281e-15_wp * zs                              &
+                     &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     &
+                     &                                + 0.408195e-10_wp   * zs     &
+                     &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     &
+                     &                                - 0.121555e-07_wp ) * zh
+                     !
+                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2
+                     &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   &
+                     &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) )
+#if defined key_zdfddm
+                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
+                  IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+#endif
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 2, jpkm1
+            pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 2, jpkm1
+            pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
+               &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   &
+               &               / fse3w(:,:,jk) * tmask(:,:,jk)
+         END DO
+#if defined key_zdfddm
+         DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s])
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )
+                  IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+               END DO
+            END DO
+         END DO
+#endif
+      END SELECT
+
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
+#if defined key_zdfddm
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk )
+#endif
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bn2')
+      !
+   END SUBROUTINE eos_bn2
+
+
+   SUBROUTINE eos_alpbet( pts, palpbet, beta0 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_alpbet  ***
+      !!
+      !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points
+      !!
+      !! ** Method  :   calculates alpha / beta ratio at T-points
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial
+      !!                       polynomial expression of McDougall (1987).
+      !!                       Scalar beta0 is returned = 1.
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!                       The ratio is undefined, so we return alpha as palpbet
+      !!                       Scalar beta0 is returned = 0.
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!                       The alpha/beta ratio is returned as ralpbet
+      !!                       Scalar beta0 is returned = 1.
+      !!
+      !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points
+      !!            :   beta0   : 1. or 0.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio
+      REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T)
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos_alpbet')
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts(ji,jj,jk,jp_tem)           ! potential temperature
+                  zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35)
+                  zh = fsdept(ji,jj,jk)               ! depth in meters
+                  !
+                  palpbet(ji,jj,jk) =                                              &
+                     &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   + 0.665157e-01_wp                                         &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+               END DO
+            END DO
+         END DO
+         beta0 = 1._wp
+         !
+      CASE ( 1 )              !==  Linear formulation = F( temperature )  ==!
+         palpbet(:,:,:) = rn_alpha
+         beta0 = 0._wp
+         !
+      CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==!
+         palpbet(:,:,:) = ralpbet
+         beta0 = 1._wp
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet')
+      !
+   END SUBROUTINE eos_alpbet
+
+
+   FUNCTION tfreez( psal ) RESULT( ptf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius]
+      !!
+      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???)
+      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
+      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars
+      !!
+      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
+      ! Leave result array automatic rather than making explicitly allocated
+      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius]
+      !!----------------------------------------------------------------------
+      !
+      ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
+         &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
+      !
+   END FUNCTION tfreez
+
+
+   SUBROUTINE eos_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos and control the parameters
+      !!----------------------------------------------------------------------
+      NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )            ! Read Namelist nameos : equation of state
+      READ  ( numnam, nameos )
+      !
+      IF(lwp) THEN                ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist nameos : set eos parameters'
+         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos
+         WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha
+         WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta
+      ENDIF
+      !
+      SELECT CASE( nn_eos )         ! check option
+      !
+      CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
+         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
+         !
+      CASE( 1 )                        !==  Linear formulation = F( temperature )  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )'
+         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   &
+              &                         ' that T and S are used as state variables' )
+         !
+      CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==!
+         ralpbet = rn_alpha / rn_beta
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )'
+         !
+      CASE DEFAULT                     !==  ERROR in nn_eos  ==!
+         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      !
+   END SUBROUTINE eos_init
+
+   !!======================================================================
+END MODULE eosbn2
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/eosbn2_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/eosbn2_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/eosbn2_crs.F90	(revision 4056)
@@ -0,0 +1,755 @@
+MODULE eosbn2_crs
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Ocean diagnostic variable : equation of state - in situ and potential density
+   !!                                               - Brunt-Vaisala frequency
+   !!==============================================================================
+   !! History :  OPA  ! 1989-03  (O. Marti)  Original code
+   !!            6.0  ! 1994-07  (G. Madec, M. Imbard)  add bn2
+   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos
+   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3
+   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass
+   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient
+   !!            8.2  ! 2001-09  (M. Ben Jelloul)  bugfix on linear eos
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  add eos_init
+   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
+   !!             -   ! 2003-08  (G. Madec)  F90, free form
+   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   eos            : generic interface of the equation of state
+   !!   eos_insitu     : Compute the in situ density
+   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
+   !!                    volumic mass
+   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
+   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
+   !!   eos_alpbet     : calculates the in situ thermal/haline expansion ratio
+   !!   tfreez         : Compute the surface freezing temperature
+   !!   eos_init       : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdfddm          ! vertical physics: double diffusion
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !                   !! * Interface
+   INTERFACE eos_crs
+      MODULE PROCEDURE eos_insitu_crs, eos_insitu_pot_crs, eos_insitu_2d_crs
+   END INTERFACE
+   INTERFACE bn2_crs
+      MODULE PROCEDURE eos_bn2_crs
+   END INTERFACE
+
+   PUBLIC   eos_crs        ! called by step, istate, tranpc and zpsgrd modules
+   PUBLIC   eos_init_crs   ! called by istate module
+   PUBLIC   bn2_crs        ! called by step module
+   PUBLIC   eos_alpbet_crs ! called by ldfslp module
+   PUBLIC   tfreez_crs     ! called by sbcice_... modules
+
+   !                                          !!* Namelist (nameos) *
+   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4_wp !: thermal expension coeff. (linear equation of state)
+   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4_wp !: saline  expension coeff. (linear equation of state)
+
+   REAL(wp), PUBLIC ::   ralpbet_crs              !: alpha / beta ratio
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: eosbn2.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE eos_insitu_crs( pts, prd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!       potential temperature and salinity using an equation of state
+      !!       defined through the namelist parameter nn_eos.
+      !!
+      !! ** Method  :   3 cases:
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                      ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-]
+      !!
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zt , zs , zh , zsr   ! local scalars
+      REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      -
+      REAL(wp) ::   zrhop, ze, zbw, zb   !   -      -
+      REAL(wp) ::   zd , zc , zaw, za    !   -      -
+      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      -
+      REAL(wp) ::   zrau0r               !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = gdept_crs(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   &
+                     &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        &
+                     &                      -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp
+                  za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask_crs(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation function of temperature only  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask_crs(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask_crs(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+    !  IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos')
+      !
+   END SUBROUTINE eos_insitu_crs
+
+
+   SUBROUTINE eos_insitu_pot_crs( pts, prd, prhop )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_pot  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
+      !!      potential volumic mass (Kg/m3) from potential temperature and
+      !!      salinity fields using an equation of state defined through the
+      !!     namelist parameter nn_eos.
+      !!
+      !! ** Method  :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!              rhop(t,s)  = rho(t,s,0)
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t
+      !!              rhop(t,s)  = rho(t,s)
+      !!
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0
+      !!                       = rn_beta * s - rn_alpha * tn - 1.
+      !!              rhop(t,s)  = rho(t,s)
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!                Brown and Campana, Mon. Weather Rev., 1978
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius]
+      !                                                                ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos-p')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = gdept_crs(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                     &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   &
+                     &                                         -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! save potential volumic mass
+                  prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk)
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp
+                  za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask_crs(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask_crs(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask_crs(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask_crs(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask_crs(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+   !   IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos-p')
+      !
+   END SUBROUTINE eos_insitu_pot_crs
+
+
+   SUBROUTINE eos_insitu_2d_crs( pts, pdep, prd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_2d  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!      potential temperature and salinity using an equation of state
+      !!      defined through the namelist parameter nn_eos. * 2D field case
+      !!
+      !! ** Method :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  : - prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                           ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
+      !!
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos2d')
+      !
+      CALL wrk_alloc( jpi, jpj, zws )
+      !
+
+      prd(:,:) = 0._wp
+
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+      !
+!CDIR NOVERRCHK
+         DO jj = 1, jpjm1
+!CDIR NOVERRCHK
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) )
+            END DO
+         END DO
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zmask = tmask_crs(ji,jj,1)          ! land/sea bottom mask = surf. mask
+               zt    = pts  (ji,jj,jp_tem)            ! interpolated T
+               zs    = pts  (ji,jj,jp_sal)            ! interpolated S
+               zsr   = zws  (ji,jj)            ! square root of interpolated S
+               zh    = pdep (ji,jj)            ! depth at the partial step level
+               !
+               ! compute volumic mass pure water at atm pressure
+               zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                  &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+               ! seawater volumic mass atm pressure
+               zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   &
+                  &                                   -4.0899e-3_wp ) *zt+0.824493_wp
+               zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp
+               zr4 = 4.8314e-4_wp
+               !
+               ! potential volumic mass (reference to the surface)
+               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+               !
+               ! add the compression terms
+               ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+               zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+               zb = zbw + ze * zs
+               !
+               zd =    -2.042967e-2_wp
+               zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+               zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp
+               za = ( zd*zsr + zc ) *zs + zaw
+               !
+               zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp
+               za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp
+               zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   &
+                  &                             +2098.925_wp ) *zt+190925.6_wp
+               zk0= ( zb1*zsr + za1 )*zs + zkw
+               !
+               ! masked in situ density anomaly
+               prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_crs(ji,jj,1)
+            END DO
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_crs(ji,jj,1)
+            END DO
+         END DO
+         !
+      END SELECT
+
+!     IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+      !
+      CALL wrk_dealloc( jpi, jpj, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos2d')
+      !
+   END SUBROUTINE eos_insitu_2d_crs
+
+
+   SUBROUTINE eos_bn2_crs( pts, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
+      !!      step of the input arguments
+      !!
+      !! ** Method :
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!         The brunt-vaisala frequency is computed using the polynomial
+      !!      polynomial expression of McDougall (1987):
+      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
+      !!      computed and used in zdfddm module :
+      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w
+      !!      The use of potential density to compute N^2 introduces e r r o r
+      !!      in the sign of N^2 at great depths. We recommand the use of
+      !!      nn_eos = 0, except for academical studies.
+      !!        Macro-tasked on horizontal slab (jk-loop)
+      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
+      !!      and is never used at this level.
+      !!
+      !! ** Action  : - pn2 : the brunt-vaisala frequency
+      !!
+      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1]
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars
+#if defined key_zdfddm
+      REAL(wp) ::   zds   ! local scalars
+#endif
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bn2')
+      !
+      ! pn2 : interior points only (2=< jk =< jpkm1 )
+      ! --------------------------
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = grav / e3w_max_crs(ji,jj,jk)
+                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt
+                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt
+                  zh = gdepw_crs(ji,jj,jk)                                                ! depth in meters  at w-point
+                  !
+                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   +         0.665157e-01_wp                                 &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+                     !
+                  zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta
+                     &                               - 0.301985e-05_wp ) * zt      &
+                     &   +       0.785567e-03_wp                                   &
+                     &   + (     0.515032e-08_wp * zs                              &
+                     &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     &
+                     &   + ( (   0.121551e-17_wp * zh                              &
+                     &         - 0.602281e-15_wp * zs                              &
+                     &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     &
+                     &                                + 0.408195e-10_wp   * zs     &
+                     &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     &
+                     &                                - 0.121555e-07_wp ) * zh
+                     !
+                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask_crs(ji,jj,jk)           &   ! N^2
+                     &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   &
+                     &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) )
+#if defined key_zdfddm
+                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
+                  IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+#endif
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 2, jpkm1
+            pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / e3w_max_crs(:,:,jk) * tmask_crs(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 2, jpkm1
+            pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
+               &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   &
+               &               / e3w_max_crs(:,:,jk) * tmask_crs(:,:,jk)
+         END DO
+#if defined key_zdfddm
+         DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s])
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )
+                  IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = ralpbet_crs * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+               END DO
+            END DO
+         END DO
+#endif
+      END SELECT
+
+  !    IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
+#if defined key_zdfddm
+  !    IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk )
+#endif
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bn2')
+      !
+   END SUBROUTINE eos_bn2_crs
+
+
+   SUBROUTINE eos_alpbet_crs( pts, palpbet, beta0 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_alpbet  ***
+      !!
+      !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points
+      !!
+      !! ** Method  :   calculates alpha / beta ratio at T-points
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial
+      !!                       polynomial expression of McDougall (1987).
+      !!                       Scalar beta0 is returned = 1.
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!                       The ratio is undefined, so we return alpha as palpbet
+      !!                       Scalar beta0 is returned = 0.
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!                       The alpha/beta ratio is returned as ralpbet
+      !!                       Scalar beta0 is returned = 1.
+      !!
+      !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points
+      !!            :   beta0   : 1. or 0.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio
+      REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T)
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos_alpbet')
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts(ji,jj,jk,jp_tem)           ! potential temperature
+                  zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35)
+                  zh = fsdept(ji,jj,jk)               ! depth in meters
+                  !
+                  palpbet(ji,jj,jk) =                                              &
+                     &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   + 0.665157e-01_wp                                         &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+               END DO
+            END DO
+         END DO
+         beta0 = 1._wp
+         !
+      CASE ( 1 )              !==  Linear formulation = F( temperature )  ==!
+         palpbet(:,:,:) = rn_alpha
+         beta0 = 0._wp
+         !
+      CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==!
+         palpbet(:,:,:) = ralpbet_crs
+         beta0 = 1._wp
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet')
+      !
+   END SUBROUTINE eos_alpbet_crs
+
+
+   FUNCTION tfreez_crs( psal ) RESULT( ptf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius]
+      !!
+      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???)
+      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
+      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars
+      !!
+      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
+      ! Leave result array automatic rather than making explicitly allocated
+      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius]
+      !!----------------------------------------------------------------------
+      !
+      ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
+         &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
+      !
+   END FUNCTION tfreez_crs
+
+
+   SUBROUTINE eos_init_crs
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos and control the parameters
+      !!----------------------------------------------------------------------
+      NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )            ! Read Namelist nameos : equation of state
+      READ  ( numnam, nameos )
+      !
+      IF(lwp) THEN                ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist nameos : set eos parameters'
+         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos
+         WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha
+         WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta
+      ENDIF
+      !
+      SELECT CASE( nn_eos )         ! check option
+      !
+      CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
+         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
+         !
+      CASE( 1 )                        !==  Linear formulation = F( temperature )  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )'
+         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   &
+              &                         ' that T and S are used as state variables' )
+         !
+      CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==!
+         ralpbet_crs = rn_alpha / rn_beta
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )'
+         !
+      CASE DEFAULT                     !==  ERROR in nn_eos  ==!
+         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      !
+   END SUBROUTINE eos_init_crs
+
+   !!======================================================================
+END MODULE eosbn2_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom.F90	(revision 4056)
@@ -0,0 +1,1184 @@
+MODULE iom
+   !!=====================================================================
+   !!                    ***  MODULE  iom ***
+   !! Input/Output manager :  Library to read input files
+   !!====================================================================
+   !! History :  9.0  ! 05 12  (J. Belier) Original code
+   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
+   !!             "   ! 07 07  (D. Storkey) Changes to iom_gettime
+   !!                 ! 12 07  - add coarse grid definitions (modified iodef.xml)
+   !!                          
+   !!--------------------------------------------------------------------
+   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis cdvar in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+ !  USE dom_oce         ! ocean space and time domain
+   USE dom_oce, ONLY : njmpp, nimpp, nldi, gphif, gphiv, nlei, nldj, nlej, mig, mjg, narea, agrif_root, agrif_cfixed, &
+                     & mjg, mig, rdt,rdttra, gdept_0, ln_crs, gdepw_0, nlcj, nlci, lk_agrif, adatrj, fjulday
+   USE flo_oce         ! floats module declarations
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE iom_ioipsl      ! NetCDF format with IOIPSL library
+   USE iom_nf90        ! NetCDF format with native NetCDF library
+   USE iom_rstdimg     ! restarts access direct format "dimg" style...
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp           ! MPP library
+#if defined key_iomput
+   USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain
+   USE domngb          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE dianam          ! build name of file
+   USE mod_event_client
+   USE mod_attribut
+# endif
+   USE crs
+
+   IMPLICIT NONE
+   PUBLIC   !   must be public to be able to access iom_def through iom
+   
+   PUBLIC iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
+   PUBLIC iom_getatt
+#if defined key_iomput
+   PUBLIC set_grid
+   PUBLIC setgrid_crs
+# endif
+
+   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
+   PRIVATE iom_p1d, iom_p2d, iom_p3d
+
+   INTERFACE iom_get
+      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
+   END INTERFACE
+   INTERFACE iom_getatt
+      MODULE PROCEDURE iom_g0d_intatt
+   END INTERFACE
+   INTERFACE iom_rstput
+      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   END INTERFACE
+  INTERFACE iom_put
+     MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
+  END INTERFACE
+#if defined key_iomput
+   INTERFACE iom_setkt
+      MODULE PROCEDURE event__set_timestep
+   END INTERFACE
+# endif
+
+#if defined key_iomput
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: iom.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_swap
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_swap  ***
+      !!
+      !! ** Purpose :  swap context between different agrif grid for xmlio_server
+      !!---------------------------------------------------------------------
+#if defined key_iomput
+
+     IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL event__swap_context("nemo")
+     ELSE
+        CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo")
+     ENDIF
+
+#endif
+   END SUBROUTINE iom_swap
+
+
+   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file (return 0 if not found)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
+      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90) 
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
+
+      CHARACTER(LEN=100)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
+      CHARACTER(LEN=100)    ::   cltmpn    ! tempory name to store clname (in writting mode)
+      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg"
+      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
+      CHARACTER(LEN=100)    ::   clinfo    ! info character
+      LOGICAL               ::   llok      ! check the existence 
+      LOGICAL               ::   llwrt     ! local definition of ldwrt
+      LOGICAL               ::   llnoov    ! local definition to read overlap
+      LOGICAL               ::   llstop    ! local definition of ldstop
+      LOGICAL               ::   lliof     ! local definition of ldiof
+      INTEGER               ::   iolib     ! library do we use to open the file
+      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
+      INTEGER               ::   iln, ils  ! lengths of character
+      INTEGER               ::   idom      ! type of domain
+      INTEGER               ::   istop     ! 
+      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters: 
+      ! local number of points for x,y dimensions
+      ! position of first local point for x,y dimensions
+      ! position of last local point for x,y dimensions
+      ! start halo size for x,y dimensions
+      ! end halo size for x,y dimensions
+      !---------------------------------------------------------------------
+      ! Initializations and control
+      ! =============
+      kiomid = -1
+      clinfo = '                    iom_open ~~~  '
+      istop = nstop
+      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
+      ! (could be done when defining iom_file in f95 but not in f90)
+      IF( Agrif_Root() ) THEN
+         IF( iom_open_init == 0 ) THEN
+            iom_file(:)%nfid = 0
+            iom_open_init = 1
+         ENDIF
+      ENDIF
+      ! do we read or write the file?
+      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
+      ELSE                        ;   llwrt = .FALSE.
+      ENDIF
+      ! do we call ctl_stop if we try to open a non-existing file in read mode?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      ! what library do we use to open the file?
+      IF( PRESENT(kiolib) ) THEN   ;   iolib = kiolib
+      ELSE                         ;   iolib = jpnf90
+      ENDIF
+      ! are we using interpolation on the fly?
+      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof
+      ELSE                        ;   lliof = .FALSE.
+      ENDIF
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
+      ! =============
+      clname   = trim(cdname)
+      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
+         iln    = INDEX(clname,'/') 
+         cltmpn = clname(1:iln)
+         clname = clname(iln+1:LEN_TRIM(clname))
+         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      ENDIF
+      ! which suffix should we use?
+      SELECT CASE (iolib)
+      CASE (jpioipsl ) ;   clsuffix = '.nc'
+      CASE (jpnf90   ) ;   clsuffix = '.nc'
+      CASE (jprstdimg) ;   clsuffix = '.dimg'
+      CASE DEFAULT     ;   clsuffix = ''
+         CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+      END SELECT
+      ! Add the suffix if needed
+      iln = LEN_TRIM(clname)
+      ils = LEN_TRIM(clsuffix)
+      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
+         &   clname = TRIM(clname)//TRIM(clsuffix)
+      cltmpn = clname   ! store this name
+      ! try to find if the file to be opened already exist
+      ! =============
+      INQUIRE( FILE = clname, EXIST = llok )
+      IF( .NOT.llok ) THEN
+         ! we try to add the cpu number to the name
+         IF( iolib == jprstdimg ) THEN   ;   WRITE(clcpu,*) narea
+         ELSE                            ;   WRITE(clcpu,*) narea-1
+         ENDIF
+         clcpu  = TRIM(ADJUSTL(clcpu))
+         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
+         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+         icnt = 0
+         INQUIRE( FILE = clname, EXIST = llok ) 
+         ! we try different formats for the cpu number by adding 0
+         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
+            clcpu  = "0"//trim(clcpu)
+            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+            INQUIRE( FILE = clname, EXIST = llok )
+            icnt = icnt + 1
+         END DO
+      ENDIF
+      IF( llwrt ) THEN
+         ! check the domain definition
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         idom = jpdom_local_noovlap   ! default definition
+         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
+         ELSE                ;   idom = jpdom_local_full      ! default definition
+         ENDIF
+         IF( PRESENT(kdom) )   idom = kdom
+         ! create the domain informations
+         ! =============
+         SELECT CASE (idom)
+         CASE (jpdom_local_full)
+            idompar(:,1) = (/ jpi             , jpj              /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /)
+         CASE (jpdom_local_noextra)
+            idompar(:,1) = (/ nlci            , nlcj             /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /)
+         CASE (jpdom_local_noovlap)
+            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /)
+            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
+            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
+            idompar(:,4) = (/ 0               , 0                /)
+            idompar(:,5) = (/ 0               , 0                /)
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
+         END SELECT
+      ENDIF
+      ! Open the NetCDF or RSTDIMG file
+      ! =============
+      ! do we have some free file identifier?
+      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
+         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
+      ! if no file was found...
+      IF( .NOT. llok ) THEN
+         IF( .NOT. llwrt ) THEN   ! we are in read mode 
+            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
+            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
+            ENDIF
+         ELSE                     ! we are in write mode so we 
+            clname = cltmpn       ! get back the file name without the cpu number
+         ENDIF
+      ELSE
+         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file 
+            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
+            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN   ! no error within this routine
+         SELECT CASE (iolib)
+         CASE (jpioipsl )   ;   CALL iom_ioipsl_open(  clname, kiomid, llwrt, llok, idompar )
+         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
+         CASE (jprstdimg)   ;   CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         END SELECT
+      ENDIF
+      !
+   END SUBROUTINE iom_open
+
+
+   SUBROUTINE iom_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_close  ***
+      !!
+      !! ** Purpose : close an input file, or all files opened by iom
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
+      !                                              ! return 0 when file is properly closed
+      !                                              ! No argument: all files opened by iom are closed
+
+      INTEGER ::   jf         ! dummy loop indices
+      INTEGER ::   i_s, i_e   ! temporary integer
+      CHARACTER(LEN=100)    ::   clinfo    ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_close ~~~  '
+      IF( PRESENT(kiomid) ) THEN
+         i_s = kiomid
+         i_e = kiomid
+      ELSE
+         i_s = 1
+         i_e = jpmax_files
+#if defined key_iomput
+         CALL event__stop_ioserver
+#endif
+      ENDIF
+
+      IF( i_s > 0 ) THEN
+         DO jf = i_s, i_e
+            IF( iom_file(jf)%nfid > 0 ) THEN
+               SELECT CASE (iom_file(jf)%iolib)
+               CASE (jpioipsl )   ;   CALL iom_ioipsl_close(  jf )
+               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
+               CASE (jprstdimg)   ;   CALL iom_rstdimg_close( jf )
+               CASE DEFAULT
+                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+               END SELECT
+               iom_file(jf)%nfid       = 0          ! free the id 
+               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
+            ELSEIF( PRESENT(kiomid) ) THEN
+               WRITE(ctmp1,*) '--->',  kiomid
+               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
+            ENDIF
+         END DO
+      ENDIF
+      !    
+   END SUBROUTINE iom_close
+
+
+   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
+      !
+      INTEGER                        ::   iom_varid, iiv, i_nvd
+      LOGICAL                        ::   ll_fnd
+      CHARACTER(LEN=100)             ::   clinfo                   ! info character
+      LOGICAL                        ::   llstop                   ! local definition of ldstop
+      !!-----------------------------------------------------------------------
+      iom_varid = 0                         ! default definition
+      ! do we call ctl_stop if we look for non-existing variable?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      !
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
+         IF( iom_file(kiomid)%nfid == 0 ) THEN 
+            CALL ctl_stop( trim(clinfo), 'the file is not open' )
+         ELSE
+            ll_fnd  = .FALSE.
+            iiv = 0
+            !
+            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
+               iiv = iiv + 1
+               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
+            END DO
+            !
+            IF( .NOT.ll_fnd ) THEN
+               iiv = iiv + 1
+               IF( iiv <= jpmax_vars ) THEN
+                  SELECT CASE (iom_file(kiomid)%iolib)
+                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
+                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz )
+                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file
+                  CASE DEFAULT   
+                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+                  END SELECT
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
+                        &                         'increase the parameter jpmax_vars')
+               ENDIF
+               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
+            ELSE
+               iom_varid = iiv
+               IF( PRESENT(kdimsz) ) THEN 
+                  i_nvd = iom_file(kiomid)%ndims(iiv)
+                  IF( i_nvd == size(kdimsz) ) THEN
+                     kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
+                  ELSE
+                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
+                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END FUNCTION iom_varid
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_get
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d( kiomid, cdvar, pvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
+      !
+      INTEGER               :: idvar   ! variable id
+      !
+      IF( kiomid > 0 ) THEN
+         idvar = iom_varid( kiomid, cdvar )
+         IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar )
+            CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar )
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d
+
+   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+      ENDIF
+   END SUBROUTINE iom_g1d
+
+   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+      ENDIF
+   END SUBROUTINE iom_g2d
+
+   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+      ENDIF
+   END SUBROUTINE iom_g3d
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
+         &                  pv_r1d, pv_r2d, pv_r3d,   &
+         &                  ktime , kstart, kcount  )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_get_123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
+      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
+      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
+      !
+      LOGICAL                        ::   llnoov      ! local definition to read overlap
+      INTEGER                        ::   jl          ! loop on number of dimension 
+      INTEGER                        ::   idom        ! type of domain
+      INTEGER                        ::   idvar       ! id of the variable
+      INTEGER                        ::   inbdim      ! number of dimensions of the variable
+      INTEGER                        ::   idmspc      ! number of spatial dimensions 
+      INTEGER                        ::   itime       ! record number
+      INTEGER                        ::   istop       ! temporary value of nstop
+      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER                        ::   ji, jj      ! loop counters
+      INTEGER                        ::   irankpv       ! 
+      INTEGER                        ::   ind1, ind2  ! substring index
+      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
+      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis 
+      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
+      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
+      INTEGER                        ::   itmp        ! temporary integer
+      CHARACTER(LEN=100)             ::   clinfo      ! info character
+      CHARACTER(LEN=100)             ::   clname      ! file name
+      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+      !---------------------------------------------------------------------
+      !
+      clname = iom_file(kiomid)%name   !   esier to read
+      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
+      ! local definition of the domain ?
+      idom = kdom
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+      ! check kcount and kstart optionals parameters...
+      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
+      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
+      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
+
+      ! Search for the variable in the data base (eventually actualize data)
+      istop = nstop
+      idvar = iom_varid( kiomid, cdvar )
+      !
+      IF( idvar > 0 ) THEN
+         ! to write iom_file(kiomid)%dimsz in a shorter way !
+         idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
+         inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
+         idmspc = inbdim                                   ! number of spatial dimensions in the file
+         IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
+         IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
+         !
+         ! update idom definition...
+         ! Identify the domain in case of jpdom_auto(glo/dta) definition
+         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN            
+            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
+            ELSE                               ;   idom = jpdom_data
+            ENDIF
+            ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
+            ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
+            IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
+         ENDIF
+         ! Identify the domain in case of jpdom_local definition
+         IF( idom == jpdom_local ) THEN
+            IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
+            ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
+            ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
+            ENDIF
+         ENDIF
+         !
+         ! check the consistency between input array and data rank in the file
+         !
+         ! initializations
+         itime = 1
+         IF( PRESENT(ktime) ) itime = ktime
+
+         irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
+         WRITE(clrankpv, fmt='(i1)') irankpv
+         WRITE(cldmspc , fmt='(i1)') idmspc
+         !
+         IF(     idmspc <  irankpv ) THEN 
+            CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+               &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
+         ELSEIF( idmspc == irankpv ) THEN
+            IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
+               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
+         ELSEIF( idmspc >  irankpv ) THEN
+               IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
+                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
+                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
+                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
+                  idmspc = idmspc - 1
+               ELSE
+                  CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
+                     &                         'we do not accept data with more than '//cldmspc//' spatial dimension',   &
+                     &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+               ENDIF
+         ENDIF
+
+         !
+         ! definition of istart and icnt
+         !
+         icnt  (:) = 1
+         istart(:) = 1
+         istart(idmspc+1) = itime
+
+         IF(              PRESENT(kstart)       ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
+         ELSE
+            IF(           idom == jpdom_unknown ) THEN                                       ; icnt(1:idmspc) = idimsz(1:idmspc)
+            ELSE 
+               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
+                  IF(     idom == jpdom_data    ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /)  ! icnt(1:2) done bellow
+                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done bellow
+                  ENDIF
+                  ! we do not read the overlap                     -> we start to read at nldi, nldj
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
+                  ENDIF
+                  IF( PRESENT(pv_r3d) ) THEN
+                     IF( idom == jpdom_data ) THEN   ; icnt(3) = jpkdta
+                     ELSE                            ; icnt(3) = jpk
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+
+         ! check that istart and icnt can be used with this file
+         !-
+         DO jl = 1, jpmax_dims
+            itmp = istart(jl)+icnt(jl)-1
+            IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
+               WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
+               WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
+               CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
+            ENDIF
+         END DO
+
+         ! check that icnt matches the input array
+         !-     
+         IF( idom == jpdom_unknown ) THEN
+            IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
+            IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
+            IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
+            ctmp1 = 'd'
+         ELSE
+            IF( irankpv == 2 ) THEN
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
+               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
+               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
+               ENDIF
+            ENDIF
+            IF( irankpv == 3 ) THEN 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
+               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
+               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+               ENDIF
+            ENDIF
+         ENDIF
+         
+         DO jl = 1, irankpv
+            WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
+            IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
+         END DO
+
+      ENDIF
+
+      ! read the data
+      !-     
+      IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
+         !
+         ! find the right index of the array to be read
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+!         ENDIF
+         IF( llnoov ) THEN
+            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+            ENDIF
+         ELSE
+            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
+            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+            ENDIF
+         ENDIF
+      
+         SELECT CASE (iom_file(kiomid)%iolib)
+         CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE DEFAULT    
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         END SELECT
+
+         IF( istop == nstop ) THEN   ! no additional errors until this point...
+            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+          
+            !--- overlap areas and extra hallows (mpp)
+            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
+               CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
+            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
+               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
+               IF( icnt(3) == jpk ) THEN
+                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
+               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
+                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
+                  DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
+               ENDIF
+            ENDIF
+            
+            !--- Apply scale_factor and offset
+            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
+            zofs = iom_file(kiomid)%ofs(idvar)      ! offset
+            IF(     PRESENT(pv_r1d) ) THEN
+               IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
+               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
+            ELSEIF( PRESENT(pv_r2d) ) THEN
+!CDIR COLLAPSE
+               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
+!CDIR COLLAPSE
+               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
+            ELSEIF( PRESENT(pv_r3d) ) THEN
+!CDIR COLLAPSE
+               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
+!CDIR COLLAPSE
+               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE iom_get_123d
+
+
+   SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kiomid     ! file Identifier
+      REAL(wp), DIMENSION(:)     , INTENT(  out) ::   ptime      ! the time axis
+      CHARACTER(len=*), OPTIONAL , INTENT(in   ) ::   cdvar      ! time axis name
+      INTEGER         , OPTIONAL , INTENT(  out) ::   kntime     ! number of times in file
+      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdunits    ! units attribute of time coordinate
+      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdcalendar ! calendar attribute of 
+      !
+      INTEGER, DIMENSION(1) :: kdimsz
+      INTEGER            ::   idvar    ! id of the variable
+      CHARACTER(LEN=32)  ::   tname    ! local name of time coordinate
+      CHARACTER(LEN=100) ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      IF ( PRESENT(cdvar) ) THEN
+         tname = cdvar
+      ELSE
+         tname = iom_file(kiomid)%uldname
+      ENDIF
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
+         IF ( PRESENT(kntime) ) THEN
+            idvar  = iom_varid( kiomid, tname, kdimsz = kdimsz )
+            kntime = kdimsz(1)
+         ELSE
+            idvar = iom_varid( kiomid, tname )
+         ENDIF
+         !
+         ptime(:) = 0. ! default definition
+         IF( idvar > 0 ) THEN
+            IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
+               IF( iom_file(kiomid)%luld(idvar) ) THEN
+                  IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
+                     SELECT CASE (iom_file(kiomid)%iolib)
+                     CASE (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
+                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
+                     CASE (jprstdimg)   ;   CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
+                     CASE DEFAULT    
+                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+                     END SELECT
+                  ELSE
+                     WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
+                     CALL ctl_stop( trim(clinfo), trim(ctmp1) )
+                  ENDIF
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
+               ENDIF
+            ELSE
+               CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
+            ENDIF
+         ELSE
+            CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE iom_gettime
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_getatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      INTEGER         , INTENT(  out)                 ::   pvar      ! read field
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_intatt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_rstput
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp0d
+
+   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp1d
+
+   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp2d
+
+   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp3d
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_put
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d( cdname, pfield0d )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      REAL(wp)        , INTENT(in) ::   pfield0d
+#if defined key_iomput
+      CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p0d
+
+   SUBROUTINE iom_p1d( cdname, pfield1d )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
+      INTEGER :: jpz
+#if defined key_iomput
+      jpz=SIZE(pfield1d)
+      CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p1d
+
+   SUBROUTINE iom_p2d( cdname, pfield2d )
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
+#if defined key_iomput
+      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p2d
+
+   SUBROUTINE iom_p3d( cdname, pfield3d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
+#if defined key_iomput
+      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p3d
+   !!----------------------------------------------------------------------
+
+
+#if defined key_iomput
+
+   SUBROUTINE set_grid( cdname, plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   define horizontal grids
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+
+      CALL event__set_grid_dimension( cdname, jpiglo, jpjglo)
+      CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, &
+         &                         plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) )
+      CALL event__set_grid_type_nemo( cdname )
+
+   END SUBROUTINE set_grid
+
+   SUBROUTINE setgrid_crs( cdname, plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   define horizontal coarse grids
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(in) ::   plat
+
+      CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+      
+      CALL set_grid( cdname, plon, plat )
+
+      CALL dom_grid_glo   ! Return to parent grid domain
+
+   END SUBROUTINE setgrid_crs
+
+
+   SUBROUTINE set_scalar
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   define fake grids for scalar point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1,1) ::   zz = 1.
+      !!----------------------------------------------------------------------
+      CALL event__set_grid_dimension( 'scalarpoint', jpnij, 1)
+      CALL event__set_grid_domain   ( 'scalarpoint', 1, 1, narea, 1, zz, zz )
+      CALL event__set_grid_type_nemo( 'scalarpoint' )
+
+   END SUBROUTINE set_scalar
+
+
+   SUBROUTINE set_xmlatt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   automatic definitions of some of the xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=6),DIMENSION( 12) ::   clsuff                   ! suffix name
+      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
+      CHARACTER(len=50)              ::   clname                   ! file name
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 1 character
+      INTEGER                        ::   idt                      ! time-step in seconds
+      INTEGER                        ::   iddss, ihhss             ! number of seconds in 1 day, 1 hour and 1 year
+      INTEGER                        ::   iyymo                    ! number of months in 1 year
+      INTEGER                        ::   jg, jh, jd, jm, jy       ! loop counters
+      INTEGER                        ::   ix, iy                   ! i-,j- index
+      REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings
+      REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings
+      REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings
+      REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings
+      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
+      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
+      !!----------------------------------------------------------------------
+      ! 
+      idt   = NINT( rdttra(1)     )
+      iddss = NINT( rday          )                                         ! number of seconds in 1 day
+      ihhss = NINT( rmmss * rhhmm )                                         ! number of seconds in 1 hour
+      iyymo = NINT( raamo         )                                         ! number of months in 1 year
+
+      ! frequency of the call of iom_put (attribut: freq_op)
+      CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt           ) )    ! model time-step
+      CALL event__set_attribut( 'SBC'             , attr( field__freq_op, idt * nn_fsbc ) )    ! SBC time-step
+      
+      ! output file names (attribut: name)
+      clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar', &
+         &           'gcrs_T', 'gcrs_U', 'gcrs_V', 'gcrs_W' /)      
+      DO jg = 1, SIZE(clsuff)                                                                  ! grid type
+         DO jh = 1, 12                                                                         ! 1, 2, 3, 4, 6, 12 hours
+            IF( MOD(12,jh) == 0 ) THEN 
+               WRITE(cl2,'(i2)') jh 
+               CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. )
+               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
+         END DO
+         DO jd = 1, 5, 2                                                                       ! 1, 3, 5 days
+            WRITE(cl1,'(i1)') jd 
+            CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. )
+            CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+         END DO
+         DO jm = 1, 6                                                                          ! 1, 2, 3, 4, 6 months
+            IF( MOD(6,jm) == 0 ) THEN 
+               WRITE(cl1,'(i1)') jm 
+               CALL dia_nam( clname, -jm, clsuff(jg) )
+               CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
+         END DO
+         DO jy = 1, 10                                                                         ! 1, 2, 5, 10 years  
+            IF( MOD(10,jy) == 0 ) THEN 
+               WRITE(cl2,'(i2)') jy 
+               CALL dia_nam( clname, -jy * iyymo, clsuff(jg) )
+               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
+         END DO
+      END DO
+
+      ! Zooms...
+      clgrd = (/ 'T', 'U', 'W' /) 
+      DO jg = 1, SIZE(clgrd)                                                                   ! grid type
+         cl1 = clgrd(jg)
+         ! Equatorial section (attributs: jbegin, ni, name_suffix)
+         CALL dom_ngb( 0., 0., ix, iy, cl1 )
+         CALL event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin     , iy     ) )
+         CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni         , jpiglo ) )
+         CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq'  ) )
+      END DO
+      ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
+      zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
+      zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /)
+      CALL set_mooring( zlontao, zlattao )
+      ! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonrama = (/  55.0,  67.0, 80.5, 90.0 /)
+      zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
+      CALL set_mooring( zlonrama, zlatrama )
+      ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonpira = (/ -38.0, -23.0, -10.0 /)
+      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
+      CALL set_mooring( zlonpira, zlatpira )
+      
+   END SUBROUTINE set_xmlatt
+
+
+   SUBROUTINE set_mooring( plon, plat)
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   automatic definitions of moorings xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in) ::  plon, plat           ! longitudes/latitudes oft the mooring
+      !
+!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name
+      CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name
+      CHARACTER(len=50)             ::   clname                   ! file name
+      CHARACTER(len=1)              ::   cl1                      ! 1 character
+      CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude
+      INTEGER                       ::   ji, jj, jg               ! loop counters
+      INTEGER                       ::   ix, iy                   ! i-,j- index
+      REAL(wp)                      ::   zlon, zlat
+      !!----------------------------------------------------------------------
+      DO jg = 1, SIZE(clgrd)
+         cl1 = clgrd(jg)
+         DO ji = 1, SIZE(plon)
+            DO jj = 1, SIZE(plat)
+               zlon = plon(ji)
+               zlat = plat(jj)
+               ! modifications for RAMA moorings
+               IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65.
+               IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95.
+               IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5.
+               ! modifications for PIRATA moorings
+               IF( zlon == -38. .AND. zlat == -19. )   zlon = -34.
+               IF( zlon == -38. .AND. zlat == -14. )   zlon = -32.
+               IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30.
+               IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35.
+               IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21.
+               IF( zlon == -10. .AND. zlat == -14. )   zlat = -10.
+               IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6.
+               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF
+               CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
+               IF( zlon >= 0. ) THEN  
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e'
+                  ENDIF
+               ELSE             
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w'
+                  ENDIF
+               ENDIF
+               IF( zlat >= 0. ) THEN  
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n'
+                  ENDIF
+               ELSE             
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's'
+                  ENDIF
+               ENDIF
+               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin     , ix                ) )
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin     , iy                ) )
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) )      
+            END DO
+         END DO
+      END DO
+      
+   END SUBROUTINE set_mooring
+
+#else
+
+   SUBROUTINE iom_setkt( kt )
+      INTEGER, INTENT(in   )::   kt 
+      IF( .FALSE. )   WRITE(numout,*) kt   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_setkt
+
+#endif
+
+
+   !!======================================================================
+END MODULE iom
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_ini.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_ini.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_ini.F90	(revision 4056)
@@ -0,0 +1,72 @@
+MODULE iom_ini
+
+USE dom_oce
+USE crs
+USE iom
+
+
+   IMPLICIT NONE
+   PRIVATE   !   must be public to be able to access iom_def through iom
+   
+PUBLIC iom_init
+
+CONTAINS
+
+   SUBROUTINE iom_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+#if defined key_iomput
+      REAL(wp) ::   ztmp
+      !!----------------------------------------------------------------------
+     ! read the xml file
+      IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)...
+      CALL iom_swap
+
+      ! calendar parameters
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ;   CALL event__set_calendar('gregorian')
+      CASE ( 0)   ;   CALL event__set_calendar('noleap'   )
+      CASE (30)   ;   CALL event__set_calendar('360d'     )
+      END SELECT
+      ztmp = fjulday - adatrj
+      IF( ABS(ztmp  - REAL(NINT(ztmp),wp)) < 0.1 / rday )   ztmp = REAL(NINT(ztmp),wp)   ! avoid truncation error
+      CALL event__set_time_parameters( nit000 - 1, ztmp, rdt )
+
+      ! horizontal grid definition
+      CALL set_scalar
+      CALL set_grid( "grid_T", glamt, gphit )
+      CALL set_grid( "grid_U", glamu, gphiu )
+      CALL set_grid( "grid_V", glamv, gphiv )
+      CALL set_grid( "grid_W", glamt, gphit )
+      !cc
+      IF(ln_crs) THEN
+      ! horizontal coarse grid definition
+         CALL setgrid_crs( "grid_T_crs", glamt_crs, gphit_crs )
+         CALL setgrid_crs( "grid_U_crs", glamu_crs, gphiu_crs )
+         CALL setgrid_crs( "grid_V_crs", glamv_crs, gphiv_crs )
+         CALL setgrid_crs( "grid_W_crs", glamt_crs, gphit_crs )
+      ENDIF
+
+      ! vertical grid definition
+      CALL event__set_vert_axis( "deptht", gdept_0 )
+      CALL event__set_vert_axis( "depthu", gdept_0 )
+      CALL event__set_vert_axis( "depthv", gdept_0 )
+      CALL event__set_vert_axis( "depthw", gdepw_0 )
+# if defined key_floats
+      CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp)  )
+# endif
+      
+      ! automatic definitions of some of the xml attributs
+      CALL set_xmlatt
+
+      ! end file definition
+      CALL event__close_io_definition
+#endif
+
+
+   END SUBROUTINE iom_init
+END MODULE iom_ini
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_ioipsl.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_ioipsl.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_ioipsl.F90	(revision 4056)
@@ -0,0 +1,438 @@
+MODULE iom_ioipsl
+   !!=====================================================================
+   !!                    ***  MODULE  iom_ioipsl ***
+   !! Input/Output manager :  Library to read input files with IOIPSL (only fliocom module)
+   !!====================================================================
+   !! History :  9.0  ! 05 12  (J. Belier) Original code
+   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
+   !!             "   ! 07 07  (D. Storkey) Changes to iom_ioipsl_gettime
+   !!--------------------------------------------------------------------
+   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis kvid in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+ !  USE dom_oce         ! ocean space and time domain
+   USE dom_oce, ONLY : glamt, gphit, gdept_0, nlci, nlcj, nldi, nldj, nlei, nlej, narea
+   USE iom_def         ! iom variables definitions
+   USE ioipsl          ! IOIPSL library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_ioipsl_open, iom_ioipsl_close, iom_ioipsl_varid, iom_ioipsl_get, iom_ioipsl_gettime, iom_ioipsl_rstput
+
+   INTERFACE iom_ioipsl_get
+      MODULE PROCEDURE iom_ioipsl_g0d, iom_ioipsl_g123d
+   END INTERFACE
+   INTERFACE iom_ioipsl_rstput
+      MODULE PROCEDURE iom_ioipsl_rp0123d
+   END INTERFACE
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: iom_ioipsl.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_ioipsl_open( cdname, kiomid, ldwrt, ldok, kdompar )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file with IOIPSL (only fliocom module)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! ioipsl identifier of the opened file
+      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
+      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
+      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
+
+      CHARACTER(LEN=100) ::   clinfo      ! info character
+      CHARACTER(LEN=10 ) ::   clstatus    ! status of opened file (REPLACE or NEW)
+      INTEGER            ::   iln         ! lengths of character
+      INTEGER            ::   istop       ! temporary storage of nstop
+      INTEGER            ::   ifliodom    ! model domain identifier (see flio_dom_set)
+      INTEGER            ::   ioipslid    ! ioipsl identifier of the opened file
+      INTEGER            ::   jl          ! loop variable
+      LOGICAL            ::   llclobber   ! local definition of ln_clobber
+      !---------------------------------------------------------------------
+
+      clinfo = '                    iom_ioipsl_open ~~~  '
+      istop = nstop
+      !
+      llclobber = ldwrt .AND. ln_clobber
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
+         !                 ! =============
+         IF( ldwrt ) THEN  ! ... in write mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
+            CALL flioopfd( TRIM(cdname), ioipslid, "WRITE" )
+         ELSE              ! ... in read mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            CALL flioopfd( TRIM(cdname), ioipslid )
+         ENDIF
+      ELSE                 ! the file does not exist
+         !                 ! =============
+         iln = INDEX( cdname, '.nc' )
+         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
+            IF( llclobber ) THEN   ;   clstatus = 'REPLACE 64' 
+            ELSE                   ;   clstatus = 'NEW 64'
+            ENDIF
+            IF( jpnij > 1 ) THEN
+               ! define the domain position regarding to the global domain (mainly useful in mpp)
+               CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/)   &
+                  &             , kdompar(:,1), kdompar(:,2), kdompar(:,3), kdompar(:,4), kdompar(:,5)   &
+                  &             , 'BOX', ifliodom )        
+               ! Note that fliocrfd may change the value of cdname (add the cpu number...)
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname(1:iln-1)//'... in WRITE mode'
+               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   &
+                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, ifliodom, mode = clstatus )
+            ELSE              ! the file should be open for read mode so it must exist...
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname//' in WRITE mode'
+               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   &
+                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid,           mode = clstatus )
+            ENDIF
+         ELSE              ! the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      ! start to fill file informations
+      ! =============
+      IF( istop == nstop ) THEN   ! no error within this routine
+!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
+         kiomid = 0
+         DO jl = jpmax_files, 1, -1
+            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
+         ENDDO
+         iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%nfid   = ioipslid
+         iom_file(kiomid)%iolib  = jpioipsl
+         iom_file(kiomid)%nvars  = 0
+         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files
+         CALL flioinqf( ioipslid, id_uld = iom_file(kiomid)%iduld )
+         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
+      ELSE
+         kiomid = 0               ! return error flag
+      ENDIF
+      !
+   END SUBROUTINE iom_ioipsl_open
+
+
+   SUBROUTINE iom_ioipsl_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_ioipsl_close  ***
+      !!
+      !! ** Purpose : close an input file with IOIPSL (only fliocom module) 
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      !---------------------------------------------------------------------
+      !
+      CALL flioclo( iom_file(kiomid)%nfid )
+      !    
+   END SUBROUTINE iom_ioipsl_close
+
+
+   FUNCTION iom_ioipsl_varid ( kiomid, cdvar, kiv, kdimsz )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file with IOIPSL (only fliocom module)
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER              , INTENT(in   )           ::   kiv   ! 
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      !
+      INTEGER                        ::   iom_ioipsl_varid  ! iom variable Id
+      INTEGER                        ::   ioipslid          ! ioipsl file identifier
+      INTEGER                        ::   ji                ! dummy loop index
+      INTEGER                        ::   i_nvd             ! number of dimension of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   idimid            ! dimension ids of the variable
+      LOGICAL                        ::   ll_fnd            ! found test
+      CHARACTER(LEN=100)             ::   clinfo            ! info character
+      !!-----------------------------------------------------------------------
+      clinfo = 'iom_ioipsl_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
+      iom_ioipsl_varid = 0                  ! default definition
+      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
+      ioipslid = iom_file(kiomid)%nfid      ! get back ioipsl file identifier 
+      CALL flioinqv( ioipslid, cdvar, ll_fnd, nb_dims = i_nvd )   ! does the variable exist in the file
+      IF( ll_fnd ) THEN
+         IF( i_nvd <= jpmax_dims ) THEN
+            iom_ioipsl_varid = kiv
+            iom_file(kiomid)%nvars       = kiv
+            iom_file(kiomid)%nvid(kiv)   = -1   ! variable id is not available in ioipsl
+            iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
+            iom_file(kiomid)%ndims(kiv)  = i_nvd
+            CALL flioinqv( ioipslid, cdvar, ll_fnd,   &
+                  &           len_dims = iom_file(kiomid)%dimsz(1:i_nvd,kiv), &   ! dimensions size
+                  &           id_dims  = idimid(1:i_nvd) )                        ! dimensions ids
+            iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
+            DO ji = 1, i_nvd                       ! find the unlimited dimension
+               IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.
+            END DO
+            !---------- Deal with scale_factor and add_offset
+            CALL flioinqa( ioipslid, cdvar, 'scale_factor', ll_fnd )
+            IF( ll_fnd) THEN
+               CALL fliogeta( ioipslid, cdvar, 'scale_factor', iom_file(kiomid)%scf(kiv) )
+            ELSE
+               iom_file(kiomid)%scf(kiv) = 1.
+            END IF
+            CALL flioinqa( ioipslid, cdvar, 'add_offset', ll_fnd )
+            IF( ll_fnd ) THEN
+               CALL fliogeta( ioipslid, cdvar, 'add_offset', iom_file(kiomid)%ofs(kiv) )
+            ELSE
+               iom_file(kiomid)%ofs(kiv) = 0.
+            END IF
+            ! return the simension size
+            IF( PRESENT(kdimsz) ) THEN 
+               IF( i_nvd == SIZE(kdimsz) ) THEN
+                  kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
+               ELSE
+                  WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
+                  CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
+               ENDIF
+            ENDIF
+         ELSE
+            CALL ctl_stop( TRIM(clinfo), 'Too many dimensions in the file '//iom_file(kiomid)%name,   &
+                  &                       'increase the parameter jpmax_vars')
+         ENDIF
+      ELSE  
+         iom_ioipsl_varid = -1   !   variable not found, return error code: -1
+      ENDIF
+      !
+   END FUNCTION iom_ioipsl_varid
+
+
+   SUBROUTINE iom_ioipsl_g0d( kiomid, kvid, pvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_ioipsl_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with IOIPSL (only fliocom module)
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   ) ::   kiomid    ! Identifier of the file
+      INTEGER , INTENT(in   ) ::   kvid      ! variable id
+      REAL(wp), INTENT(  out) ::   pvar      ! read field
+      !
+      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), pvar )
+      ! 
+   END SUBROUTINE iom_ioipsl_g0d
+
+
+   SUBROUTINE iom_ioipsl_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
+         &                      pv_r1d, pv_r2d, pv_r3d)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_ioipsl_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with IOIPSL (only fliocom module)
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kvid       ! Name of the variable
+      INTEGER                    , INTENT(in   )           ::   knbdim     ! number of dimensions of the variable
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart     ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount     ! number of points to be read in each axis
+      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
+      !
+      INTEGER               ::   ioipslid   ! ioipsl file identifier
+      CHARACTER(LEN=100)    ::   clvn       ! variable name
+      !---------------------------------------------------------------------
+      clvn = TRIM(iom_file(kiomid)%cn_var(kvid))   ! get back variable name 
+      ioipslid = iom_file(kiomid)%nfid             ! get back IPIPSL file id
+      !
+      IF( PRESENT(pv_r1d) ) THEN
+         CALL fliogetv( ioipslid, clvn, pv_r1d(:                ), start = kstart(1:knbdim), count = kcount(1:knbdim) )
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         CALL fliogetv( ioipslid, clvn, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim), count = kcount(1:knbdim) )
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         CALL fliogetv( ioipslid, clvn, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim), count = kcount(1:knbdim) )
+      ENDIF
+      !
+      !
+   END SUBROUTINE iom_ioipsl_g123d
+
+
+   SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis kvid in the file with IOIPSL (only fliocom module)
+      !!--------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier
+      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id
+      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute
+      !---------------------------------------------------------------------
+      !
+      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), ptime(:),   &
+            &         start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /) )
+      IF ( PRESENT(cdunits) ) THEN 
+         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "units", cdunits )
+      ENDIF
+      IF ( PRESENT(cdcalendar) ) THEN 
+         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "calendar", cdcalendar )
+      ENDIF
+      !
+   END SUBROUTINE iom_ioipsl_gettime
+
+
+   SUBROUTINE iom_ioipsl_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+         &                                 pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_ioipsl_rstput  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      !
+      INTEGER               :: idims                ! number of dimension
+      INTEGER               :: idvar                ! variable id
+      INTEGER               :: itype                ! variable type
+      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
+      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
+      CHARACTER(LEN=100)    :: clinfo               ! info character
+      INTEGER               :: ioipslid             ! ioipsl file identifier
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_ioipsl_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      ioipslid = iom_file(kiomid)%nfid
+      !
+      ! define dimension variables if it is not already done
+      ! ==========================
+      IF( iom_file(kiomid)%nvars == 0 ) THEN
+         ! define the dimension variables if it is not already done
+         CALL fliodefv( ioipslid,'nav_lon', (/1,2/), v_t=flio_r4   , axis='X',   &
+               &                  long_name="Longitude", units="degrees_east" )
+         CALL fliodefv( ioipslid,'nav_lat', (/1,2/), v_t=flio_r4   , axis='Y',   &
+               &                  long_name="Latitude", units="degrees_north" )
+         CALL fliodefv( ioipslid,'nav_lev', (/3/)  , v_t=flio_i4   , axis='Z',   &
+               &                  long_name="Model levels",units="model_levels")
+         CALL fliodefv( ioipslid,'time_counter', (/4/), v_t=flio_r4, axis='T',   &
+               &                  long_name="Time axis", units='seconds since 0001-01-01 00:00:00' )
+         ! update informations structure related the dimension variable we just added...
+         iom_file(kiomid)%nvars       = 4
+         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
+         iom_file(kiomid)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /)
+         iom_file(kiomid)%cn_var(4)   = 'time_counter'
+         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)
+         ! trick: defined to 0 to say that dimension variables are defined but not yet written
+         iom_file(kiomid)%dimsz(1, 1) = 0   
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
+      ENDIF
+
+      ! define the data if it is not already done
+      ! ===============
+      IF( kvid <= 0 ) THEN
+         ! variable definition
+         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
+         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
+         ENDIF
+         IF( PRESENT(ktype) ) THEN   ! variable external type
+            SELECT CASE (ktype)
+            CASE (jp_r8)  ;   itype = flio_r8
+            CASE (jp_r4)  ;   itype = flio_r4
+            CASE (jp_i4)  ;   itype = flio_i4
+            CASE (jp_i2)  ;   itype = flio_i2
+            CASE (jp_i1)  ;   itype = flio_i1   !   fliocom does not handle i1 type of variable
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
+            END SELECT
+         ELSE
+            itype = flio_r8
+         ENDIF
+         IF( PRESENT(pv_r0d) ) THEN   ;   CALL fliodefv (ioipslid, TRIM(cdvar)                 , v_t = itype)
+         ELSE                         ;   CALL fliodefv (ioipslid, TRIM(cdvar), idimid(1:idims), v_t = itype)
+         ENDIF
+         ! update informations structure related the new variable we want to add...
+         idvar                          = iom_file(kiomid)%nvars + 1
+         iom_file(kiomid)%nvars         = idvar
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%nvid(idvar)   = -1   ! netcdf variable id is not available in ioipsl
+         iom_file(kiomid)%scf(idvar)    = 1.
+         iom_file(kiomid)%ofs(idvar)    = 0.
+         iom_file(kiomid)%ndims(idvar)  = idims
+         IF( .NOT. PRESENT(pv_r0d) ) THEN
+            iom_file(kiomid)%luld(idvar) = .TRUE.
+            CALL flioinqf( ioipslid, ln_dim = idimsz )
+            iom_file(kiomid)%dimsz(1:idims-1,idvar) = idimsz(idimid(1:idims-1))
+         ELSE                               
+            iom_file(kiomid)%luld(idvar) = .FALSE.
+         ENDIF
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
+      ELSE
+         idvar = kvid
+      ENDIF
+
+      ! time step kwrite : write the variable
+      IF( kt == kwrite ) THEN
+         ! on what kind of domain must the data be written?
+         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
+            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
+            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
+               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
+               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
+               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+            ELSE 
+               CALL ctl_stop( 'iom_ioipsl_rp0123d: should have been an impossible case...' )
+            ENDIF
+
+            ! write dimension variables if it is not already done
+            ! =============
+            ! trick: is defined to 0 => dimension variable are defined but not yet written
+            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
+               CALL flioputv( ioipslid, 'nav_lon'     , glamt(ix1:ix2, iy1:iy2) )
+               CALL flioputv( ioipslid, 'nav_lat'     , gphit(ix1:ix2, iy1:iy2) )
+               CALL flioputv( ioipslid, 'nav_lev'     , gdept_0 )
+               ! +++ WRONG VALUE: to be improved but not really useful...
+               CALL flioputv( ioipslid, 'time_counter', kt )
+               ! update the values of the variables dimensions size
+               CALL flioinqf( ioipslid, ln_dim = idimsz )
+               iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2)
+               iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2)
+               iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/)
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
+            ENDIF
+         ENDIF
+
+         ! write the data
+         ! =============
+         IF(     PRESENT(pv_r0d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r0d                      )
+         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r1d(                  :) )
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r2d(ix1:ix2, iy1:iy2   ) )
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r3d(ix1:ix2, iy1:iy2, :) )
+         ENDIF
+         ! add 1 to the size of the temporal dimension (not really useful...)
+         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
+               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !     
+   END SUBROUTINE iom_ioipsl_rp0123d
+
+
+   !!======================================================================
+END MODULE iom_ioipsl
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_nf90.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_nf90.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_nf90.F90	(revision 4056)
@@ -0,0 +1,578 @@
+MODULE iom_nf90
+   !!=====================================================================
+   !!                    ***  MODULE  iom_nf90 ***
+   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
+   !!====================================================================
+   !! History :  9.0  ! 05 12  (J. Belier) Original code
+   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
+   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime
+   !!--------------------------------------------------------------------
+   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis kvid in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+ !  USE dom_oce         ! ocean space and time domain
+   USE dom_oce, ONLY : narea, nldi, nldj, nlei, nlej, nlci, nlcj, gdept_0, gphit, glamt
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE netcdf          ! NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput
+   PUBLIC iom_nf90_getatt
+
+   INTERFACE iom_nf90_get
+      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
+   END INTERFACE
+   INTERFACE iom_nf90_getatt
+      MODULE PROCEDURE iom_nf90_intatt
+   END INTERFACE
+   INTERFACE iom_nf90_rstput
+      MODULE PROCEDURE iom_nf90_rp0123d
+   END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: iom_nf90.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose : open an input file with NF90
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file
+      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
+      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
+      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
+
+      CHARACTER(LEN=100) ::   clinfo           ! info character
+      CHARACTER(LEN=100) ::   cltmp            ! temporary character
+      INTEGER            ::   iln              ! lengths of character
+      INTEGER            ::   istop            ! temporary storage of nstop
+      INTEGER            ::   if90id           ! nf90 identifier of the opened file
+      INTEGER            ::   idmy             ! dummy variable
+      INTEGER            ::   jl               ! loop variable
+      INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
+      INTEGER            ::   imode            ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER or NF90_HDF5
+      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
+      LOGICAL            ::   llclobber        ! local definition of ln_clobber
+      !---------------------------------------------------------------------
+
+      clinfo = '                    iom_nf90_open ~~~  '
+      istop = nstop   ! store the actual value of nstop
+      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz
+      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT
+      ENDIF
+      !
+      llclobber = ldwrt .AND. ln_clobber
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
+         !                 ! =============
+         IF( ldwrt ) THEN  ! ... in write mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
+            IF( snc4set%luse ) THEN
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id, chunksize = ichunk ), clinfo)
+            ENDIF
+            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                          ), clinfo)
+         ELSE              ! ... in read mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo)
+         ENDIF
+      ELSE                                       ! the file does not exist (or we overwrite it)
+         !                 ! =============
+         iln = INDEX( cdname, '.nc' )
+         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
+            IF( jpnij > 1 ) THEN
+               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
+               cdname = TRIM(cltmp)
+            ENDIF
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
+
+            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   )
+            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
+            ENDIF
+            IF( snc4set%luse ) THEN
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' creating file: '//TRIM(cdname)//' in hdf5 (netcdf4) mode'
+               CALL GET_NF90_SYMBOL("NF90_HDF5", ihdf5)
+               IF( llclobber ) THEN   ;   imode = IOR(ihdf5, NF90_CLOBBER)
+               ELSE                   ;   imode = IOR(ihdf5, NF90_NOCLOBBER)
+               ENDIF
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo)
+            ENDIF
+            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                     ), clinfo)
+            ! define dimensions
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo)
+            ! global attributes
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo)
+         ELSE              ! the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      ! start to fill file informations
+      ! =============
+      IF( istop == nstop ) THEN   ! no error within this routine
+!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
+         kiomid = 0
+         DO jl = jpmax_files, 1, -1
+            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
+         ENDDO
+         iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%nfid   = if90id
+         iom_file(kiomid)%iolib  = jpnf90
+         iom_file(kiomid)%nvars  = 0
+         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
+         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
+         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN
+           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,   &
+        &                                               name = iom_file(kiomid)%uldname), clinfo)
+         ENDIF
+         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
+      ELSE
+         kiomid = 0               ! return error flag
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_open
+
+
+   SUBROUTINE iom_nf90_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_close  ***
+      !!
+      !! ** Purpose : close an input file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      CHARACTER(LEN=100)  ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name)
+      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
+      !    
+   END SUBROUTINE iom_nf90_close
+
+
+   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER              , INTENT(in   )           ::   kiv   ! 
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      !
+      INTEGER                        ::   iom_nf90_varid   ! iom variable Id
+      INTEGER                        ::   if90id           ! nf90 file identifier
+      INTEGER                        ::   ji               ! dummy loop index
+      INTEGER                        ::   ivarid           ! NetCDF  variable Id
+      INTEGER                        ::   i_nvd            ! number of dimension of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   idimid           ! dimension ids of the variable
+      LOGICAL                        ::   llok             ! ok  test
+      CHARACTER(LEN=100)             ::   clinfo           ! info character
+      !!-----------------------------------------------------------------------
+      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      iom_nf90_varid = 0                    ! default definition
+      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
+      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id
+      !
+      llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
+      IF( llok ) THEN
+         iom_nf90_varid = kiv
+         iom_file(kiomid)%nvars       = kiv
+         iom_file(kiomid)%nvid(kiv)   = ivarid
+         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions
+         iom_file(kiomid)%ndims(kiv)  = i_nvd
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids
+         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
+         DO ji = 1, i_nvd                       ! dimensions size
+            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)   
+            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension? 
+         END DO
+         !---------- Deal with scale_factor and add_offset
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
+         IF( llok) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%scf(kiv) = 1.
+         END IF
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr
+         IF( llok ) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%ofs(kiv) = 0.
+         END IF
+         ! return the simension size
+         IF( PRESENT(kdimsz) ) THEN 
+            IF( i_nvd == SIZE(kdimsz) ) THEN
+               kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
+            ELSE
+               WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
+               CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
+            ENDIF
+         ENDIF
+      ELSE  
+         iom_nf90_varid = -1   !   variable not found, return error code: -1
+      ENDIF
+      !
+   END FUNCTION iom_nf90_varid
+
+
+   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      INTEGER , INTENT(in   ) ::   kvid     ! variable id
+      REAL(wp), INTENT(  out) ::   pvar     ! read field
+      !
+      CHARACTER(LEN=100)      ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar), clinfo )
+      ! 
+   END SUBROUTINE iom_nf90_g0d
+
+
+   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
+         &                    pv_r1d, pv_r2d, pv_r3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with NF90
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable
+      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis
+      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
+      !
+      CHARACTER(LEN=100) ::   clinfo               ! info character
+      INTEGER            ::   if90id               ! nf90 identifier of the opened file
+      INTEGER            ::   ivid                 ! nf90 variable id
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id
+      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id
+      !
+      IF(     PRESENT(pv_r1d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_g123d
+
+
+   SUBROUTINE iom_nf90_intatt( kiomid, cdatt, pvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_intatt  ***
+      !!
+      !! ** Purpose : read an integer attribute with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      INTEGER         , INTENT(  out) ::   pvar     ! read field
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      LOGICAL                         ::   llok     ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      ! 
+      if90id = iom_file(kiomid)%nfid
+      llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+      IF( llok) THEN
+         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
+         CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo)
+      ELSE
+         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
+         pvar = -999
+      ENDIF
+      ! 
+   END SUBROUTINE iom_nf90_intatt
+
+
+   SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis kvid in the file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier
+      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id
+      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute
+      !
+      CHARACTER(LEN=100) ::   clinfo     ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_gettime, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   &
+            &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo)
+      IF ( PRESENT(cdunits) ) THEN 
+         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", &
+            &                           values=cdunits), clinfo)
+      ENDIF
+      IF ( PRESENT(cdcalendar) ) THEN 
+         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", &
+            &                           values=cdcalendar), clinfo)
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_gettime
+
+
+   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+         &                               pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_rstput  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      !
+      INTEGER               :: idims                ! number of dimension
+      INTEGER               :: idvar                ! variable id
+      INTEGER               :: jd                   ! dimension loop counter   
+      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes   
+      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
+      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
+      CHARACTER(LEN=100)    :: clinfo               ! info character
+      CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character
+      INTEGER               :: if90id               ! nf90 file identifier
+      INTEGER               :: idmy                 ! dummy variable
+      INTEGER               :: itype                ! variable type
+      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using
+                                                    ! nn_nchunks_[i,j,k,t] namelist parameters
+      INTEGER               :: ichunkalg, ishuffle,&
+                               ideflate, ideflate_level
+                                                    ! NetCDF4 internally fixed parameters
+      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression
+                                                    ! when appropriate (currently chunking is applied to 4d fields only)
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      if90id = iom_file(kiomid)%nfid
+      !
+      ! define dimension variables if it is not already done
+      ! ==========================
+      IF( iom_file(kiomid)%nvars == 0 ) THEN
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! define the dimension variables if it is not already done
+         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
+         ! update informations structure related the dimension variable we just added...
+         iom_file(kiomid)%nvars       = 4
+         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
+         iom_file(kiomid)%cn_var(1:4) = cltmp
+         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)  
+         ! trick: defined to 0 to say that dimension variables are defined but not yet written
+         iom_file(kiomid)%dimsz(1, 1)  = 0   
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
+      ENDIF
+      ! define the data if it is not already done
+      ! ===============
+      IF( kvid <= 0 ) THEN
+         !
+         ! NetCDF4 chunking and compression fixed settings
+         ichunkalg = 0
+         ishuffle = 1
+         ideflate = 1
+         ideflate_level = 1
+         !
+         idvar = iom_file(kiomid)%nvars + 1
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! variable definition
+         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
+         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
+         ENDIF
+         IF( PRESENT(ktype) ) THEN   ! variable external type
+            SELECT CASE (ktype)
+            CASE (jp_r8)  ;   itype = NF90_DOUBLE
+            CASE (jp_r4)  ;   itype = NF90_FLOAT
+            CASE (jp_i4)  ;   itype = NF90_INT
+            CASE (jp_i2)  ;   itype = NF90_SHORT
+            CASE (jp_i1)  ;   itype = NF90_BYTE
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
+            END SELECT
+         ELSE
+            itype = NF90_DOUBLE
+         ENDIF
+         IF( PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    &
+                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
+         ELSE
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   &
+                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
+         ENDIF
+         lchunk = .false.
+         IF( snc4set%luse .AND. idims.eq.4 ) lchunk = .true.
+         ! update informations structure related the new variable we want to add...
+         iom_file(kiomid)%nvars         = idvar
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%scf(idvar)    = 1.
+         iom_file(kiomid)%ofs(idvar)    = 0.
+         iom_file(kiomid)%ndims(idvar)  = idims
+         IF( .NOT. PRESENT(pv_r0d) ) THEN   ;   iom_file(kiomid)%luld(idvar) = .TRUE.
+         ELSE                               ;   iom_file(kiomid)%luld(idvar) = .FALSE.
+         ENDIF
+         DO jd = 1, idims
+            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, idimid(jd), len = iom_file(kiomid)%dimsz(jd,idvar) ), clinfo)
+            IF ( lchunk ) ichunksz(jd) = iom_file(kiomid)%dimsz(jd,idvar)
+         END DO
+         IF ( lchunk ) THEN
+            ! Calculate chunk sizes by partitioning each dimension as requested in namnc4 namelist
+            ! Disallow very small chunk sizes and prevent chunk sizes larger than each individual dimension
+            ichunksz(1) = MIN( ichunksz(1),MAX( (ichunksz(1)-1)/snc4set%ni + 1 ,16 ) ) ! Suggested default nc4set%ni=4
+            ichunksz(2) = MIN( ichunksz(2),MAX( (ichunksz(2)-1)/snc4set%nj + 1 ,16 ) ) ! Suggested default nc4set%nj=2
+            ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6
+            ichunksz(4) = 1                                                            ! Do not allow chunks to span the
+                                                                                       ! unlimited dimension
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo)
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo)
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' chunked ok. Chunks sizes: ', ichunksz
+         ENDIF
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
+      ELSE
+         idvar = kvid
+      ENDIF
+
+      ! time step kwrite : write the variable
+      IF( kt == kwrite ) THEN
+         ! are we in write mode?
+         IF( iom_file(kiomid)%irec == -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = 0
+         ENDIF
+         ! on what kind of domain must the data be written?
+         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
+            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
+            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
+               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
+               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
+               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+            ELSE 
+               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
+            ENDIF
+
+            ! write dimension variables if it is not already done
+            ! =============
+            ! trick: is defined to 0 => dimension variable are defined but not yet written
+            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo)
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo)
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_0                 ), clinfo)
+               ! +++ WRONG VALUE: to be improved but not really useful...
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)   
+               ! update the values of the variables dimensions size
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)
+               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)
+               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
+            ENDIF
+         ENDIF
+
+         ! write the data
+         ! =============
+         IF(     PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r0d                      ), clinfo)
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r1d(                  :) ), clinfo)
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2   ) ), clinfo)
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)
+         ENDIF
+         ! add 1 to the size of the temporal dimension (not really useful...)
+         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
+               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !     
+   END SUBROUTINE iom_nf90_rp0123d
+
+
+   SUBROUTINE iom_nf90_check( kstatus, cdinfo )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_nf90_check  ***
+      !!
+      !! ** Purpose :   check nf90 errors
+      !!--------------------------------------------------------------------
+      INTEGER,          INTENT(in) :: kstatus
+      CHARACTER(LEN=*), INTENT(in) :: cdinfo
+      !---------------------------------------------------------------------
+      IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
+   END SUBROUTINE iom_nf90_check
+
+   !!======================================================================
+END MODULE iom_nf90
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_rstdimg.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_rstdimg.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/iom_rstdimg.F90	(revision 4056)
@@ -0,0 +1,506 @@
+MODULE iom_rstdimg
+   !!=====================================================================
+   !!                    ***  MODULE  iom_rstdimg ***
+   !! Input/Output manager :  Library to read input rstdimg files
+   !!====================================================================
+   !! History :  9.0  ! 06 09  (S. Masson) Original code
+   !!--------------------------------------------------------------------
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis kvid in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+  ! USE dom_oce         ! ocean space and time domain
+   USE dom_oce, ONLY : narea, nldi, nldj, nlei, nlej, nlci, nlcj, gdept_0, gphit, glamt, nlcit, nlcjt, nleit, nlejt, &
+                     & nimppt, njmppt, nldit, nldjt
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_rstdimg_open, iom_rstdimg_close, iom_rstdimg_get, iom_rstdimg_rstput
+
+   INTERFACE iom_rstdimg_get
+      MODULE PROCEDURE iom_rstdimg_g0d, iom_rstdimg_g123d
+   END INTERFACE
+   INTERFACE iom_rstdimg_rstput
+      MODULE PROCEDURE iom_rstdimg_rp0d, iom_rstdimg_rp123d
+   END INTERFACE
+
+   INTEGER, PARAMETER ::   jpvnl          = 32   ! variable name length
+      
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: iom_rstdimg.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_rstdimg_open( cdname, kiomid, ldwrt, ldok, kdompar )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file read only (return 0 if not found)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! iom identifier of the opened file
+      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
+      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
+      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
+
+      CHARACTER(LEN=100)                      ::   clinfo                     ! info character
+      CHARACTER(LEN=100)                      ::   cltmp                      ! temporary character
+      CHARACTER(LEN=10 )                      ::   clstatus                   ! status of opened file (REPLACE or NEW)
+      INTEGER                                 ::   jv                         ! loop counter
+      INTEGER                                 ::   istop                      ! temporary storage of nstop
+      INTEGER                                 ::   idrst                      ! logical unit of the restart file
+      INTEGER                                 ::   iln                        ! lengths of character
+      INTEGER                                 ::   irecl8                     ! record length
+      INTEGER                                 ::   ios                        ! IO status
+      INTEGER                                 ::   irhd                       ! record of the header infos
+      INTEGER                                 ::   ivnum                      ! number of variables
+      INTEGER                                 ::   ishft                      ! counter shift
+      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable
+      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables
+      INTEGER                                 ::   ipni, ipnj, ipnij, iarea   ! domain decomposition 
+      INTEGER                                 ::   iiglo, ijglo               ! domain global size 
+      INTEGER                                 ::   jl                         ! loop variable
+      LOGICAL                                 ::   llclobber                  ! local definition of ln_clobber
+      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables
+      REAL(wp),             DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record
+      !                                                                                   ! position for 1/2/3D variables
+      !---------------------------------------------------------------------
+      clinfo = '                    iom_rstdimg_open ~~~  '
+      istop = nstop      ! store the actual value of nstop
+      ios = 0            ! default definition
+      kiomid = 0         ! default definition
+      llclobber = ldwrt .AND. ln_clobber
+      ! get a free unit
+      idrst = get_unit()  ! get a free logical unit for the restart file
+!!$#if defined key_agrif 
+!!$      idrst = Agrif_Get_Unit()      
+!!$#endif 
+      ! Open the file...
+      ! =============
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
+         ! find the record length
+         OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
+            &       , RECL = 8, STATUS = 'old', ACTION = 'read', IOSTAT = ios, ERR = 987 )
+         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8
+         CLOSE( idrst )
+         ! Open the file with the appropriate record length and parameters
+         IF( ldwrt ) THEN  ! ... in readwrite mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READWRITE mode'
+            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
+               &       , RECL = irecl8, STATUS = 'old', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 )
+         ELSE              ! ... in read mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
+               &       , RECL = irecl8, STATUS = 'old', ACTION = 'read'     , IOSTAT = ios, ERR = 987 )
+         ENDIF
+      ELSE                                       ! the file does not exist (or we overwrite it)
+         iln = INDEX( cdname, '.dimg' )
+         IF( ldwrt ) THEN  ! the file should be open in readwrite mode so we create it...
+            irecl8= MAX( kdompar(1,1) * kdompar(2,1) * wp, ( 8*jpnij + 15 ) * 4 )
+            IF( jpnij > 1 ) THEN
+               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea, '.dimg'
+               cdname = TRIM(cltmp)
+            ENDIF
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in READWRITE mode'
+            
+            IF( llclobber ) THEN   ;   clstatus = 'REPLACE' 
+            ELSE                   ;   clstatus = 'NEW'
+            ENDIF
+            OPEN( idrst, FILE = TRIM(cdname), FORM = 'UNFORMATTED', ACCESS = 'DIRECT'   &
+               &       , RECL = irecl8, STATUS = TRIM(clstatus), ACTION = 'readwrite', IOSTAT = ios, ERR = 987 )
+         ELSE              ! the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      ! Performs checks on the file
+      ! =============
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! old file
+         READ( idrst, REC = 1   , IOSTAT = ios, ERR = 987 )              &
+              &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   &
+              &   ipni, ipnj, ipnij, iarea, iiglo, ijglo
+         READ( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                       &
+            &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   &
+            &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d)
+         clinfo = TRIM(clinfo)//' file '//TRIM(cdname)
+         IF( iiglo /= jpiglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in i direction' )
+         IF( ijglo /= jpjglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in j direction' )
+         IF( ldwrt ) THEN
+            IF( inx   /= kdompar(1,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in i direction' )
+            IF( iny   /= kdompar(2,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in j direction' )
+         ENDIF
+         IF( inz   /= jpk          )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in k direction' )
+         IF( ipni  /= jpni         )   CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along I' )
+         IF( ipnj  /= jpnj         )   CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along J' )
+         IF( ipnij /= jpnij        )   CALL ctl_stop( TRIM(clinfo), 'Total number of processors changed' )
+         IF( iarea /= narea        )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in area numbering ...' )
+      ENDIF
+      ! fill file informations
+      ! =============
+      IF( istop == nstop ) THEN   ! no error within this routine
+!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
+         kiomid = 0
+         DO jl = jpmax_files, 1, -1
+            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
+         ENDDO
+         iom_file(kiomid)%name    = TRIM(cdname)
+         iom_file(kiomid)%nfid    = idrst
+         iom_file(kiomid)%iolib   = jprstdimg
+         iom_file(kiomid)%iduld   = -1
+         IF( ldok ) THEN      ! old file
+            ! read variables informations from the file header
+            IF(  TRIM(clna0d(1)) == 'no0d' )   in0d = 0
+            IF(  TRIM(clna1d(1)) == 'no1d' )   in1d = 0
+            IF(  TRIM(clna2d(1)) == 'no2d' )   in2d = 0
+            IF(  TRIM(clna3d(1)) == 'no3d' )   in3d = 0
+            ivnum = in0d + in1d + in2d + in3d
+            iom_file(kiomid)%nvars            = ivnum
+            iom_file(kiomid)%irec             = 2 + in1d + in2d + inz * in3d
+            iom_file(kiomid)%luld(   1:ivnum) = .FALSE.
+            iom_file(kiomid)%scf(    1:ivnum) = 1.
+            ! scalar variable
+            DO jv = 1, in0d
+               iom_file(kiomid)%cn_var(jv) = TRIM(clna0d(jv))
+               iom_file(kiomid)%nvid(  jv) = 1
+               iom_file(kiomid)%ndims( jv) = 0
+               iom_file(kiomid)%ofs(   jv) = zval0d(jv)   ! warning: trick... we use ofs to store the value
+            END DO
+            ! 1d variable
+            ishft = in0d
+            DO jv = 1, in1d
+               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna1d(jv))
+               iom_file(kiomid)%nvid(      ishft + jv) = zval1d(jv)
+               iom_file(kiomid)%ndims(     ishft + jv) = 1
+               iom_file(kiomid)%dimsz(1  , ishft + jv) = jpk
+               iom_file(kiomid)%ofs(       ishft + jv) = 0.
+            END DO
+            ! 2d variable
+            ishft = in0d + in1d
+            DO jv = 1, in2d
+               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna2d(jv))
+               iom_file(kiomid)%nvid(      ishft + jv) = zval2d(jv)
+               iom_file(kiomid)%ndims(     ishft + jv) = 2
+               iom_file(kiomid)%dimsz(1:2, ishft + jv) = (/ inx, iny /)
+               iom_file(kiomid)%ofs(       ishft + jv) = 0.
+            END DO
+            ! 3d variable
+            ishft = in0d + in1d + in2d 
+            DO jv = 1, in3d
+               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna3d(jv))
+               iom_file(kiomid)%nvid(      ishft + jv) = zval3d(jv)
+               iom_file(kiomid)%ndims(     ishft + jv) = 3
+               iom_file(kiomid)%dimsz(1:3, ishft + jv) = (/ inx, iny, jpk /)
+               iom_file(kiomid)%ofs(       ishft + jv) = 0.
+            END DO
+         ELSE                 ! new file
+            iom_file(kiomid)%nvars = 0
+            iom_file(kiomid)%irec  = 2
+            ! store file informations
+            WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, kdompar(:,1), jpk   ! store domain size
+         ENDIF
+      ENDIF
+987   CONTINUE
+      IF( ios /= 0 ) THEN
+         WRITE(ctmp1,*) '           iostat = ', ios
+         CALL ctl_stop( TRIM(clinfo), '   error in opening file '//TRIM(cdname), ctmp1 )
+      ENDIF
+      !
+   END SUBROUTINE iom_rstdimg_open
+
+
+   SUBROUTINE iom_rstdimg_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_rstdimg_close  ***
+      !!
+      !! ** Purpose : close an input file
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      !
+      CHARACTER(LEN=100)                      ::   clinfo                     ! info character
+      INTEGER                                 ::   jv                         ! loop counter
+      INTEGER                                 ::   irecl8                     ! record length
+      INTEGER                                 ::   ios                        ! IO status
+      INTEGER                                 ::   irhd                       ! record of the header infos
+      INTEGER                                 ::   ivnum                      ! number of variables
+      INTEGER                                 ::   idrst                      ! file logical unit
+      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable
+      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables
+      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d    ! name of 0/1/2/3D variables
+      REAL(wp),          DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d    ! value of 0d variables or record
+      !                                                                               ! position for 1/2/3D variables
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_rstdimg_close ~~~  '
+      idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
+      ! test if we can write in the file (test with INQUIRE gives alsways YES even with read only files...)
+      READ(  idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   
+      WRITE( idrst, REC = 1, IOSTAT = ios            ) irecl8, inx, iny, inz   
+      ! We can write in the file => we update its header before closing
+      IF( ios == 0 ) THEN
+         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   ! get back domain size
+         irhd = iom_file(kiomid)%irec
+         ivnum = iom_file(kiomid)%nvars
+         in0d = 0   ;   in1d = 0   ;   in2d = 0   ;   in3d = 0
+         DO jv = 1, ivnum   ! loop on each variable to get its name and value/record position
+            SELECT CASE (iom_file(kiomid)%ndims(jv))
+            CASE (0)   ! scalar variable
+               in0d = in0d + 1
+               clna0d(in0d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval0d(in0d) = iom_file(kiomid)%ofs(jv)   ! warning: trick... we use ofs to store the value
+            CASE (1)   ! 1d variable
+               in1d = in1d + 1
+               clna1d(in1d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval1d(in1d) = iom_file(kiomid)%nvid(jv)
+            CASE (2)   ! 2d variable
+               in2d = in2d + 1
+               clna2d(in2d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval2d(in2d) = iom_file(kiomid)%nvid(jv)
+            CASE (3)   ! 3d variable
+               in3d = in3d + 1
+               clna3d(in3d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval3d(in3d) = iom_file(kiomid)%nvid(jv)
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo), 'Should not ne there...' )
+            END SELECT
+         END DO
+         ! force to have at least 1 variable in each list (not necessary (?), but safer...)
+         IF( in0d == 0 ) THEN   ;   in0d = 1   ;   clna0d(1) = 'no0d'   ;   zval0d(1) = -1.   ;   ENDIF
+         IF( in1d == 0 ) THEN   ;   in1d = 1   ;   clna1d(1) = 'no1d'   ;   zval1d(1) = -1.   ;   ENDIF
+         IF( in2d == 0 ) THEN   ;   in2d = 1   ;   clna2d(1) = 'no2d'   ;   zval2d(1) = -1.   ;   ENDIF
+         IF( in3d == 0 ) THEN   ;   in3d = 1   ;   clna3d(1) = 'no3d'   ;   zval3d(1) = -1.   ;   ENDIF
+         ! update the file header before closing it
+         WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 )              &
+            &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   &
+            &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo,              &
+            &   nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+         IF( (ivnum * (jpvnl + wp)) > irecl8 ) THEN 
+            CALL ctl_stop( TRIM(clinfo),   &
+                 &   'Last record size is too big... You could reduce the value of jpvnl' )
+         ELSE 
+            WRITE( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                        &
+                 &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   &
+                 &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d)
+         ENDIF
+      ELSE
+         ios = 0   ! we cannot write in the file
+      ENDIF
+      !
+      CLOSE( idrst, IOSTAT = ios, ERR = 987 )
+987   CONTINUE
+      IF( ios /= 0 ) THEN
+         WRITE(ctmp1,*) '           iostat = ', ios
+         CALL ctl_stop( TRIM(clinfo),   &
+            &   '   error when updating the header of '//TRIM(iom_file(kiomid)%name), ctmp1 )
+      ENDIF
+      !    
+   END SUBROUTINE iom_rstdimg_close
+
+
+   SUBROUTINE iom_rstdimg_g0d( kiomid, kvid, pvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_rstdimg_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with RSTDIMG
+      !!-----------------------------------------------------------------------
+      INTEGER,  INTENT(in   ) ::   kiomid    ! Identifier of the file
+      INTEGER,  INTENT(in   ) ::   kvid      ! variable id
+      REAL(wp), INTENT(  out) ::   pvar      ! read field
+      !---------------------------------------------------------------------
+      !
+      pvar = iom_file(kiomid)%ofs(kvid)   ! warning: trick... we use ofs to store the value
+      !
+   END SUBROUTINE iom_rstdimg_g0d
+
+
+   SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, kvid, pv_r0d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  ***
+      !!
+      !! ** Purpose : write a scalar with RSTDIMG
+      !!--------------------------------------------------------------------
+      INTEGER                   , INTENT(in) ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)          , INTENT(in) ::   cdvar    ! time axis name
+      INTEGER                   , INTENT(in) ::   kvid     ! variable id
+      REAL(wp)                  , INTENT(in) ::   pv_r0d   ! written 0d field
+      !
+      CHARACTER(LEN=100) ::   clinfo     ! info character
+      INTEGER            ::   idvar      ! variable id
+      !---------------------------------------------------------------------
+      !  
+      clinfo = '                    iom_rstdimg_rp0d ~~~  '
+      IF( kvid <= 0 ) THEN   !   new variable
+         idvar = iom_file(kiomid)%nvars + 1
+      ELSE                   !   the variable already exists in the file
+         idvar = kvid
+      ENDIF
+      IF( idvar <= jpmax_vars ) THEN
+         iom_file(kiomid)%nvars = idvar
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%nvid(   idvar) = 1   ! useless, Od variables a strored in record 1
+         iom_file(kiomid)%ndims(  idvar) = 0
+         iom_file(kiomid)%luld(   idvar) = .FALSE.
+         iom_file(kiomid)%scf(    idvar) = 1.
+         iom_file(kiomid)%ofs(    idvar) = pv_r0d   ! warning: trick... we use ofs to store the value
+      ELSE
+         CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' )
+      ENDIF
+   END SUBROUTINE iom_rstdimg_rp0d
+
+
+   SUBROUTINE iom_rstdimg_g123d( kiomid, kdom  , kvid, kx1, kx2, ky1, ky2,   &
+         &                       pv_r1d, pv_r2d, pv_r3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_rstdimg_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with RSTDIMG
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
+      INTEGER                    , INTENT(in   )           ::   kvid       ! variable id
+      INTEGER ,                    INTENT(inout)           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
+
+      CHARACTER(LEN=100) ::   clinfo               ! info character
+      INTEGER            ::   ios                  ! IO status
+      INTEGER            ::   jk                   ! loop counter
+      INTEGER            ::   idrst                ! logical unit of the restart file
+      !---------------------------------------------------------------------
+      clinfo = '                    iom_rstdimg_g123d ~~~  '
+      !
+      IF( kdom == jpdom_data .OR. kdom == jpdom_global ) THEN
+         CALL ctl_stop( TRIM(clinfo), TRIM(iom_file(kiomid)%cn_var(kvid))//': case not coded for rstdimg files' )
+      ELSE
+      !
+         idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
+         ! modify the subdomain indexes because we cannot directly extract the appropriate subdomaine
+         IF(     kdom == jpdom_local_full    ) THEN   ;   kx1 = 1   ;   kx2 = jpi    ;   ky1 = 1
+         ELSEIF( kdom == jpdom_local_noextra ) THEN   ;   kx1 = 1   ;   kx2 = nlci   ;   ky1 = 1
+         ENDIF
+         !
+         IF(     PRESENT(pv_r1d) ) THEN   ! read 1D variables
+            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r1d(:)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ! read 2D variables
+            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r2d(kx1:kx2, ky1:ky2    )
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ! read 3D variables
+            DO jk = 1, iom_file(kiomid)%dimsz(3,kvid)   ! do loop on each level
+               READ( idrst, REC = iom_file(kiomid)%nvid(kvid) + jk - 1, IOSTAT = ios, ERR = 987 )   pv_r3d(kx1:kx2, ky1:ky2, jk)
+            END DO
+         ENDIF
+987      CONTINUE
+         IF( ios /= 0 ) THEN
+            WRITE(ctmp1,*) '           iostat = ', ios
+            CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 )
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE iom_rstdimg_g123d
+
+
+   SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, kvid, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  ***
+      !!
+      !! ** Purpose : write a 2D/3D variable with RSTDIMG
+      !!--------------------------------------------------------------------
+      INTEGER                         , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! time axis name
+      INTEGER                         , INTENT(in)           ::   kvid     ! variable id
+      REAL(wp), DIMENSION(          :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:  ,:      ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:  ,:  ,:  ), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      !
+      CHARACTER(LEN=100)    ::   clinfo               ! info character
+      INTEGER               ::   irecl8               ! reacord length
+      INTEGER               ::   ios                  ! IO status
+      INTEGER               ::   idrst                ! reacord length
+      INTEGER               ::   inx, iny, inz        ! x,y,z dimension of the variable
+      INTEGER               ::   idvar                ! variable id
+      INTEGER               ::   istop                ! temporary storage of nstop
+      INTEGER               ::   irec                 ! record number
+      INTEGER               ::   ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER               ::   jk                   ! loop counter
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_rstdimg_rp123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      istop = nstop                   ! store the actual value of nstop
+      irec = iom_file(kiomid)%irec    ! get back the record number of the variable
+      idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
+      IF( kvid <= 0 ) THEN   !   new variable
+         idvar = iom_file(kiomid)%nvars + 1
+      ELSE                   !   the variable already exists in the file
+         idvar = kvid
+      ENDIF
+      IF( idvar > jpmax_vars )   CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' )
+      IF( .NOT. PRESENT(pv_r1d) ) THEN
+         ! find which part of data must be written
+         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz
+         IF(     inx == (nlei - nldi + 1) .AND. iny == (nlej - nldj + 1) ) THEN
+            ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+         ELSEIF( inx == nlci              .AND. iny == nlcj              ) THEN
+            ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+         ELSEIF( inx == jpi               .AND. iny == jpj               ) THEN
+            ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+         ELSE 
+            CALL ctl_stop( clinfo, 'should have been an impossible case...' )
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN
+         ! write the data
+         IF(     PRESENT(pv_r1d) ) THEN   ! 1D variable
+            WRITE( idrst, REC = irec            , IOSTAT = ios, ERR = 987 ) pv_r1d(:)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ! 2D variable
+            WRITE( idrst, REC = irec            , IOSTAT = ios, ERR = 987 ) pv_r2d(ix1:ix2, iy1:iy2    )
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ! 3D variable
+            DO jk = 1, jpk   ! do loop on each level
+               WRITE( idrst, REC = irec + jk - 1, IOSTAT = ios, ERR = 987 ) pv_r3d(ix1:ix2, iy1:iy2, jk)
+            END DO
+         ENDIF
+         ! fill the file informations
+         iom_file(kiomid)%nvars = idvar
+         IF(     PRESENT(pv_r1d) ) THEN
+            iom_file(kiomid)%irec              = irec + 1
+            iom_file(kiomid)%ndims(     idvar) = 1
+            iom_file(kiomid)%dimsz(1  , idvar) = inz
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            iom_file(kiomid)%irec              = irec + 1
+            iom_file(kiomid)%ndims(     idvar) = 2
+            iom_file(kiomid)%dimsz(1:2, idvar) = (/ inx, iny /)
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            iom_file(kiomid)%irec              = irec + inz
+            iom_file(kiomid)%ndims(     idvar) = 3
+            iom_file(kiomid)%dimsz(1:3, idvar) = (/ inx, iny, inz /)
+         ENDIF
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%nvid(  idvar) = irec
+         iom_file(kiomid)%luld(  idvar) = .FALSE.
+         iom_file(kiomid)%scf(   idvar) = 1.
+         iom_file(kiomid)%ofs(   idvar) = 0.
+      ENDIF
+987   CONTINUE
+      IF( ios /= 0 ) THEN
+         WRITE(ctmp1,*) '           iostat = ', ios
+         CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 )
+      ELSE
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !     
+   END SUBROUTINE iom_rstdimg_rp123d
+
+
+   !!======================================================================
+END MODULE iom_rstdimg
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lbclnk.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lbclnk.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lbclnk.F90	(revision 4056)
@@ -0,0 +1,271 @@
+MODULE lbclnk
+   !! jes. Remove this from MY_SRC no mods done.
+   !!======================================================================
+   !!                       ***  MODULE  lbclnk  ***
+   !! Ocean        : 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  
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   '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_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE lib_mpp          ! distributed memory computing library
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE mpp_lnk_2d_e
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC lbc_lnk_e
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lbclnk.F90 2442 2010-11-27 18:05:38Z gm $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!----------------------------------------------------------------------
+   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
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE lbc_lnk_2d
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC   lbc_lnk_e 
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lbclnk.F90 2442 2010-11-27 18:05:38Z gm $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   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.e0
+      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.e0
+      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
+            
+            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
+
+#endif
+
+   !!======================================================================
+END MODULE lbclnk
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lbcnfd.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lbcnfd.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lbcnfd.F90	(revision 4056)
@@ -0,0 +1,365 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
+   !!   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)
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
+   END INTERFACE
+
+   PUBLIC   lbc_nfd   ! north fold conditions
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lbcnfd.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+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
+            !                                        (the 2 North Poles are at (i,j) = (2,jpjglo-1) and (jpiglo/2+1,jpjglo-1)
+            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,ijpjm1,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_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) ::   pt2d      ! 2D array on which the boundary condition is applied
+      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
+      !
+      INTEGER  ::   ji, jl, ipr2dj
+      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
+      !
+      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
+         ipr2dj = pr2dj
+         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
+      ELSE
+         ipr2dj = 0 
+      ENDIF
+      !
+      ijpjm1 = ijpj-1
+
+      SELECT CASE ( npolj )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( cd_type )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO jl = 0, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt=jpiglo-ji+2
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-2)
+            DO ji = jpiglo/2+1, jpiglo
+               ijt=jpiglo-ji+2
+               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO jl = 0, ipr2dj
+               DO ji = 2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            pt2d(   1  ,ijpj) = psgn * pt2d(    2   ,ijpj-2)
+            pt2d(jpiglo,ijpj) = psgn * pt2d(jpiglo-1,ijpj-2)
+            pt2d(1,ijpj-1) = psgn * pt2d(jpiglo,ijpj-1)   
+            
+            DO ji = jpiglo/2, jpiglo-1
+               iju = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO jl = -1, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt2d(ji,ijpj+jl)   = psgn * pt2d(ijt,ijpj-3-jl)
+               END DO
+            END DO
+            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3) 
+            
+         CASE ( 'F' )                                     ! F-point
+            DO jl = -1, ipr2dj
+               DO ji = 2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
+               END DO
+            END DO
+            pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3)
+            pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3)
+            pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)      
+            pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)      
+         CASE ( 'I' )                                     ! ice U-V point (I-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 ( '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 )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
+               END DO
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
+               END DO
+            END DO
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
+         CASE ( 'V' )                                     ! V-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo
+               ijt = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
+            DO ji = jpiglo/2+1, jpiglo-1
+               iju = jpiglo-ji
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'I' )                                  ! ice U-V point (I-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)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
+               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)
+         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'F' )                                   ! F-point
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         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
+         END SELECT
+         !
+      END SELECT
+      !
+   END SUBROUTINE lbc_nfd_2d
+
+   !!======================================================================
+END MODULE lbcnfd
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/ldfslp.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/ldfslp.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/ldfslp.F90	(revision 4056)
@@ -0,0 +1,823 @@
+MODULE ldfslp
+   !!======================================================================
+   !!                       ***  MODULE  ldfslp  ***
+   !! Ocean physics: slopes of neutral surfaces
+   !!======================================================================
+   !! History :  OPA  ! 1994-12  (G. Madec, M. Imbard)  Original code
+   !!            8.0  ! 1997-06  (G. Madec)  optimization, lbc
+   !!            8.1  ! 1999-10  (A. Jouzeau)  NEW profile in the mixed layer
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  Free form, F90
+   !!             -   ! 2005-10  (A. Beckmann)  correction for s-coordinates
+   !!            3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  add Griffies operator
+   !!             -   ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      Rotation of lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator)
+   !!   ldf_slp      : calculates the slopes of neutral surface   (Madec operator)
+   !!   ldf_slp_mxl  : calculates the slopes at the base of the mixed layer (Madec operator)
+   !!   ldf_slp_init : initialization of the slopes computation
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! lateral diffusion: traceur
+   USE ldfdyn_oce      ! lateral diffusion: dynamics
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer depth
+   USE eosbn2          ! equation of states
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_slp        ! routine called by step.F90
+   PUBLIC   ldf_slp_grif   ! routine called by step.F90
+   PUBLIC   ldf_slp_init   ! routine called by opa.F90
+
+   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag
+   !                                                                             !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp, wslpi          !: i_slope at U- and W-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp, wslpj          !: j-slope at V- and W-points
+   !                                                                !! Griffies operator
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
+
+   !                                                              !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer
+
+   REAL(wp) ::   repsln = 1.e-25_wp       ! tiny value used as minium of di(rho), dj(rho) and dk(rho)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: ldfslp.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_slp( kt, prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp  ***
+      !!
+      !! ** Purpose :   Compute the slopes of neutral surface (slope of isopycnal
+      !!              surfaces referenced locally) (ln_traldf_iso=T).
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at U- and
+      !!      W-points (uslp, wslpi) and the slope in the j-direction is
+      !!      computed at V- and W-points (vslp, wslpj).
+      !!      They are bounded by 1/100 over the whole ocean, and within the
+      !!      surface layer they are bounded by the distance to the surface
+      !!      ( slope<= depth/l  where l is the length scale of horizontal
+      !!      diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!      of 10cm/s)
+      !!        A horizontal shapiro filter is applied to the slopes
+      !!        ln_sco=T, s-coordinate, add to the previously computed slopes
+      !!      the slope of the model level surface.
+      !!        macro-tasked on horizontal slab (jk-loop)  (2, jpk-1)
+      !!      [slopes already set to zero at level 1, and to zero or the ocean
+      !!      bottom slope (ln_sco=T) at level jpk in inildf]
+      !!
+      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes
+      !!               of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.)
+      !!
+      INTEGER  ::   ji , jj , jk    ! dummy loop indices
+      INTEGER  ::   ii0, ii1, iku   ! temporary integer
+      INTEGER  ::   ij0, ij1, ikv   ! temporary integer
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
+
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      z1_16  =  1.0_wp / 16._wp
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      zww(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      !
+      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
+               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+      DO jk = 2, jpkm1
+         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+         !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
+         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
+         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2
+         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster
+         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              &
+            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) )
+      END DO
+      !
+      !                          !==   Slopes just below the mixed layer   ==!
+      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
+
+
+      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd )
+      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1                            !* Slopes at u and v points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                      ! horizontal and vertical density gradient at u- and v-points
+               zau = zgru(ji,jj,jk) / e1u(ji,jj)
+               zav = zgrv(ji,jj,jk) / e2v(ji,jj)
+               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
+               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  )
+               !                                      ! uslp and vslp output in zwz and zww, resp.
+               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              &
+                  &                   + zfi  * uslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              &
+                  &                   + zfj  * vslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk)
+!!gm  modif to suppress omlmask.... (as in Griffies case)
+!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
+!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
+!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
+!               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
+      !
+      !                                            !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
+                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
+               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
+                  &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp
+            END DO
+         END DO
+      END DO
+
+
+      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd )
+      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                  !* Local vertical density gradient evaluated from N^2
+               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+               !                                  !* Slopes at w point
+               !                                        ! i- & j-gradient of density at w-points
+               zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
+                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
+               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
+                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) *  e2t(ji,jj)
+               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
+                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask (ji,jj,jk)
+               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask (ji,jj,jk)
+               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  )
+               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+               zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )
+               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk)
+
+!!gm  modif to suppress omlmask....  (as in Griffies operator)
+!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
+!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
+!               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
+!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
+      !
+      !                                           !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               zcofw = tmask(ji,jj,jk) * z1_16
+               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcofw = tmask(ji,jj,jk) * z1_16
+               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
+                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
+               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck
+               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck
+            END DO
+         END DO
+      END DO
+
+      ! III.  Specific grid points
+      ! ===========================
+      !
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area
+         !                                                    ! Gibraltar Strait
+         ij0 =  50   ;   ij1 =  53
+         ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ij0 =  51   ;   ij1 =  53
+         ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         !
+         !                                                    ! Mediterrannean Sea
+         ij0 =  49   ;   ij1 =  56
+         ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ij0 =  50   ;   ij1 =  56
+         ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+      ENDIF
+
+
+      ! IV. Lateral boundary conditions
+      ! ===============================
+      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
+      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
+
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)
+         CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp')
+      !
+   END SUBROUTINE ldf_slp
+
+
+   SUBROUTINE ldf_slp_grif ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_grif  ***
+      !!
+      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T)
+      !!      at W-points using the Griffies quarter-cells.
+      !!
+      !! ** Method  :   calculates alpha and beta at T-points
+      !!
+      !! ** Action : - triadi_g, triadj_g   T-pts i- and j-slope triads relative to geopot. (used for eiv)
+      !!             - triadi , triadj    T-pts i- and j-slope triads relative to model-coordinate
+      !!             - wslp2              squared slope of neutral surfaces at w-points.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices
+      INTEGER  ::   iku, ikv                    ! local integer
+      REAL(wp) ::   zfacti, zfactj              ! local scalars
+      REAL(wp) ::   znot_thru_surface           ! local scalars
+      REAL(wp) ::   zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj
+      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim
+      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim
+      REAL(wp) ::   zdzrho_raw
+      REAL(wp) ::   zbeta0
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_grif')
+      !
+      CALL wrk_alloc( jpi,jpj, z1_mlbw )
+      CALL wrk_alloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      !--------------------------------!
+      !  Some preliminary calculation  !
+      !--------------------------------!
+      !
+      CALL eos_alpbet( tsb, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==!
+      !
+      DO jl = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
+         !
+         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln)
+         DO jk = 1, jpkm1                     ! done each pair of triad
+            DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set
+               DO ji = 1, fs_jpim1            ! vector opt.
+                  zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point
+                  zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point
+                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_zps.and.l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom
+# if defined key_vectopt_loop
+            DO jj = 1, 1
+               DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling)
+# else
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+# endif
+                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points)
+                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
+                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
+                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+
+      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
+         DO jk = 1, jpkm1                     ! done each pair of triad
+            DO jj = 1, jpj                    ! NB: not masked ==>  a minimum value is set
+               DO ji = 1, jpi                 ! vector opt.
+                  IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp
+                     zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) )
+                     zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) )
+                  ELSE
+                     zdkt = 0._wp                                             ! 1st level gradient set to zero
+                     zdks = 0._wp
+                  ENDIF
+                  zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)
+                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln
+                 END DO
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 1, jpj                          !==  Reciprocal depth of the w-point below ML base  ==!
+         DO ji = 1, jpi
+            jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
+            z1_mlbw(ji,jj) = 1._wp / fsdepw(ji,jj,jk)
+         END DO
+      END DO
+      !
+      !                                       !==  intialisations to zero  ==!
+      !
+      wslp2  (:,:,:)     = 0._wp              ! wslp2 will be cumulated 3D field set to zero
+      triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj_g(:,:,1,:,:) = 0._wp   ;   triadj_g(:,:,jpk,:,:) = 0._wp
+      !!gm _iso set to zero missing
+      triadi  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp
+
+      !-------------------------------------!
+      !  Triads just below the Mixed Layer  !
+      !-------------------------------------!
+      !
+      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base
+         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  ip = jl   ;   jp = jl
+                  jk = MIN( nmln(ji+ip,jj) , mbkt(ji+ip,jj) ) + 1         ! ML level+1 (MIN in case ML depth is the ocean depth)
+                  ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                  zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
+                     &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk)
+                  jk = MIN( nmln(ji,jj+jp) , mbkt(ji,jj+jp) ) + 1
+                  ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                     &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
+                  zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !-------------------------------------!
+      !  Triads with surface limits         !
+      !-------------------------------------!
+      !
+      DO kp = 0, 1                            ! k-index of triads
+         DO jl = 0, 1
+            ip = jl   ;   jp = jl             ! i- and j-indices of triads (i-k and j-k planes)
+            DO jk = 1, jpkm1
+               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface
+               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1         ! vector opt.
+                     !
+                     ! Calculate slope relative to geopotentials used for GM skew fluxes
+                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                     ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point
+                     ! masked by umask taken at the level of dz(rho)
+                     !
+                     ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti)
+                     !
+                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked
+                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp)
+
+                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface
+                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj)
+                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)                  ! unmasked
+                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
+                     ztj_g_raw = ztj_raw - ztj_coord
+                     zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     !
+                     ! Below  ML use limited zti_g as is & mask
+                     ! Inside ML replace by linearly reducing sx_mlb towards surface & mask
+                     !
+                     zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1
+                     zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1
+                     !                                                          !                   otherwise  zfact=0
+                     zti_g_lim =          ( zfacti   * zti_g_lim                       &
+                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   &
+                        &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)
+                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
+                        &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)
+                     !
+                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim
+                     triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim
+                     !
+                     ! Get coefficients of isoneutral diffusion tensor
+                     ! 1. Utilise gradients *relative* to s-coordinate, so add t-point slopes (*subtract* depth gradients)
+                     ! 2. We require that isoneutral diffusion  gives no vertical buoyancy flux
+                     !     i.e. 33 term = (real slope* 31, 13 terms)
+                     ! To do this, retain limited sx**2  in vertical flux, but divide by real slope for 13/31 terms
+                     ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2
+                     !
+                     zti_lim  = ( zti_g_lim + zti_coord ) * umask(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces
+                     ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask(ji,jj,jk+kp)
+                     !
+                     IF( ln_triad_iso ) THEN
+                        zti_raw = zti_lim**2 / zti_raw
+                        ztj_raw = ztj_lim**2 / ztj_raw
+                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw )
+                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw )
+                        zti_lim =           zfacti   * zti_lim                       &
+                        &      + ( 1._wp - zfacti ) * zti_raw
+                        ztj_lim =           zfactj   * ztj_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_raw
+                     ENDIF
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim
+                    !
+                     zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   )
+                     zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   )
+                     zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp)
+                     zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp)
+                     !
+                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked
+                     wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked
+                     wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      wslp2(:,:,1) = 0._wp                ! force the surface wslp to zero
+
+      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked
+      !
+      CALL wrk_dealloc( jpi,jpj, z1_mlbw )
+      CALL wrk_dealloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_grif')
+      !
+   END SUBROUTINE ldf_slp_grif
+
+
+   SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_mxl  ***
+      !!
+      !! ** Purpose :   Compute the slopes of iso-neutral surface just below
+      !!              the mixed layer.
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at u- & w-points
+      !!              (uslpml, wslpiml) and the slope in the j-direction is computed
+      !!              at v- and w-points (vslpml, wslpjml) with the same bounds as
+      !!              in ldf_slp.
+      !!
+      !! ** Action  :   uslpml, wslpiml :  i- &  j-slopes of neutral surfaces
+      !!                vslpml, wslpjml    just below the mixed layer
+      !!                omlmask         :  mixed layer mask
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   prd            ! in situ density
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point)
+      !!
+      INTEGER  ::   ji , jj , jk                   ! dummy loop indices
+      INTEGER  ::   iku, ikv, ik, ikm1             ! local integers
+      REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_mxl')
+      !
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
+      vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp
+      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp
+      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp
+      !
+      !                                            !==   surface mixed layer mask   !
+      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij                        ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+# endif
+               ik = nmln(ji,jj) - 1
+               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+
+      ! Slopes of isopycnal surfaces just before bottom of mixed layer
+      ! --------------------------------------------------------------
+      ! The slope are computed as in the 3D case.
+      ! A key point here is the definition of the mixed layer at u- and v-points.
+      ! It is assumed to be the maximum of the two neighbouring T-point mixed layer depth.
+      ! Otherwise, a n2 value inside the mixed layer can be involved in the computation
+      ! of the slope, resulting in a too steep diagnosed slope and thus a spurious eddy
+      ! induce velocity field near the base of the mixed layer.
+      !-----------------------------------------------------------------------
+      !
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==!
+            !
+            !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
+            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !
+            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
+            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
+            !                        !- horizontal density gradient at u- & v-points
+            zau = p_gru(ji,jj,iku) / e1u(ji,jj)
+            zav = p_grv(ji,jj,ikv) / e2v(ji,jj)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  )
+            !                        !- Slope at u- & v-points (uslpml, vslpml)
+            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku)
+            vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask(ji,jj,ikv)
+            !
+            !                        !==   i- & j-slopes at w-points just below the Mixed Layer   ==!
+            !
+            ik   = MIN( nmln(ji,jj) + 1, jpk )
+            ikm1 = MAX( 1, ik-1 )
+            !                        !- vertical density gradient for w-slope (from N^2)
+            zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
+            !                        !- horizontal density i- & j-gradient at w-points
+            zci = MAX(   umask(ji-1,jj,ik  ) + umask(ji,jj,ik  )           &
+               &       + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps  ) * e1t(ji,jj)
+            zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           &
+               &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj)
+            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)           &
+               &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask(ji,jj,ik)
+            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           &
+               &       + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1)  ) / zcj  * tmask(ji,jj,ik)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  )
+            !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
+            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
+         END DO
+      END DO
+      !!gm this lbc_lnk should be useless....
+      CALL lbc_lnk( uslpml , 'U', -1. )   ;   CALL lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change)
+      CALL lbc_lnk( wslpiml, 'W', -1. )   ;   CALL lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_mxl')
+      !
+   END SUBROUTINE ldf_slp_mxl
+
+
+   SUBROUTINE ldf_slp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_init  ***
+      !!
+      !! ** Purpose :   Initialization for the isopycnal slopes computation
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameter
+      !!      values called by tra_dmp at the first timestep (nit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ierr         ! local integer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr )
+         ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr )
+         IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' )
+         !
+         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' )
+         !
+      ELSE                             ! Madec operator : slopes at u-, v-, and w-points
+         ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                &
+            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr )
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' )
+
+         ! Direction of lateral diffusion (tracers and/or momentum)
+         ! ------------------------------
+         uslp (:,:,:) = 0._wp   ;   uslpml (:,:) = 0._wp      ! set the slope to zero (even in s-coordinates)
+         vslp (:,:,:) = 0._wp   ;   vslpml (:,:) = 0._wp
+         wslpi(:,:,:) = 0._wp   ;   wslpiml(:,:) = 0._wp
+         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp
+
+         !!gm I no longer understand this.....
+         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN
+            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
+
+            ! geopotential diffusion in s-coordinates on tracers and/or momentum
+            ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+
+            ! set the slope of diffusion to the slope of s-surfaces
+            !      ( c a u t i o n : minus sign as fsdep has positive value )
+            DO jk = 1, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk)
+                     vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk)
+                     wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
+                     wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions
+            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init')
+      !
+   END SUBROUTINE ldf_slp_init
+
+#else
+   !!------------------------------------------------------------------------
+   !!   Dummy module :                 NO Rotation of lateral mixing tensor
+   !!------------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag
+CONTAINS
+   SUBROUTINE ldf_slp( kt, prd, pn2 )   ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2
+      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)
+   END SUBROUTINE ldf_slp
+   SUBROUTINE ldf_slp_grif( kt )        ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt
+   END SUBROUTINE ldf_slp_grif
+   SUBROUTINE ldf_slp_init              ! Dummy routine
+   END SUBROUTINE ldf_slp_init
+#endif
+
+   !!======================================================================
+END MODULE ldfslp
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/ldfslp_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/ldfslp_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/ldfslp_crs.F90	(revision 4056)
@@ -0,0 +1,833 @@
+MODULE ldfslp_crs
+   !!======================================================================
+   !!                       ***  MODULE  ldfslp  ***
+   !! Ocean physics: slopes of neutral surfaces
+   !!======================================================================
+   !! History :  OPA  ! 1994-12  (G. Madec, M. Imbard)  Original code
+   !!            8.0  ! 1997-06  (G. Madec)  optimization, lbc
+   !!            8.1  ! 1999-10  (A. Jouzeau)  NEW profile in the mixed layer
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  Free form, F90
+   !!             -   ! 2005-10  (A. Beckmann)  correction for s-coordinates
+   !!            3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  add Griffies operator
+   !!             -   ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      Rotation of lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator)
+   !!   ldf_slp      : calculates the slopes of neutral surface   (Madec operator)
+   !!   ldf_slp_mxl  : calculates the slopes at the base of the mixed layer (Madec operator)
+   !!   ldf_slp_init : initialization of the slopes computation
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! lateral diffusion: traceur
+   USE ldfdyn_oce      ! lateral diffusion: dynamics
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer depth
+   USE eosbn2_crs      ! equation of states
+   USE crslbclnk       ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_slp_crs        ! routine called by step.F90
+   PUBLIC   ldf_slp_grif_crs   ! routine called by step.F90
+   PUBLIC   ldf_slp_init_crs   ! routine called by opa.F90
+
+ !  LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp_crs = .TRUE.     !: slopes flag
+   !                                                                             !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp_crs, wslpi_crs          !: i_slope at U- and W-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp_crs, wslpj_crs          !: j-slope at V- and W-points
+   !                                                                !! Griffies operator
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
+
+   !                                                              !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer
+
+   REAL(wp) ::   repsln = 1.e-25_wp       ! tiny value used as minium of di(rho), dj(rho) and dk(rho)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: ldfslp.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_slp_crs( kt, prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp  ***
+      !!
+      !! ** Purpose :   Compute the slopes of neutral surface (slope of isopycnal
+      !!              surfaces referenced locally) (ln_traldf_iso=T).
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at U- and
+      !!      W-points (uslp, wslpi) and the slope in the j-direction is
+      !!      computed at V- and W-points (vslp, wslpj).
+      !!      They are bounded by 1/100 over the whole ocean, and within the
+      !!      surface layer they are bounded by the distance to the surface
+      !!      ( slope<= depth/l  where l is the length scale of horizontal
+      !!      diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!      of 10cm/s)
+      !!        A horizontal shapiro filter is applied to the slopes
+      !!        ln_sco=T, s-coordinate, add to the previously computed slopes
+      !!      the slope of the model level surface.
+      !!        macro-tasked on horizontal slab (jk-loop)  (2, jpk-1)
+      !!      [slopes already set to zero at level 1, and to zero or the ocean
+      !!      bottom slope (ln_sco=T) at level jpk in inildf]
+      !!
+      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes
+      !!               of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.)
+      !!
+      INTEGER  ::   ji , jj , jk    ! dummy loop indices
+      INTEGER  ::   ii0, ii1, iku   ! temporary integer
+      INTEGER  ::   ij0, ij1, ikv   ! temporary integer
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp')
+      !
+      CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zwz, zww, zdzr, zgru, zgrv )
+
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      z1_16  =  1.0_wp / 16._wp
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      zww(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      !
+      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgru(ji,jj,jk) = umask_crs(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
+               zgrv(ji,jj,jk) = vmask_crs(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               zgru(ji,jj,mbku_crs(ji,jj)) = gru_crs(ji,jj)
+               zgrv(ji,jj,mbkv_crs(ji,jj)) = grv_crs(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+      DO jk = 2, jpkm1
+         !                               !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
+         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
+         !                                    ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+         !                             !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2
+         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster
+         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              &
+            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask_crs(:,:,jk+1) )
+      END DO
+      !
+      !                          !==   Slopes just below the mixed layer   ==!
+      CALL ldf_slp_mxl_crs( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
+
+
+      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd )
+      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1                            !* Slopes at u and v points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                      ! horizontal and vertical density gradient at u- and v-points
+               zau = zgru(ji,jj,jk) / e1u_crs(ji,jj)
+               zav = zgrv(ji,jj,jk) / e2v_crs(ji,jj)
+               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
+               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,jk)* ABS( zav )  )
+               !                                      ! uslp and vslp output in zwz and zww, resp.
+               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              &
+                  &                   + zfi  * uslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( gdept_crs(ji+1,jj,jk)+gdept_crs(ji,jj,jk) - e3u_max_crs(ji,jj,1) )   &
+                  &                          / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji+1,jj), 5._wp ) ) * umask_crs(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              &
+                  &                   + zfj  * vslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( gdept_crs(ji,jj+1,jk)+ gdept_crs(ji,jj,jk)-e3u_max_crs(ji,jj,1) )   &
+                  &                          / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji,jj+1), 5. ) ) * vmask_crs(ji,jj,jk)
+!!gm  modif to suppress omlmask.... (as in Griffies case)
+!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
+!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
+!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
+!               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL crs_lbc_lnk( zwz, 'U', -1. )   ;   CALL crs_lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
+      !
+      !                                            !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               uslp_crs(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp_crs(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp_crs(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp_crs(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp_crs(ji,jj,jk) = uslp_crs(ji,jj,jk) * ( umask_crs(ji,jj+1,jk) + umask_crs(ji,jj-1,jk  ) ) * 0.5_wp   &
+                  &                            * ( umask_crs(ji,jj  ,jk) + umask_crs(ji,jj  ,jk+1) ) * 0.5_wp
+               vslp_crs(ji,jj,jk) = vslp_crs(ji,jj,jk) * ( vmask_crs(ji+1,jj,jk) + vmask_crs(ji-1,jj,jk  ) ) * 0.5_wp   &
+                  &                            * ( vmask_crs(ji  ,jj,jk) + vmask_crs(ji  ,jj,jk+1) ) * 0.5_wp
+            END DO
+         END DO
+      END DO
+
+
+      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd )
+      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                  !* Local vertical density gradient evaluated from N^2
+               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+               !                                  !* Slopes at w point
+               !                                        ! i- & j-gradient of density at w-points
+               zci = MAX(  umask_crs(ji-1,jj,jk  ) + umask_crs(ji,jj,jk  )           &
+                  &      + umask_crs(ji-1,jj,jk-1) + umask_crs(ji,jj,jk-1) , zeps  ) * e1t_crs(ji,jj)
+               zcj = MAX(  vmask_crs(ji,jj-1,jk  ) + vmask_crs(ji,jj,jk-1)           &
+                  &      + vmask_crs(ji,jj-1,jk-1) + vmask_crs(ji,jj,jk  ) , zeps  ) *  e2t_crs(ji,jj)
+               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
+                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask_crs (ji,jj,jk)
+               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask_crs (ji,jj,jk)
+               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_max_crs(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_max_crs(ji,jj,jk)* ABS( zaj )  )
+               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+               zck = gdepw_crs(ji,jj,jk) / MAX( hmlp_crs(ji,jj), 10._wp )
+               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk)
+
+!!gm  modif to suppress omlmask....  (as in Griffies operator)
+!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
+!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
+!               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
+!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL crs_lbc_lnk( zwz, 'T', -1. )   ;    CALL crs_lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
+      !
+      !                                           !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               zcofw = tmask_crs(ji,jj,jk) * z1_16
+               wslpi_crs(ji,jj,jk) = (      zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj_crs(ji,jj,jk) = (      zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcofw = tmask_crs(ji,jj,jk) * z1_16
+               wslpi_crs(ji,jj,jk) = (      zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj_crs(ji,jj,jk) = (      zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zck =   ( umask_crs(ji,jj,jk) + umask_crs(ji-1,jj,jk) )   &
+                  &  * ( vmask_crs(ji,jj,jk) + vmask_crs(ji,jj-1,jk) ) * 0.25
+               wslpi_crs(ji,jj,jk) = wslpi_crs(ji,jj,jk) * zck
+               wslpj_crs(ji,jj,jk) = wslpj_crs(ji,jj,jk) * zck
+            END DO
+         END DO
+      END DO
+
+      ! III.  Specific grid points
+      ! ===========================
+ !! cc     !
+ !     IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area
+ !        !                                                    ! Gibraltar Strait
+ !        ij0 =  50   ;   ij1 =  53
+ !        ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ij0 =  51   ;   ij1 =  53
+ !        ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        !
+ !        !                                                    ! Mediterrannean Sea
+ !        ij0 =  49   ;   ij1 =  56
+ !        ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ij0 =  50   ;   ij1 =  56
+ !        ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !        ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+ !     ENDIF
+!! cc
+
+      ! IV. Lateral boundary conditions
+      ! ===============================
+      CALL crs_lbc_lnk( uslp_crs , 'U', -1. )      ;      CALL crs_lbc_lnk( vslp_crs , 'V', -1. )
+      CALL crs_lbc_lnk( wslpi_crs, 'W', -1. )      ;      CALL crs_lbc_lnk( wslpj_crs, 'W', -1. )
+
+
+  !    IF(ln_ctl) THEN
+  !       CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)
+  !      CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
+  !    ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp')
+      !
+   END SUBROUTINE ldf_slp_crs
+
+
+   SUBROUTINE ldf_slp_grif_crs ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_grif  ***
+      !!
+      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T)
+      !!      at W-points using the Griffies quarter-cells.
+      !!
+      !! ** Method  :   calculates alpha and beta at T-points
+      !!
+      !! ** Action : - triadi_g, triadj_g   T-pts i- and j-slope triads relative to geopot. (used for eiv)
+      !!             - triadi , triadj    T-pts i- and j-slope triads relative to model-coordinate
+      !!             - wslp2              squared slope of neutral surfaces at w-points.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices
+      INTEGER  ::   iku, ikv                    ! local integer
+      REAL(wp) ::   zfacti, zfactj              ! local scalars
+      REAL(wp) ::   znot_thru_surface           ! local scalars
+      REAL(wp) ::   zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj
+      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim
+      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim
+      REAL(wp) ::   zdzrho_raw
+      REAL(wp) ::   zbeta0
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_grif')
+      !
+      CALL wrk_alloc( jpi,jpj, z1_mlbw )
+      CALL wrk_alloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      !--------------------------------!
+      !  Some preliminary calculation  !
+      !--------------------------------!
+      !
+      CALL eos_alpbet_crs( tsb_crs, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==!
+      !
+      DO jl = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
+         !
+         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln)
+         DO jk = 1, jpkm1                     ! done each pair of triad
+            DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set
+               DO ji = 1, fs_jpim1            ! vector opt.
+                  zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point
+                  zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point
+                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_zps.and.l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom
+# if defined key_vectopt_loop
+            DO jj = 1, 1
+               DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling)
+# else
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+# endif
+                  iku  = mbku_crs(ji,jj)          ;   ikv  = mbkv_crs(ji,jj)             ! last ocean level (u- & v-points)
+                  zdit = gtsu_crs(ji,jj,jp_tem)   ;   zdjt = gtsv_crs(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
+                  zdis = gtsu_crs(ji,jj,jp_sal)   ;   zdjs = gtsv_crs(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
+                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+
+      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
+         DO jk = 1, jpkm1                     ! done each pair of triad
+            DO jj = 1, jpj                    ! NB: not masked ==>  a minimum value is set
+               DO ji = 1, jpi                 ! vector opt.
+                  IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp
+                     zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) )
+                     zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) )
+                  ELSE
+                     zdkt = 0._wp                                             ! 1st level gradient set to zero
+                     zdks = 0._wp
+                  ENDIF
+                  zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)
+                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln
+                 END DO
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 1, jpj                          !==  Reciprocal depth of the w-point below ML base  ==!
+         DO ji = 1, jpi
+            jk = MIN( nmln_crs(ji,jj), mbkt_crs(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
+            z1_mlbw(ji,jj) = 1._wp / gdepw_crs(ji,jj,jk)
+         END DO
+      END DO
+      !
+      !                                       !==  intialisations to zero  ==!
+      !
+      wslp2  (:,:,:)     = 0._wp              ! wslp2 will be cumulated 3D field set to zero
+      triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj_g(:,:,1,:,:) = 0._wp   ;   triadj_g(:,:,jpk,:,:) = 0._wp
+      !!gm _iso set to zero missing
+      triadi  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp
+
+      !-------------------------------------!
+      !  Triads just below the Mixed Layer  !
+      !-------------------------------------!
+      !
+      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base
+         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  ip = jl   ;   jp = jl
+                  jk = MIN( nmln_crs(ji+ip,jj) , mbkt_crs(ji+ip,jj) ) + 1         ! ML level+1 (MIN in case ML depth is the ocean depth)
+                  ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                  zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
+                     &      - ( gdept_crs(ji+1,jj,jk-kp) - gdept_crs(ji,jj,jk-kp) ) / e1u_crs(ji,jj)  ) * umask_crs(ji,jj,jk)
+                  jk = MIN( nmln_crs(ji,jj+jp) , mbkt_crs(ji,jj+jp) ) + 1
+                  ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                     &      - ( gdept_crs(ji,jj+1,jk-kp) - gdept_crs(ji,jj,jk-kp) ) / e2v_crs(ji,jj)  ) * vmask_crs(ji,jj,jk)
+                  zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !-------------------------------------!
+      !  Triads with surface limits         !
+      !-------------------------------------!
+      !
+      DO kp = 0, 1                            ! k-index of triads
+         DO jl = 0, 1
+            ip = jl   ;   jp = jl             ! i- and j-indices of triads (i-k and j-k planes)
+            DO jk = 1, jpkm1
+               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface
+               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1         ! vector opt.
+                     !
+                     ! Calculate slope relative to geopotentials used for GM skew fluxes
+                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                     ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point
+                     ! masked by umask taken at the level of dz(rho)
+                     !
+                     ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti)
+                     !
+                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked
+                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp)
+
+                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface
+                     zti_coord = znot_thru_surface * ( gdept_crs(ji+1,jj  ,jk) - gdept_crs(ji,jj,jk) ) / e1u_crs(ji,jj)
+                     ztj_coord = znot_thru_surface * ( gdept_crs(ji  ,jj+1,jk) - gdept_crs(ji,jj,jk) ) / e2v_crs(ji,jj)                  ! unmasked
+                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
+                     ztj_g_raw = ztj_raw - ztj_coord
+                     zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     !
+                     ! Below  ML use limited zti_g as is & mask
+                     ! Inside ML replace by linearly reducing sx_mlb towards surface & mask
+                     !
+                     zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln_crs(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1
+                     zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln_crs(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1
+                     !                                                          !                   otherwise  zfact=0
+                     zti_g_lim =          ( zfacti   * zti_g_lim                       &
+                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   &
+                        &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask_crs(ji,jj,jk+kp)
+                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
+                        &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask_crs(ji,jj,jk+kp)
+                     !
+                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim
+                     triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim
+                     !
+                     ! Get coefficients of isoneutral diffusion tensor
+                     ! 1. Utilise gradients *relative* to s-coordinate, so add t-point slopes (*subtract* depth gradients)
+                     ! 2. We require that isoneutral diffusion  gives no vertical buoyancy flux
+                     !     i.e. 33 term = (real slope* 31, 13 terms)
+                     ! To do this, retain limited sx**2  in vertical flux, but divide by real slope for 13/31 terms
+                     ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2
+                     !
+                     zti_lim  = ( zti_g_lim + zti_coord ) * umask_crs(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces
+                     ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask_crs(ji,jj,jk+kp)
+                     !
+                     IF( ln_triad_iso ) THEN
+                        zti_raw = zti_lim**2 / zti_raw
+                        ztj_raw = ztj_lim**2 / ztj_raw
+                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw )
+                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw )
+                        zti_lim =           zfacti   * zti_lim                       &
+                        &      + ( 1._wp - zfacti ) * zti_raw
+                        ztj_lim =           zfactj   * ztj_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_raw
+                     ENDIF
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim
+                    !
+                     zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   )
+                     zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   )
+                     zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp)
+                     zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp)
+                     !
+                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked
+                     wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked
+                     wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      wslp2(:,:,1) = 0._wp                ! force the surface wslp to zero
+
+      CALL crs_lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked
+      !
+      CALL wrk_dealloc( jpi,jpj, z1_mlbw )
+      CALL wrk_dealloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_grif')
+      !
+   END SUBROUTINE ldf_slp_grif_crs
+
+
+   SUBROUTINE ldf_slp_mxl_crs( prd, pn2, p_gru, p_grv, p_dzr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_mxl  ***
+      !!
+      !! ** Purpose :   Compute the slopes of iso-neutral surface just below
+      !!              the mixed layer.
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at u- & w-points
+      !!              (uslpml, wslpiml) and the slope in the j-direction is computed
+      !!              at v- and w-points (vslpml, wslpjml) with the same bounds as
+      !!              in ldf_slp.
+      !!
+      !! ** Action  :   uslpml, wslpiml :  i- &  j-slopes of neutral surfaces
+      !!                vslpml, wslpjml    just below the mixed layer
+      !!                omlmask         :  mixed layer mask
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   prd            ! in situ density
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point)
+      !!
+      INTEGER  ::   ji , jj , jk                   ! dummy loop indices
+      INTEGER  ::   iku, ikv, ik, ikm1             ! local integers
+      REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_mxl')
+      !
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
+      vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp
+      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp
+      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp
+      !
+      !                                            !==   surface mixed layer mask   !
+      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij                        ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+# endif
+               ik = nmln_crs(ji,jj) - 1
+               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+
+      ! Slopes of isopycnal surfaces just before bottom of mixed layer
+      ! --------------------------------------------------------------
+      ! The slope are computed as in the 3D case.
+      ! A key point here is the definition of the mixed layer at u- and v-points.
+      ! It is assumed to be the maximum of the two neighbouring T-point mixed layer depth.
+      ! Otherwise, a n2 value inside the mixed layer can be involved in the computation
+      ! of the slope, resulting in a too steep diagnosed slope and thus a spurious eddy
+      ! induce velocity field near the base of the mixed layer.
+      !-----------------------------------------------------------------------
+      !
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==!
+            !
+            !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
+            iku = MIN(  MAX( 1, nmln_crs(ji,jj) , nmln_crs(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+            ikv = MIN(  MAX( 1, nmln_crs(ji,jj) , nmln_crs(ji,jj+1) ) , jpkm1  )   !
+            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
+            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
+            !                        !- horizontal density gradient at u- & v-points
+            zau = p_gru(ji,jj,iku) / e1u_crs(ji,jj)
+            zav = p_grv(ji,jj,ikv) / e2v_crs(ji,jj)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,ikv)* ABS( zav )  )
+            !                        !- Slope at u- & v-points (uslpml, vslpml)
+            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask_crs(ji,jj,iku)
+            vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask_crs(ji,jj,ikv)
+            !
+            !                        !==   i- & j-slopes at w-points just below the Mixed Layer   ==!
+            !
+            ik   = MIN( nmln_crs(ji,jj) + 1, jpk )
+            ikm1 = MAX( 1, ik-1 )
+            !                        !- vertical density gradient for w-slope (from N^2)
+            zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
+            !                        !- horizontal density i- & j-gradient at w-points
+            zci = MAX(   umask_crs(ji-1,jj,ik  ) + umask_crs(ji,jj,ik  )           &
+               &       + umask_crs(ji-1,jj,ikm1) + umask_crs(ji,jj,ikm1) , zeps  ) * e1t_crs(ji,jj)
+            zcj = MAX(   vmask_crs(ji,jj-1,ik  ) + vmask_crs(ji,jj,ik  )           &
+               &       + vmask_crs(ji,jj-1,ikm1) + vmask_crs(ji,jj,ikm1) , zeps  ) * e2t_crs(ji,jj)
+            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)           &
+               &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask_crs(ji,jj,ik)
+            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           &
+               &       + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1)  ) / zcj  * tmask_crs(ji,jj,ik)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_max_crs(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_max_crs(ji,jj,ik)* ABS( zaj )  )
+            !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask_crs (ji,jj,ik)
+            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask_crs (ji,jj,ik)
+         END DO
+      END DO
+      !!gm this lbc_lnk should be useless....
+      CALL crs_lbc_lnk( uslpml , 'U', -1. )   ;   CALL crs_lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change)
+      CALL crs_lbc_lnk( wslpiml, 'W', -1. )   ;   CALL crs_lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_mxl')
+      WRITE(numout,*) ' uslp_crs' , MAXVAL(uslp_crs(:,:,:)) , MINVAL(uslp_crs(:,:,:))
+ !     WRITE(numout,*) ' vslp_crs' , vslp_crs
+ !     WRITE(numout,*) ' uslpml' , uslpml
+ !     WRITE(numout,*) ' vslpml' , vslpml
+ !     WRITE(numout,*) ' wslpiml' , wslpiml
+ !     WRITE(numout,*) ' wslpjml' , wslpjml
+ !     WRITE(numout,*) ' wslpi_crs' , wslpi_crs
+ !     WRITE(numout,*) ' wslpj_crs' , wslpj_crs
+      
+      !
+   END SUBROUTINE ldf_slp_mxl_crs
+
+
+   SUBROUTINE ldf_slp_init_crs
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_init  ***
+      !!
+      !! ** Purpose :   Initialization for the isopycnal slopes computation
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameter
+      !!      values called by tra_dmp at the first timestep (nit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ierr         ! local integer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr )
+         ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr )
+         IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' )
+         !
+         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' )
+         !
+      ELSE                             ! Madec operator : slopes at u-, v-, and w-points
+         ALLOCATE( uslp_crs(jpi,jpj,jpk) , vslp_crs(jpi,jpj,jpk) , wslpi_crs(jpi,jpj,jpk) , wslpj_crs(jpi,jpj,jpk) ,  &
+            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr )
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' )
+
+         ! Direction of lateral diffusion (tracers and/or momentum)
+         ! ------------------------------
+         uslp_crs (:,:,:) = 0._wp   ;   uslpml (:,:) = 0._wp      ! set the slope to zero (even in s-coordinates)
+         vslp_crs (:,:,:) = 0._wp   ;   vslpml (:,:) = 0._wp
+         wslpi_crs(:,:,:) = 0._wp   ;   wslpiml(:,:) = 0._wp
+         wslpj_crs(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp
+
+         !!gm I no longer understand this.....
+         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN
+            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
+
+            ! geopotential diffusion in s-coordinates on tracers and/or momentum
+            ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+
+            ! set the slope of diffusion to the slope of s-surfaces
+            !      ( c a u t i o n : minus sign as fsdep has positive value )
+            DO jk = 1, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                 uslp_crs (ji,jj,jk) = -1./e1u_crs(ji,jj) * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk)
+                 vslp_crs (ji,jj,jk) = -1./e2v_crs(ji,jj) * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk)
+                 wslpi_crs(ji,jj,jk) = -1./e1t_crs(ji,jj) * ( gdepw_crs(ji+1,jj,jk) - gdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                 wslpj_crs(ji,jj,jk) = -1./e2t_crs(ji,jj) * ( gdepw_crs(ji,jj+1,jk) - gdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5
+                  END DO
+               END DO
+            END DO
+            CALL crs_lbc_lnk( uslp_crs , 'U', -1. )   ;   CALL crs_lbc_lnk( vslp_crs , 'V', -1. )      ! Lateral boundary conditions
+            CALL crs_lbc_lnk( wslpi_crs, 'W', -1. )   ;   CALL crs_lbc_lnk( wslpj_crs, 'W', -1. )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init')
+      !
+   END SUBROUTINE ldf_slp_init_crs
+
+#else
+   !!------------------------------------------------------------------------
+   !!   Dummy module :                 NO Rotation of lateral mixing tensor
+   !!------------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp_crs = .FALSE.    !: slopes flag
+CONTAINS
+   SUBROUTINE ldf_slp_crs( kt, prd, pn2 )   ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2
+      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)
+   END SUBROUTINE ldf_slp_crs
+   SUBROUTINE ldf_slp_grif_crs( kt )        ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt
+   END SUBROUTINE ldf_slp_grif_crs
+   SUBROUTINE ldf_slp_init_crs              ! Dummy routine
+   END SUBROUTINE ldf_slp_init_crs
+#endif
+
+   !!======================================================================
+END MODULE ldfslp_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lib_fortran.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lib_fortran.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lib_fortran.F90	(revision 4056)
@@ -0,0 +1,518 @@
+MODULE lib_fortran
+   !!======================================================================
+   !!                       ***  MODULE  lib_fortran  ***
+   !! Fortran utilities:  includes some low levels fortran functionality
+   !!======================================================================
+   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   glob_sum    : generic interface for global masked summation over 
+   !!                 the interior domain for 1 or 2 2D or 3D arrays
+   !!                 it works only for T points   
+   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour
+   !!                 of intrinsinc sign function
+   !!----------------------------------------------------------------------
+   USE par_oce          ! Ocean parameter
+   USE lib_mpp          ! distributed memory computing
+ !  USE dom_oce          ! ocean domain
+   USE dom_oce, ONLY : tmask_i
+   USE in_out_manager   ! I/O manager
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC glob_sum
+#if defined key_nosignedzero
+   PUBLIC SIGN
+#endif
+
+   INTERFACE glob_sum
+      MODULE PROCEDURE glob_sum_2d, glob_sum_3d,glob_sum_2d_a, glob_sum_3d_a 
+   END INTERFACE
+
+#if defined key_nosignedzero   
+   INTERFACE SIGN
+      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   &
+         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          & 
+         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B 
+   END INTERFACE
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lib_fortran.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS 
+
+#if ! defined key_mpp_rep
+   FUNCTION glob_sum_2d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2D  ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of a 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
+      REAL(wp)                             ::   glob_sum_2d   ! global masked sum
+      !!-----------------------------------------------------------------------
+      !
+      IF( size(ptab(:,1)) == jpi_full ) THEN
+         glob_sum_2d = SUM( ptab(:,:)*tmask_i(:,:) )
+      ELSE
+         glob_sum_2d = SUM( ptab(:,:)*tmask_i_crs(:,:) )
+      ENDIF
+      
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_2d )
+      !
+   END FUNCTION glob_sum_2d
+   
+   
+   FUNCTION glob_sum_3d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3D  ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of a 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
+      REAL(wp)                               ::   glob_sum_3d   ! global masked sum
+      !!
+      INTEGER :: jk
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_3d = 0.e0
+      
+      IF( size(ptab(:,1,1)) == jpi_full ) THEN
+         DO jk = 1, jpk
+            glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) )
+         END DO
+      ELSE
+         DO jk = 1, jpk
+            glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i_crs(:,:) )
+         END DO
+      ENDIF
+      
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_3d )
+      !
+   END FUNCTION glob_sum_3d
+
+
+   FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2D _a ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of two 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
+      REAL(wp)            , DIMENSION(2)   ::   glob_sum_2d_a   ! global masked sum
+      !!-----------------------------------------------------------------------
+      !  
+      IF( size(ptab1(:,1)) == jpi_full ) THEN           
+         glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i(:,:) )
+         glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i(:,:) )
+      ELSE
+         glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i_crs(:,:) )
+         glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i_crs(:,:) )
+      ENDIF
+    
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_2d_a, 2 )
+      !
+   END FUNCTION glob_sum_2d_a
+ 
+ 
+   FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3D_a ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of two 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
+      REAL(wp)            , DIMENSION(2)     ::   glob_sum_3d_a   ! global masked sum
+      !!
+      INTEGER :: jk
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_3d_a(:) = 0.e0
+      IF( size(ptab1(:,1,1)) == jpi_full ) THEN
+         DO jk = 1, jpk
+            glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) )
+            glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) )
+         END DO
+      ELSE
+         DO jk = 1, jpk
+            glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i_crs(:,:) )
+            glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i_crs(:,:) )
+         END DO
+      ENDIF
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_3d_a, 2 )
+      !
+   END FUNCTION glob_sum_3d_a
+
+#else  
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_rep'                                   MPP reproducibility
+   !!----------------------------------------------------------------------
+   
+   FUNCTION glob_sum_2d( ptab ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab
+      REAL(wp)                                 ::   glob_sum_2d   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      IF( size(ptab(:,1)) == jpi_full ) THEN
+         DO jj = 1, jpj
+            DO ji =1, jpi
+               ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
+               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO
+      ELSE 
+         DO jj = 1, jpj
+            DO ji =1, jpi
+               ztmp =  ptab(ji,jj) * tmask_i_crs(ji,jj)
+               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO
+      ENDIF
+      
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_2d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_2d   
+
+
+   FUNCTION glob_sum_3d( ptab ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3d ***
+      !!
+      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab
+      REAL(wp)                                     ::   glob_sum_3d   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      
+      IF( size(ptab(:,1,1)) == jpi_full ) THEN
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji =1, jpi
+                  ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
+                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+               END DO
+            END DO    
+         END DO
+      ELSE
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji =1, jpi
+                  ztmp =  ptab(ji,jj,jk) * tmask_i_crs(ji,jj)
+                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+               END DO
+            END DO    
+         END DO
+      ENDIF
+      
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_3d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_3d   
+
+
+   FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2d_a ***
+      !!
+      !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab1, ptab2
+      REAL(wp)                                 ::   glob_sum_2d_a   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      
+      IF( size(ptab1(:,1)) == jpi_full ) THEN      
+         DO jj = 1, jpj
+            DO ji =1, jpi
+               ztmp =  ptab1(ji,jj) * tmask_i(ji,jj)
+               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+               ztmp =  ptab2(ji,jj) * tmask_i(ji,jj)
+              CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO
+      ELSE
+         DO jj = 1, jpj
+            DO ji =1, jpi
+               ztmp =  ptab1(ji,jj) * tmask_i_crs(ji,jj)
+               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+               ztmp =  ptab2(ji,jj) * tmask_i_crs(ji,jj)
+              CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO
+      ENDIF
+      
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_2d_a = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_2d_a   
+
+
+   FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3d_a ***
+      !!
+      !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab1, ptab2
+      REAL(wp)                                     ::   glob_sum_3d_a   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      IF( size(ptab1(:,1,1)) == jpi_full ) THEN
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji =1, jpi
+                  ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj)
+                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+                  ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj)
+                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+               END DO
+            END DO    
+         END DO
+      ELSE 
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji =1, jpi
+                  ztmp =  ptab1(ji,jj,jk) * tmask_i_crs(ji,jj)
+                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+                  ztmp =  ptab2(ji,jj,jk) * tmask_i_crs(ji,jj)
+                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+               END DO
+            END DO    
+         END DO
+      ENDIF
+      
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_3d_a = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_3d_a   
+
+
+   SUBROUTINE DDPDD( ydda, yddb )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE DDPDD ***
+      !!          
+      !! ** Purpose : Add a scalar element to a sum
+      !!             
+      !!
+      !! ** Method  : The code uses the compensated summation with doublet 
+      !!              (sum,error) emulated useing complex numbers. ydda is the
+      !!               scalar to add to the summ yddb 
+      !! 
+      !! ** Action  : This does only work for MPI. 
+      !!
+      !! References : Using Acurate Arithmetics to Improve Numerical
+      !!              Reproducibility and Sability in Parallel Applications
+      !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001 
+      !!----------------------------------------------------------------------
+      COMPLEX(wp), INTENT(in   ) ::   ydda
+      COMPLEX(wp), INTENT(inout) ::   yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2  ! local work variables
+      !!-----------------------------------------------------------------------
+      !
+      ! Compute ydda + yddb using Knuth's trick.
+      zt1  = REAL(ydda) + REAL(yddb)
+      zerr = zt1 - REAL(ydda)
+      zt2  = ( (REAL(yddb) - zerr) + (REAL(ydda) - (zt1 - zerr)) )   &
+         &   + AIMAG(ydda)         + AIMAG(yddb)
+      !
+      ! The result is t1 + t2, after normalization.
+      yddb = CMPLX( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1), wp )
+      !
+   END SUBROUTINE DDPDD
+#endif
+
+#if defined key_nosignedzero
+   !!----------------------------------------------------------------------
+   !!   'key_nosignedzero'                                         F90 SIGN
+   !!----------------------------------------------------------------------
+   
+   FUNCTION SIGN_SCALAR( pa, pb )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_SCALAR  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb          ! input
+      REAL(wp) :: SIGN_SCALAR    ! result
+      !!-----------------------------------------------------------------------
+      IF ( pb >= 0.e0) THEN   ;   SIGN_SCALAR = ABS(pa)
+      ELSE                    ;   SIGN_SCALAR =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_SCALAR
+
+
+   FUNCTION SIGN_ARRAY_1D( pa, pb ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:)                   ! input
+      REAL(wp) :: SIGN_ARRAY_1D(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D
+
+
+   FUNCTION SIGN_ARRAY_2D(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D
+
+   FUNCTION SIGN_ARRAY_3D(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_3D(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D
+
+
+   FUNCTION SIGN_ARRAY_1D_A(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb(:)      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_A(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D_A
+
+
+   FUNCTION SIGN_ARRAY_2D_A(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_A(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D_A
+
+
+   FUNCTION SIGN_ARRAY_3D_A(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb(:,:,:)  ! input
+      REAL(wp) :: SIGN_ARRAY_3D_A(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3)) ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D_A
+
+
+   FUNCTION SIGN_ARRAY_1D_B(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_B(SIZE(pa,1))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_1D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_1D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_1D_B
+
+
+   FUNCTION SIGN_ARRAY_2D_B(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_B(SIZE(pa,1),SIZE(pa,2))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_2D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_2D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_2D_B
+
+
+   FUNCTION SIGN_ARRAY_3D_B(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_3D_B(SIZE(pa,1),SIZE(pa,2),SIZE(pa,3))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_3D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_3D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_3D_B
+#endif
+
+   !!======================================================================
+END MODULE lib_fortran
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lib_mpp.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lib_mpp.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/lib_mpp.F90	(revision 4056)
@@ -0,0 +1,3040 @@
+MODULE lib_mpp
+   !!======================================================================
+   !!                       ***  MODULE  lib_mpp  ***
+   !! Ocean numerics:  massively parallel processing library
+   !!=====================================================================
+   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
+   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
+   !!            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
+   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
+   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
+   !!                 !  2004  (J.M. Molines) minloc, maxloc
+   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
+   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
+   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
+   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
+   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
+   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop   : update momentum and tracer Kz from a tke scheme
+   !!   ctl_warn   : initialization, namelist read, and parameters control
+   !!   ctl_opn    : Open file and check if required file is available.
+   !!   get_unit    : give the index of an unused logical unit
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi  
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lib_mpp_alloc : allocate mpp arrays
+   !!   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)
+   !!   mpprecv         :
+   !!   mppsend       :   SUBROUTINE mpp_ini_znl
+   !!   mppscatter    :
+   !!   mppgather     :
+   !!   mpp_min       : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max       : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
+   !!   mpp_sum       : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+   !!   mpp_minloc    :
+   !!   mpp_maxloc    :
+   !!   mppsync       :
+   !!   mppstop       :
+   !!   mppobc        : variant of mpp_lnk for open boundary condition
+   !!   mpp_ini_north : initialisation of north fold
+   !!   mpp_lbc_north : north fold processors gathering
+   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
+   !!----------------------------------------------------------------------
+ !  USE dom_oce        ! ocean space and time domain 
+   USE dom_oce , ONLY : nimpp
+   USE dom_oce , ONLY : nlci
+   USE dom_oce , ONLY : nlcj
+   USE dom_oce , ONLY : njmpp
+   USE dom_oce , ONLY : narea
+   USE dom_oce , ONLY : nbondi
+   USE dom_oce , ONLY : nbondj
+   USE dom_oce , ONLY : noea
+   USE dom_oce , ONLY : nono
+   USE dom_oce , ONLY : noso
+   USE dom_oce , ONLY : nowe
+   USE dom_oce , ONLY : nreci
+   USE dom_oce , ONLY : nrecj
+   USE dom_oce , ONLY : nimppt
+   USE dom_oce , ONLY : nldit
+   USE dom_oce , ONLY : nleit
+   USE dom_oce , ONLY : agrif_root
+   USE dom_oce , ONLY : njmppt
+   USE dom_oce , ONLY : npolj
+   USE dom_oce , ONLY : nperio
+   USE dom_oce , ONLY : nlej
+   USE dom_oce , ONLY : nlei
+   USE dom_oce , ONLY : nldj
+   USE dom_oce , ONLY : nldi  
+   USE lbcnfd         ! north fold treatment
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn
+   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
+   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
+   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+   PUBLIC   mppscatter, mppgather
+   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
+   PUBLIC   mppsize
+
+   !! * Interfaces
+   !! define generic interface for these routine as they are called sometimes
+   !! with scalar arguments instead of array arguments, which causes problems
+   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_sum
+# if defined key_mpp_rep
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, &
+                       mppsum_realdd, mppsum_a_realdd
+# else
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
+# endif
+   END INTERFACE
+   INTERFACE mpp_lbc_north
+      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+   
+   !! ========================= !!
+   !!  MPI  variable definition !!
+   !! ========================= !!
+!$AGRIF_DO_NOT_TREAT
+   INCLUDE 'mpif.h'
+!$AGRIF_END_DO_NOT_TREAT
+   
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
+
+   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
+   
+   INTEGER ::   mppsize        ! number of process
+   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ]
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator
+!$AGRIF_END_DO_NOT_TREAT
+
+# if defined key_mpp_rep
+   INTEGER :: MPI_SUMDD
+# endif
+
+   ! variables used in case of sea-ice
+   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice
+   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
+   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
+   INTEGER ::   ngrp_world        ! group ID for the world processors
+   INTEGER ::   ngrp_opa          ! group ID for the opa processors
+   INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold)
+   INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
+   INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line
+   INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   ! dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
+   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
+      
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
+
+   ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public
+   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 8                 ! Assumed maximum number of active neighbours
+   INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges 
+   INTEGER, PUBLIC,  DIMENSION (jpmaxngh,jptyps)    ::   isendto
+   INTEGER, PUBLIC,  DIMENSION (jptyps)             ::   nsndto
+   LOGICAL, PUBLIC                                  ::   ln_nnogather     = .FALSE.  ! namelist control of northfold comms
+   LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms
+   INTEGER, PUBLIC                                  ::   ityp
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lib_mpp.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION mynode( ldtxt, kumnam, kstop, localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!                    
+      !! ** Purpose :   Find processor unit
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit 
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator 
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      !
+      INTEGER ::   mynode, ierr, code, ji, ii
+      LOGICAL ::   mpi_was_called
+      !
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, ln_nnogather
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*)                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                            ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                                ;   ii = ii + 1
+      !
+      jpni = -1; jpnj = -1; jpnij = -1
+      REWIND( kumnam )               ! Namelist namrun : parameters of the run
+      READ  ( kumnam, nammpp )
+      !                              ! 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 in bytes of exported buffer   nn_buffer   = ', nn_buffer     ;   ii = ii + 1
+
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+         jpni  = Agrif_Parent(jpni ) 
+         jpnj  = Agrif_Parent(jpnj )
+         jpnij = Agrif_Parent(jpnij)
+      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
+         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically'; ii = ii + 1
+      ELSE
+         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni; ii = ii + 1
+         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
+
+      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
+
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt) 
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO         
+         WRITE(*, cform_err)
+         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( mpi_was_called ) THEN
+         !
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr ) 
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
+            l_isend = .TRUE.
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
+            kstop = kstop + 1
+         END SELECT
+      ELSE IF ( 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
+         kstop = kstop + 1
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
+            CALL mpi_init( ierr )
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr )
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
+            l_isend = .TRUE.
+            CALL mpi_init( ierr )
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
+            kstop = kstop + 1
+         END SELECT
+         !
+      ENDIF
+
+      IF( PRESENT(localComm) ) THEN 
+         IF( Agrif_Root() ) THEN
+            mpi_comm_opa = localComm
+         ENDIF
+      ELSE
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF 
+
+      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
+      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
+      mynode = mpprank
+      ! 
+#if defined key_mpp_rep
+      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
+#endif
+      !
+   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 ::   t3ns, t3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE ::   t3ew, t3we   ! 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( t3ns(jpi,jprecj,jpk,2)   , t3sn(jpi,jprecj,jpk,2)   ,   &
+         &      t3ew(jpj,jpreci,jpk,2)   , t3we(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
+      ! ------------------------------
+      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 boundaries (always closed)
+         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                      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 )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT  
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, t3we(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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t3we(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,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,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
+            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, t3sn(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, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t3sn(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,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = t3sn(:,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( t3ns   , t3sn,  t3ew   , t3we )
+   END SUBROUTINE mpp_lnk_3d
+
+
+   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 ::   t2ns, t2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE ::   t2ew, t2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( t2ns(jpi,jprecj    ,2)   , t2sn(jpi,jprecj    ,2)   ,   &
+         &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2))
+      
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! 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 boundaries (always closed)
+            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
+                                         pt2d(:,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 )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            t2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, t2we(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, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t2we(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,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,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
+            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, t2sn(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, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t2sn(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) = t2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,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( t2ns   , t2sn   , t2ew   , t2we)
+   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 ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      ALLOCATE(t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) ,    &
+         &     t4ew(jpj,jpreci,jpk,2,2) , t4we(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( .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
+
+
+      ! 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
+            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
+            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
+            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
+            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk *2
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, t4we(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, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t4we(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,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,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
+            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
+            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
+            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
+            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk * 2
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, t4sn(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, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t4sn(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,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2)
+            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
+            ptab2(:,jl,:) = t4sn(:,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(t4ns , t4sn , t4ew , t4we)
+   END SUBROUTINE mpp_lnk_3d_gather
+
+
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_e  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
+      !!
+      !! ** 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
+      !!                    jpr2di : number of rows for extra outer halo
+      !!                    jpr2dj : number of columns for extra outer halo
+      !!                    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(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 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  ::   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 ::   tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo
+      REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE ::   tr2ew, tr2we ! 2d for east-west   & west-east   + extra outer halo
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     &
+         &      tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2))
+         
+      ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jpr2dj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      !* North-South boundaries (always colsed)
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north
+                                
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj )
+         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
+         END SELECT 
+         !
+      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-jpr2di
+         DO jl = 1, ipreci
+            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            tr2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jpr2dj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,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, ipreci
+            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,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-jpr2dj
+         DO jl = 1, iprecj
+            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpr2di )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,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, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,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, iprecj
+            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+         END DO
+      END SELECT
+      DEALLOCATE( tr2ns , tr2sn , tr2ew , tr2we)
+   END SUBROUTINE mpp_lnk_2d_e
+
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!                   
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
+      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
+      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
+      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cn_mpi_send )
+      CASE ( 'S' )                ! Standard mpi send (blocking)
+         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'B' )                ! Buffer mpi send (blocking)
+         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+         ! be carefull, one more argument here : the mpi request identifier..
+         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa, md_req, iflag )
+      END SELECT
+      !
+   END SUBROUTINE mppsend
+
+
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
+      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
+      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number 
+      !!
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      INTEGER :: use_source
+      !!----------------------------------------------------------------------
+      !
+
+      ! If a specific process number has been passed to the receive call, 
+      ! use that one. Default is to use mpi_any_source
+      use_source=mpi_any_source
+      if(present(ksource)) then
+         use_source=ksource
+      end if
+
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag )
+      !
+   END SUBROUTINE mpprecv
+
+
+   SUBROUTINE mppgather( ptab, kp, pio )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mppgather  ***
+      !!                   
+      !! ** Purpose :   Transfert between a local subdomain array and a work 
+      !!     array which is distributed following the vertical level.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(in   ) ::   ptab   ! subdomain input array
+      INTEGER ,                           INTENT(in   ) ::   kp     ! record length
+      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = jpi * jpj
+      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
+         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
+      !
+   END SUBROUTINE mppgather
+
+
+   SUBROUTINE mppscatter( pio, kp, ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppscatter  ***
+      !!
+      !! ** Purpose :   Transfert between awork array which is distributed 
+      !!      following the vertical level and the local subdomain array.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
+      INTEGER                             ::   kp        ! Tag (not used with MPI
+      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille=jpi*jpj
+      !
+      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
+         &                            mpi_double_precision, kp  , mpi_comm_opa, ierror )
+      !
+   END SUBROUTINE mppscatter
+
+
+   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, DIMENSION(kdim) ::   iwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, 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)
+      !
+      ktab = iwork
+      !
+   END SUBROUTINE mppmax_int
+
+
+   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
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
+      !!
+      INTEGER ::   ierror, localcomm   ! 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 )
+      !
+      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 )
+      !
+      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
+      !!
+      !!----------------------------------------------------------------------
+      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 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
+      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 )
+      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 
+      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 )
+      ptab = zwork
+      !
+   END SUBROUTINE mppsum_real
+
+# if defined key_mpp_rep
+   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
+
+      !! * Local variables   (MPI version)
+      INTEGER  ::    ierror
+      INTEGER  ::   localcomm
+      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)
+      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 , INTENT( in  ), OPTIONAL :: kcom
+
+      !! * Local variables   (MPI version)
+      INTEGER                      :: ierror    ! temporary integer
+      INTEGER                      ::   localcomm
+      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)
+      ytab(:) = zwork(:)
+
+   END SUBROUTINE mppsum_a_realdd
+# endif   
+   
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab    ! Local 2D array
+      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 , DIMENSION(2)   ::   ilocs
+      INTEGER :: ierror
+      REAL(wp) ::   zmin   ! local minimum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:)=zmin
+      zain(2,:)=ki+10000.*kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
+      !
+      pmin = zaout(1,1)
+      kj = INT(zaout(2,1)/10000.)
+      ki = INT(zaout(2,1) - 10000.*kj )
+      !
+   END SUBROUTINE mpp_minloc2d
+
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      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
+      !!
+      INTEGER  ::   ierror
+      REAL(wp) ::   zmin     ! local minimum
+      INTEGER , DIMENSION(3)   ::   ilocs
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      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)
+      !
+      pmin = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_minloc3d
+
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :   Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab     ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask    ! Local mask
+      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab
+      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame
+      !!  
+      INTEGER  :: ierror
+      INTEGER, DIMENSION (2)   ::   ilocs
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:) = zmax
+      zain(2,:) = ki + 10000. * kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
+      !
+      pmax = zaout(1,1)
+      kj   = INT( zaout(2,1) / 10000.     )
+      ki   = INT( zaout(2,1) - 10000.* kj )
+      !
+   END SUBROUTINE mpp_maxloc2d
+
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :  Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      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(2,1) ::   zain, zaout
+      INTEGER , DIMENSION(3)   ::   ilocs
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      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)
+      !
+      pmax = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_maxloc3d
+
+
+   SUBROUTINE mppsync()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsync  ***
+      !!                   
+      !! ** Purpose :   Massively parallel processors, synchroneous
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      CALL mpi_barrier( mpi_comm_opa, ierror )
+      !
+   END SUBROUTINE mppsync
+
+
+   SUBROUTINE mppstop
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppstop  ***
+      !!                   
+      !! ** purpose :   Stop massively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      !
+      CALL mppsync
+      CALL mpi_finalize( info )
+      !
+   END SUBROUTINE mppstop
+
+
+   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout)
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppobc  ***
+      !! 
+      !! ** Purpose :   Message passing manadgement for open boundary
+      !!     conditions 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
+      !!
+      !!----------------------------------------------------------------------
+      USE wrk_nemo        ! Memory allocation
+      !
+      INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
+      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary
+      INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension
+      INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt
+      !                                                           !  = 1  north/south  ;  = 2  east/west
+      INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension
+      INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit
+      REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array
+      !
+      INTEGER ::   ji, jj, jk, jl        ! dummy loop indices
+      INTEGER ::   iipt0, iipt1, ilpt1   ! local integers
+      INTEGER ::   ijpt0, ijpt1          !   -       -
+      INTEGER ::   imigr, iihom, ijhom   !   -       -
+      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend
+      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztab   ! temporary workspace
+      REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE ::   t2ns, t2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE ::   t2ew, t2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( t2ns(jpi,jprecj    ,2)   , t2sn(jpi,jprecj    ,2)   ,   &
+         &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2))
+
+
+      CALL wrk_alloc( jpi,jpj, ztab )
+
+      ! boundary condition initialization
+      ! ---------------------------------
+      ztab(:,:) = 0.e0
+      !
+      IF( ktype==1 ) THEN                                  ! north/south boundaries
+         iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
+         ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
+      ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
+         iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
+         ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
+      ELSE
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mppobc : bad ktype'
+         CALL mppstop
+      ENDIF
+      
+      ! Communication level by level
+      ! ----------------------------
+!!gm Remark : this is very time consumming!!!
+      !                                         ! ------------------------ !
+      DO jk = 1, kk                             !   Loop over the levels   !
+         !                                      ! ------------------------ !
+         !
+         IF( ktype == 1 ) THEN                               ! north/south boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(ji,jk)
+               END DO
+            END DO
+         ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+
+         ! 1. East and west directions
+         ! ---------------------------
+         !
+         IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               t2ew(:,jl,1) = ztab(jpreci+jl,:)
+               t2we(:,jl,1) = ztab(iihom +jl,:)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr=jpreci*jpj
+         !
+         IF( nbondi == -1 ) THEN
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondi == 0 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+            CALL mpprecv( 2, t2we(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 )
+         ELSEIF( nbondi == 1 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         iihom = nlci-jpreci
+         !
+         IF( nbondi == 0 .OR. nbondi == 1 ) THEN
+            DO jl = 1, jpreci
+               ztab(jl,:) = t2we(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondi == -1 .OR. nbondi == 0 ) THEN
+            DO jl = 1, jpreci
+               ztab(iihom+jl,:) = t2ew(:,jl,2)
+            END DO
+         ENDIF
+
+
+         ! 2. North and south directions
+         ! -----------------------------
+         !
+         IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               t2sn(:,jl,1) = ztab(:,ijhom +jl)
+               t2ns(:,jl,1) = ztab(:,jprecj+jl)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr = jprecj * jpi
+         !
+         IF( nbondj == -1 ) THEN
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondj == 0 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+            CALL mpprecv( 4, t2sn(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 )
+         ELSEIF( nbondj == 1 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, t2sn(1,1,2), imigr, noso)
+            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         ijhom = nlcj - jprecj
+         IF( nbondj == 0 .OR. nbondj == 1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,jl) = t2sn(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondj == 0 .OR. nbondj == -1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,ijhom+jl) = t2ns(:,jl,2)
+            END DO
+         ENDIF
+         IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
+            DO jj = ijpt0, ijpt1            ! north/south boundaries
+               DO ji = iipt0,ilpt1
+                  ptab(ji,jk) = ztab(ji,jj)  
+               END DO
+            END DO
+         ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
+            DO jj = ijpt0, ilpt1            ! east/west boundaries
+               DO ji = iipt0,iipt1
+                  ptab(jj,jk) = ztab(ji,jj) 
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+      !
+      DEALLOCATE( t2ns   , t2sn   , t2ew   , t2we)
+      CALL wrk_dealloc( jpi,jpj, ztab )
+      !
+   END SUBROUTINE mppobc
+   
+
+   SUBROUTINE mpp_comm_free( kcom )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kcom
+      !!
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      CALL MPI_COMM_FREE(kcom, ierr)
+      !
+   END SUBROUTINE mpp_comm_free
+
+
+   SUBROUTINE mpp_ini_ice( pindic, kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_ice  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for ice areas
+      !!      condition together with global variables needed in the ddmpp folding
+      !!
+      !! ** Method  : - Look for ice processors in ice routines
+      !!              - Put their number in nrank_ice
+      !!              - Create groups for the world processors and the ice processors
+      !!              - Create a communicator for ice processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_ice = number of processors with ice
+      !!      nrank_ice (ndim_rank_ice) = ice processors
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_ice = group ID for the ice processors
+      !!      ncomm_ice = communicator for the ice procs.
+      !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   pindic
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit
+      !!
+      INTEGER :: jjproc
+      INTEGER :: ii, ierr
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kice
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      ! Since this is just an init routine and these arrays are of length jpnij
+      ! then don't use wrk_nemo module - just allocate and deallocate.
+      ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length)'
+         CALL mppstop
+      ENDIF
+
+      ! Look for how many procs with sea-ice
+      !
+      kice = 0
+      DO jjproc = 1, jpnij
+         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1    
+      END DO
+      !
+      zwork = 0
+      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr )
+      ndim_rank_ice = SUM( zwork )          
+
+      ! Allocate the right size to nrank_north
+      IF( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
+      ALLOCATE( nrank_ice(ndim_rank_ice) )
+      !
+      ii = 0     
+      nrank_ice = 0
+      DO jjproc = 1, jpnij
+         IF( zwork(jjproc) == 1) THEN
+            ii = ii + 1
+            nrank_ice(ii) = jjproc -1 
+         ENDIF
+      END DO
+
+      ! Create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
+
+      ! Create the ice group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )
+
+      ! Create the ice communicator , ie the pool of procs with sea-ice
+      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_ice, ncomm_ice, ierr )
+
+      ! Find proc number in the world of proc 0 in the north
+      ! The following line seems to be useless, we just comment & keep it as reminder
+      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
+      !
+      DEALLOCATE(kice, zwork)
+      !
+   END SUBROUTINE mpp_ini_ice
+
+
+   SUBROUTINE mpp_ini_znl( kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_znl  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for computing zonal sum
+      !!
+      !! ** Method  : - Look for processors in the same row
+      !!              - Put their number in nrank_znl
+      !!              - Create group for the znl processors
+      !!              - Create a communicator for znl processors
+      !!              - Determine if processor should write znl files
+      !!
+      !! ** output
+      !!      ndim_rank_znl = number of processors on the same row
+      !!      ngrp_znl = group ID for the znl processors
+      !!      ncomm_znl = communicator for the ice procs.
+      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical units
+      !
+      INTEGER :: jproc      ! dummy loop integer
+      INTEGER :: ierr, ii   ! local integer
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork
+      !!----------------------------------------------------------------------
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa
+      !
+      ALLOCATE( kwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij'
+         CALL mppstop
+      ENDIF
+
+      IF( jpnj == 1 ) THEN
+         ngrp_znl  = ngrp_world
+         ncomm_znl = mpi_comm_opa
+      ELSE
+         !
+         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
+         !-$$        CALL flush(numout)
+         !
+         ! Count number of processors on the same row
+         ndim_rank_znl = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp ) THEN
+               ndim_rank_znl = ndim_rank_znl + 1
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
+         !-$$        CALL flush(numout)
+         ! Allocate the right size to nrank_znl
+         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
+         ALLOCATE(nrank_znl(ndim_rank_znl))
+         ii = 0     
+         nrank_znl (:) = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp) THEN
+               ii = ii + 1
+               nrank_znl(ii) = jproc -1 
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the opa group
+         CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr)
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
+         !-$$        CALL flush(numout)
+
+         ! Create the znl group from the opa group
+         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
+         CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
+         !-$$        CALL flush(numout)
+         !
+      END IF
+
+      ! Determines if processor if the first (starting from i=1) on the row
+      IF ( jpni == 1 ) THEN 
+         l_znl_root = .TRUE.
+      ELSE
+         l_znl_root = .FALSE.
+         kwork (1) = nimpp
+         CALL mpp_min ( kwork(1), kcom = ncomm_znl)
+         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
+      END IF
+
+      DEALLOCATE(kwork)
+
+   END SUBROUTINE mpp_ini_znl
+
+
+   SUBROUTINE mpp_ini_north
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_north  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for north folding 
+      !!      condition together with global variables needed in the mpp folding
+      !!
+      !! ** Method  : - Look for northern processors
+      !!              - Put their number in nrank_north
+      !!              - Create groups for the world processors and the north processors
+      !!              - Create a communicator for northern processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_north = number of processors in the northern line
+      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_north = group ID for the northern processors
+      !!      ncomm_north = communicator for the northern procs.
+      !!      north_root = number (in the world) of proc 0 in the northern comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr
+      INTEGER ::   jjproc
+      INTEGER ::   ii, ji
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      ! Look for how many procs on the northern boundary
+      ndim_rank_north = 0
+      DO jjproc = 1, jpnij
+         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
+      END DO
+      !
+      ! Allocate the right size to nrank_north
+      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
+      ALLOCATE( nrank_north(ndim_rank_north) )
+
+      ! Fill the nrank_north array with proc. number of northern procs.
+      ! Note : the rank start at 0 in MPI
+      ii = 0
+      DO ji = 1, jpnij
+         IF ( njmppt(ji) == njmppmax   ) THEN
+            ii=ii+1
+            nrank_north(ii)=ji-1
+         END IF
+      END DO
+      !
+      ! create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
+      !
+      ! Create the North group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
+      !
+      ! Create the North communicator , ie the pool of procs in the north group
+      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_north, ncomm_north, ierr )
+      !
+   END SUBROUTINE mpp_ini_north
+
+
+   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
+      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
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   ::   ztab, znorthloc
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   ::   znorthgloio
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   ::   zfoldwk      ! Workspace for message transfers avoiding mpi_allgather
+
+      !!----------------------------------------------------------------------
+      !        
+      ALLOCATE( ztab(jpiglo,4,jpk)                             )                                      
+      ALLOCATE( znorthloc(jpi,4,jpk)       , zfoldwk(jpi,4,jpk))
+      ALLOCATE( znorthgloio(jpi,4,jpk,jpni)                    )
+
+      ijpj   = 4
+      ityp = -1
+      ijpjm1 = 3
+      ztab(:,:,:) = 0.e0
+      !
+      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d
+         ij = jj - nlcj + ijpj
+         znorthloc(:,ij,:) = pt3d(:,jj,:)
+      END DO
+      !
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * jpk * 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
+         !
+         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+            ij = jj - nlcj + ijpj
+            DO ji = 1, nlci
+               ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)
+            END DO
+         END DO
+
+         !
+         ! Set the exchange type in order to access the correct list of active neighbours
+         !
+         SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )
+               ityp = 1
+            CASE ( 'U' )
+               ityp = 2
+            CASE ( 'V' )
+               ityp = 3
+            CASE ( 'F' )
+               ityp = 4
+            CASE ( 'I' )
+               ityp = 5
+            CASE DEFAULT
+               ityp = -1                    ! Set a default value for unsupported types which 
+                                            ! will cause a fallback to the mpi_allgather method
+         END SELECT
+         IF ( ityp .gt. 0 ) THEN
+
+            DO jr = 1,nsndto(ityp)
+               CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )
+            END DO
+            DO jr = 1,nsndto(ityp)
+               CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))
+               iproc = isendto(jr,ityp) + 1
+               ildi = nldit (iproc)
+               ilei = nleit (iproc)
+               iilb = nimppt(iproc)
+               DO jj = 1, ijpj
+                  DO ji = ildi, ilei
+                     ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)
+                  END DO
+               END DO
+            END DO
+            IF (l_isend) THEN
+               DO jr = 1,nsndto(ityp)
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               END DO
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+      IF ( ityp .lt. 0 ) THEN
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, 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)
+            DO jj = 1, ijpj
+               DO ji = ildi, ilei
+                  ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
+               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.
+      !
+      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+         ij = jj - nlcj + ijpj
+         DO ji= 1, nlci
+            pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)
+         END DO
+      END DO
+      !
+      DEALLOCATE( ztab                 )                                      
+      DEALLOCATE( znorthloc  , zfoldwk )
+      DEALLOCATE( znorthgloio          )
+   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      ! 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
+      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
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE    ::   ztab_2d
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE    ::   znorthgloio_2d
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE    ::   zfoldwk_2d, znorthloc_2d    ! Workspace for message transfers avoiding mpi_allgather
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab_2d(jpiglo,4)                            )                                      
+      ALLOCATE( znorthloc_2d(jpi,4)       , zfoldwk_2d(jpi,4))
+      ALLOCATE( znorthgloio_2d(jpi,4,jpni)                   )
+      
+      ijpj   = 4
+      ityp = -1
+      ijpjm1 = 3
+      ztab_2d(:,:) = 0.e0
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc_2d the last 4 jlines of pt2d
+         ij = jj - nlcj + ijpj
+         znorthloc_2d(:,ij) = pt2d(:,jj)
+      END DO
+
+      !                                     ! Build in procs of ncomm_north the znorthgloio_2d
+      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
+         !
+         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+            ij = jj - nlcj + ijpj
+            DO ji = 1, nlci
+               ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)
+            END DO
+         END DO
+
+         !
+         ! Set the exchange type in order to access the correct list of active neighbours
+         !
+         SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )
+               ityp = 1
+            CASE ( 'U' )
+               ityp = 2
+            CASE ( 'V' )
+               ityp = 3
+            CASE ( 'F' )
+               ityp = 4
+            CASE ( 'I' )
+               ityp = 5
+            CASE DEFAULT
+               ityp = -1                    ! Set a default value for unsupported types which 
+                                            ! will cause a fallback to the mpi_allgather method
+         END SELECT
+
+         IF ( ityp .gt. 0 ) THEN
+
+            DO jr = 1,nsndto(ityp)
+               CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )
+            END DO
+            DO jr = 1,nsndto(ityp)
+               CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp))
+               iproc = isendto(jr,ityp) + 1
+               ildi = nldit (iproc)
+               ilei = nleit (iproc)
+               iilb = nimppt(iproc)
+               DO jj = 1, ijpj
+                  DO ji = ildi, ilei
+                     ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj)
+                  END DO
+               END DO
+            END DO
+            IF (l_isend) THEN
+               DO jr = 1,nsndto(ityp)
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               END DO
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+      IF ( ityp .lt. 0 ) THEN
+         CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        &
+            &                znorthgloio_2d, 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)
+            DO jj = 1, ijpj
+               DO ji = ildi, ilei
+                  ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)
+               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.
+      !
+
+      CALL lbc_nfd( ztab_2d, 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_2d(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !      
+
+      DEALLOCATE( ztab_2d                    )                                      
+      DEALLOCATE( znorthloc_2d  , zfoldwk_2d )
+      DEALLOCATE( znorthgloio_2d             )
+
+   END SUBROUTINE mpp_lbc_north_2d
+
+
+   SUBROUTINE mpp_lbc_north_e( 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 and for 2d 
+      !!              array with outer extra halo
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4+2*jpr2dj 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(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
+      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
+      ! 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)
+         END DO
+      END DO
+      !
+      itaille = jpi * ( ijpj + 2 * jpr2dj )
+      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)
+         DO jj = 1, ijpj+2*jpr2dj
+            DO ji = ildi, ilei
+               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
+
+      ij = jpr2dj
+      !! Scatter back to pt2d
+      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj
+      ij  = ij +1 
+         DO ji= 1, nlci
+            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+      DEALLOCATE( ztab_e , znorthloc_e , znorthgloio_e )
+   END SUBROUTINE mpp_lbc_north_e
+
+
+   SUBROUTINE mpi_init_opa( ldtxt, ksft, code )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_init.opa  ***
+      !!
+      !! ** Purpose :: export and attach a MPI buffer for bsend
+      !!
+      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
+      !!            but classical mpi_init
+      !! 
+      !! History :: 01/11 :: IDRIS initial version for IBM only  
+      !!            08/04 :: R. Benshila, generalisation
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER                      , INTENT(inout) ::   ksft
+      INTEGER                      , INTENT(  out) ::   code
+      INTEGER                                      ::   ierr, ji
+      LOGICAL                                      ::   mpi_was_called
+      !!---------------------------------------------------------------------
+      !
+      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
+      IF ( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt) 
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO         
+         WRITE(*, cform_err)
+         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+      !
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_init( code )
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code )
+         IF ( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_buffer > 0 ) THEN
+         WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1
+         ! Buffer allocation and attachment
+         ALLOCATE( tampon(nn_buffer), stat = ierr )
+         IF( ierr /= 0 ) THEN 
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         END IF
+         CALL mpi_buffer_attach( tampon, nn_buffer, code )
+      ENDIF
+      !
+   END SUBROUTINE mpi_init_opa
+
+#if defined key_mpp_rep
+   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype)
+      !!---------------------------------------------------------------------
+      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
+      !!
+      !!   Modification of original codes written by David H. Bailey
+      !!   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
+      !
+      REAL(wp) :: zerr, zt1, zt2    ! local work variables
+      INTEGER :: ji, ztmp           ! local scalar
+
+      ztmp = itype   ! avoid compilation warning
+
+      DO ji=1,ilen
+      ! Compute ydda + yddb using Knuth's trick.
+         zt1  = real(ydda(ji)) + real(yddb(ji))
+         zerr = zt1 - real(ydda(ji))
+         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) &
+                + aimag(ydda(ji)) + aimag(yddb(ji))
+
+         ! The result is zt1 + zt2, after normalization.
+         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
+      END DO
+
+   END SUBROUTINE DDPDD_MPI
+#endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+   USE in_out_manager
+
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i, mppsum_realdd, mppsum_a_realdd
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mppobc
+      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+   LOGICAL, PUBLIC            ::   ln_nnogather  = .FALSE.  !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
+   INTEGER :: ncomm_ice
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lib_mpp_alloc(kumout)          ! Dummy function
+      INTEGER, INTENT(in) ::   kumout
+      lib_mpp_alloc = 0
+   END FUNCTION lib_mpp_alloc
+
+   FUNCTION mynode( ldtxt, kumnam, kstop, localComm ) RESULT (function_value)
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
+      INTEGER ::   kumnam, kstop
+      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
+      IF( .FALSE. )   ldtxt(:) = 'never done'
+   END FUNCTION mynode
+
+   SUBROUTINE mppsync                       ! Dummy routine
+   END SUBROUTINE mppsync
+
+   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mpp_sum_as
+
+   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:,:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
+   END SUBROUTINE mpp_sum_a2s
+
+   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mpp_sum_ai
+
+   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mpp_sum_s
+
+   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
+      integer               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mpp_sum_i
+
+   SUBROUTINE mppsum_realdd( ytab, kcom )
+      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+      WRITE(*,*) 'mppsum_realdd: You should not have seen this print! error?', ytab
+   END SUBROUTINE mppsum_realdd
+ 
+   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
+      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab
+      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+      WRITE(*,*) 'mppsum_a_realdd: You should not have seen this print! error?', kdim, ytab(1), kcom
+   END SUBROUTINE mppsum_a_realdd
+
+   SUBROUTINE mppmax_a_real( parr, kdim, kcom )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mppmax_a_real
+
+   SUBROUTINE mppmax_real( psca, kcom )
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mppmax_real
+
+   SUBROUTINE mppmin_a_real( parr, kdim, kcom )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mppmin_a_real
+
+   SUBROUTINE mppmin_real( psca, kcom )
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mppmin_real
+
+   SUBROUTINE mppmax_a_int( karr, kdim ,kcom)
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mppmax_a_int
+
+   SUBROUTINE mppmax_int( kint, kcom)
+      INTEGER               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mppmax_int
+
+   SUBROUTINE mppmin_a_int( karr, kdim, kcom )
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mppmin_a_int
+
+   SUBROUTINE mppmin_int( kint, kcom )
+      INTEGER               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mppmin_int
+
+   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_1d
+
+   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_2d
+
+   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_3d
+
+   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_4d
+
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj )
+      REAL                   :: pmin
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_minloc2d: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_minloc2d
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj, kk )
+      REAL                     :: pmin
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_minloc3d: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_minloc3d
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      REAL                   :: pmax
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_maxloc2d: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_maxloc2d
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      REAL                     :: pmax
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_maxloc3d: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_maxloc3d
+
+   SUBROUTINE mppstop
+      WRITE(*,*) 'mppstop: You should not have seen this print if running in mpp mode! error?...'
+      WRITE(*,*) 'mppstop: ..otherwise this is a stop condition raised by ctl_stop in single processor mode'
+      STOP
+   END SUBROUTINE mppstop
+
+   SUBROUTINE mpp_ini_ice( kcom, knum )
+      INTEGER :: kcom, knum
+      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom, knum
+   END SUBROUTINE mpp_ini_ice
+
+   SUBROUTINE mpp_ini_znl( knum )
+      INTEGER :: knum
+      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?', knum
+   END SUBROUTINE mpp_ini_znl
+
+   SUBROUTINE mpp_comm_free( kcom )
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
+   END SUBROUTINE mpp_comm_free
+#endif
+
+   !!----------------------------------------------------------------------
+   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn   routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 ,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_opa  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and 
+      !!                increment the error number (nstop) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nstop = nstop + 1 
+      IF(lwp) THEN
+         WRITE(numout,cform_err)
+         IF( PRESENT(cd1 ) )   WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) )   WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) )   WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) )   WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) )   WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) )   WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) )   WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) )   WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) )   WRITE(numout,*) cd9
+         IF( PRESENT(cd10) )   WRITE(numout,*) cd10
+      ENDIF
+                               CALL FLUSH(numout    )
+      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
+      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
+      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
+      !
+      IF( cd1 == 'STOP' ) THEN
+         IF(lwp) WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
+         CALL mppstop()
+      ENDIF
+      !
+   END SUBROUTINE ctl_stop
+
+
+   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_warn  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and 
+      !!                increment the warning number (nwarn) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      ! 
+      nwarn = nwarn + 1 
+      IF(lwp) THEN
+         WRITE(numout,cform_war)
+         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
+         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
+      ENDIF
+      CALL FLUSH(numout)
+      !
+   END SUBROUTINE ctl_warn
+
+
+   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_opn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
+      INTEGER          , INTENT(in   ) ::   klengh    ! record length
+      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
+      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
+      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
+      !!
+      CHARACTER(len=80) ::   clfile
+      INTEGER           ::   iost
+      !!----------------------------------------------------------------------
+
+      ! adapt filename
+      ! ----------------
+      clfile = TRIM(cdfile)
+      IF( PRESENT( karea ) ) THEN
+         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+      ENDIF
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
+      knum=Agrif_Get_Unit()
+#else
+      knum=get_unit()
+#endif
+
+      iost=0
+      IF( cdacce(1:6) == 'DIRECT' )  THEN
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
+      ELSE
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
+      ENDIF
+      IF( iost == 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*) '     file   : ', clfile,' open ok'
+            WRITE(kout,*) '     unit   = ', knum
+            WRITE(kout,*) '     status = ', cdstat
+            WRITE(kout,*) '     form   = ', cdform
+            WRITE(kout,*) '     access = ', cdacce
+            WRITE(kout,*)
+         ENDIF
+      ENDIF
+100   CONTINUE
+      IF( iost /= 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*)
+            WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile
+            WRITE(kout,*) ' =======   ===  '
+            WRITE(kout,*) '           unit   = ', knum
+            WRITE(kout,*) '           status = ', cdstat
+            WRITE(kout,*) '           form   = ', cdform
+            WRITE(kout,*) '           access = ', cdacce
+            WRITE(kout,*) '           iostat = ', iost
+            WRITE(kout,*) '           we stop. verify the file '
+            WRITE(kout,*)
+         ENDIF
+         STOP 'ctl_opn bad opening'
+      ENDIF
+      
+   END SUBROUTINE ctl_opn
+
+
+   INTEGER FUNCTION get_unit()
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  get_unit  ***
+      !!
+      !! ** Purpose :   return the index of an unused logical unit
+      !!----------------------------------------------------------------------
+      LOGICAL :: llopn 
+      !!----------------------------------------------------------------------
+      !
+      get_unit = 15   ! choose a unit that is big enough then it is not already used in NEMO
+      llopn = .TRUE.
+      DO WHILE( (get_unit < 998) .AND. llopn )
+         get_unit = get_unit + 1
+         INQUIRE( unit = get_unit, opened = llopn )
+      END DO
+      IF( (get_unit == 999) .AND. llopn ) THEN
+         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
+         get_unit = -1
+      ENDIF
+      !
+   END FUNCTION get_unit
+
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/limistate_2.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/limistate_2.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/limistate_2.F90	(revision 4056)
@@ -0,0 +1,221 @@
+MODULE limistate_2
+   !!======================================================================
+   !!                     ***  MODULE  limistate_2  ***
+   !!              Initialisation of diagnostics ice variables
+   !!======================================================================
+   !! History :   1.0  !  01-04  (C. Ethe, G. Madec)  Original code
+   !!             2.0  !  03-08  (G. Madec)  add lim_istate_init
+   !!                  !  04-04  (S. Theetten) initialization from a file
+   !!                  !  06-07  (S. Masson)  IOM to read the restart
+   !!                  !  07-10  (G. Madec)  surface module
+   !!--------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   lim_istate_2      :  Initialisation of diagnostics ice variables
+   !!   lim_istate_init_2 :  initialization of ice state and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst
+   USE par_ice_2       ! ice parameters
+   USE dom_ice_2
+   USE eosbn2          ! equation of state
+   USE lbclnk
+   USE oce
+   USE ice_2
+   USE iom
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_istate_2      ! routine called by lim_init_2.F90
+
+   !!! ** init namelist (namiceini) **
+   LOGICAL  ::   ln_limini = .FALSE.  !: Ice initialization state
+   REAL(wp) ::   ttest     = 2.0      ! threshold water temperature for initial sea ice
+   REAL(wp) ::   hninn     = 0.5      ! initial snow thickness in the north
+   REAL(wp) ::   hginn     = 3.0      ! initial ice thickness in the north
+   REAL(wp) ::   alinn     = 0.05     ! initial leads area in the north
+   REAL(wp) ::   hnins     = 0.1      ! initial snow thickness in the south
+   REAL(wp) ::   hgins     = 1.0      ! initial ice thickness in the south
+   REAL(wp) ::   alins     = 0.1      ! initial leads area in the south
+   
+   REAL(wp) ::   zero      = 0.e0     ! constant value = 0
+   REAL(wp) ::   zone      = 1.e0     ! constant value = 1
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id: limistate_2.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_istate_2
+      !!-------------------------------------------------------------------
+      !!                    ***  ROUTINE lim_istate_2  ***
+      !!
+      !! ** Purpose :   defined the sea-ice initial state
+      !!
+      !! ** Method  :   restart from a state defined in a binary file
+      !!                or from arbitrary sea-ice conditions
+      !!--------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zidto                     ! temporary scalar
+      !--------------------------------------------------------------------
+ 
+      CALL lim_istate_init_2     !  reading the initials parameters of the ice
+
+      IF( .NOT. ln_limini ) THEN  
+         
+         tfu(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tms(:,:)       ! freezing/melting point of sea water [Celcius]
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !                     ! ice if sst <= t-freez + ttest
+               IF( tsn(ji,jj,1,jp_tem)  - tfu(ji,jj) >= ttest ) THEN   ;   zidto = 0.e0      ! no ice
+               ELSE                                                    ;   zidto = 1.e0      !    ice
+               ENDIF
+               !
+               IF( fcor(ji,jj) >= 0.e0 ) THEN     !--  Northern hemisphere.
+                  hicif(ji,jj)   = zidto * hginn
+                  frld(ji,jj)    = zidto * alinn + ( 1.0 - zidto ) * 1.0
+                  hsnif(ji,jj)   = zidto * hninn
+               ELSE                               !---  Southern hemisphere.
+                  hicif(ji,jj)   = zidto * hgins
+                  frld(ji,jj)    = zidto * alins + ( 1.0 - zidto ) * 1.0
+                  hsnif(ji,jj)   = zidto * hnins
+               ENDIF
+            END DO
+         END DO
+
+         tfu(:,:) = tfu(:,:) + rt0       ! ftu converted from Celsius to Kelvin (rt0 over land)
+         
+         sist  (:,:)   = tfu(:,:)
+         tbif  (:,:,1) = tfu(:,:)
+         tbif  (:,:,2) = tfu(:,:)
+         tbif  (:,:,3) = tfu(:,:)
+
+      ENDIF
+     
+      fsbbq (:,:)   = 0.e0
+      qstoif(:,:)   = 0.e0
+      u_ice (:,:)   = 0.e0
+      v_ice (:,:)   = 0.e0
+
+      !---  Moments for advection.             
+
+      sxice (:,:)  = 0.e0   ;   sxsn (:,:)  = 0.e0   ;   sxa  (:,:)  = 0.e0
+      syice (:,:)  = 0.e0   ;   sysn (:,:)  = 0.e0   ;   sya  (:,:)  = 0.e0
+      sxxice(:,:)  = 0.e0   ;   sxxsn(:,:)  = 0.e0   ;   sxxa (:,:)  = 0.e0
+      syyice(:,:)  = 0.e0   ;   syysn(:,:)  = 0.e0   ;   syya (:,:)  = 0.e0
+      sxyice(:,:)  = 0.e0   ;   sxysn(:,:)  = 0.e0   ;   sxya (:,:)  = 0.e0
+
+      sxc0  (:,:)  = 0.e0   ;   sxc1 (:,:)  = 0.e0   ;   sxc2 (:,:)  = 0.e0
+      syc0  (:,:)  = 0.e0   ;   syc1 (:,:)  = 0.e0   ;   syc2 (:,:)  = 0.e0
+      sxxc0 (:,:)  = 0.e0   ;   sxxc1(:,:)  = 0.e0   ;   sxxc2(:,:)  = 0.e0
+      syyc0 (:,:)  = 0.e0   ;   syyc1(:,:)  = 0.e0   ;   syyc2(:,:)  = 0.e0
+      sxyc0 (:,:)  = 0.e0   ;   sxyc1(:,:)  = 0.e0   ;   sxyc2(:,:)  = 0.e0
+
+      sxst  (:,:)  = 0.e0
+      syst  (:,:)  = 0.e0
+      sxxst (:,:)  = 0.e0
+      syyst (:,:)  = 0.e0
+      sxyst (:,:)  = 0.e0
+#if ! defined key_lim2_vp
+      stress1_i (:,:) = 0._wp                          ! EVP rheology
+      stress2_i (:,:) = 0._wp
+      stress12_i(:,:) = 0._wp
+#endif
+
+      !-- lateral boundary conditions
+      CALL lbc_lnk( hicif, 'T', 1. )
+      CALL lbc_lnk( frld , 'T', 1. )
+
+      ! C A U T I O N  frld = 1 over land and lbc_lnk put zero along 
+      ! *************  closed boundaries herefore we force to one over land
+      frld(:,:) = tms(:,:) * frld(:,:) + ( 1. - tms(:,:) )   
+
+      CALL lbc_lnk( hsnif, 'T', 1. )
+      CALL lbc_lnk( sist , 'T', 1. , pval = rt0 )      ! set rt0 on closed boundary (required by bulk formulation)
+      DO jk = 1, jplayersp1
+         CALL lbc_lnk(tbif(:,:,jk), 'T', 1. )
+      END DO
+      CALL lbc_lnk( fsbbq  , 'T', 1. )
+      CALL lbc_lnk( qstoif , 'T', 1. )
+
+   END SUBROUTINE lim_istate_2
+
+   
+   SUBROUTINE lim_istate_init_2
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_istate_init_2  ***
+      !!        
+      !! ** 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
+      !!-------------------------------------------------------------------
+      INTEGER :: inum_ice
+      INTEGER :: ji,jj
+
+      NAMELIST/namiceini/ ln_limini, ttest, hninn, hginn, alinn, &
+         &                hnins, hgins, alins
+      !!-------------------------------------------------------------------
+      !
+      REWIND ( numnam_ice )               ! Read Namelist namiceini 
+      READ   ( numnam_ice , namiceini )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_istate_init_2 : ice parameters inititialisation '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '         threshold water temp. for initial sea-ice    ttest      = ', ttest
+         WRITE(numout,*) '         initial snow thickness in the north          hninn      = ', hninn
+         WRITE(numout,*) '         initial ice thickness in the north           hginn      = ', hginn 
+         WRITE(numout,*) '         initial leads area in the north              alinn      = ', alinn            
+         WRITE(numout,*) '         initial snow thickness in the south          hnins      = ', hnins 
+         WRITE(numout,*) '         initial ice thickness in the south           hgins      = ', hgins
+         WRITE(numout,*) '         initial leads area in the south              alins      = ', alins
+         WRITE(numout,*) '         Ice state initialization using input file    ln_limini  = ', ln_limini
+      ENDIF
+
+      IF( ln_limini ) THEN                      ! Ice initialization using input file
+         !
+         CALL iom_open( 'Ice_initialization.nc', inum_ice )
+         !
+         IF( inum_ice > 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '                  ice state initialization with : Ice_initialization.nc'
+            
+            CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif )      
+            CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif )      
+            CALL iom_get( inum_ice, jpdom_data, 'frld' , frld  )     
+            CALL iom_get( inum_ice, jpdom_data, 'ts'   , sist  )
+            CALL iom_get( inum_ice, jpdom_unknown, 'tbif', tbif(1:nlci,1:nlcj,:),   &
+                 &        kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,jplayersp1 /) )
+            ! put some values in the extra-halo...
+            DO jj = nlcj+1, jpj   ;   tbif(1:nlci,jj,:) = tbif(1:nlci,nlej,:)   ;   END DO
+            DO ji = nlci+1, jpi   ;   tbif(ji    ,: ,:) = tbif(nlei  ,:   ,:)   ;   END DO
+
+            CALL iom_close( inum_ice)
+            !
+         ENDIF
+      ENDIF
+      !     
+   END SUBROUTINE lim_istate_init_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_istate_2        ! Empty routine
+   END SUBROUTINE lim_istate_2
+#endif
+
+   !!======================================================================
+END MODULE limistate_2
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/mppini.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/mppini.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/mppini.F90	(revision 4056)
@@ -0,0 +1,517 @@
+
+MODULE mppini
+   !!==============================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   mpp_init       : Lay out the global domain over processors
+   !!   mpp_init2      : Lay out the global domain over processors 
+   !!                    with land processor elimination
+   !!   mpp_init_ioispl: IOIPSL initialization in mpp
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O Manager
+   USE lib_mpp         ! distribued memory computing library
+   USE ioipsl
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: mppini.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!      variables to the value of the global domain
+      !!
+      !! History :
+      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
+      !!----------------------------------------------------------------------
+
+      ! No mpp computation
+      nimpp  = 1
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nperio = jperio
+      nbondi = 2
+      nbondj = 2
+      nidom  = FLIO_DOM_NONE
+      npolj = jperio
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~~~~: '
+         WRITE(numout,*) '         nperio = ', nperio
+         WRITE(numout,*) '         npolj  = ', npolj
+         WRITE(numout,*) '         nimpp  = ', nimpp
+         WRITE(numout,*) '         njmpp  = ', njmpp
+      ENDIF
+
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
+          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
+          &              'the domain is lay out for distributed memory computing! ' )
+
+   END SUBROUTINE mpp_init
+
+
+   SUBROUTINE mpp_init2 
+      CALL mpp_init                             ! same routine as mpp_init
+   END SUBROUTINE mpp_init2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action  : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!   3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers
+      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      -
+      REAL(wp) ::   zidom, zjdom                       ! local scalars
+      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes ilcit() ilcjt()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array (cf. par_oce.F90).
+      
+      nreci  = 2 * jpreci
+      nrecj  = 2 * jprecj
+      iresti = MOD( jpiglo - nreci , jpni )
+      irestj = MOD( jpjglo - nrecj , jpnj )
+
+      IF(  iresti == 0 )   iresti = jpni
+
+#if defined key_nemocice_decomp
+      ! In order to match CICE the size of domains in NEMO has to be changed
+      ! The last line of blocks (west) will have fewer points
+
+      DO jj = 1, jpnj
+         DO ji=1, jpni-1
+            ilcit(ji,jj) = jpi
+         END DO
+         ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci)
+      END DO
+
+#else
+
+      DO jj = 1, jpnj
+         DO ji = 1, iresti
+            ilcit(ji,jj) = jpi
+         END DO
+         DO ji = iresti+1, jpni
+            ilcit(ji,jj) = jpi -1
+         END DO
+      END DO
+      
+#endif
+      IF( irestj == 0 )   irestj = jpnj
+
+#if defined key_nemocice_decomp
+      ! Same change to domains in North-South direction as in East-West. 
+      DO ji=1,jpni
+         DO jj=1,jpnj-1
+            ilcjt(ji,jj) = jpj
+         END DO
+         ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
+      END DO
+
+#else
+
+      DO ji = 1, jpni
+         DO jj = 1, irestj
+            ilcjt(ji,jj) = jpj
+         END DO
+         DO jj = irestj+1, jpnj
+            ilcjt(ji,jj) = jpj -1
+         END DO
+      END DO
+      
+#endif
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           defines mpp subdomains'
+         WRITE(numout,*) '           ----------------------'
+         WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj
+         WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9200    FORMAT('     ***',20('*************',a3))
+ 9203    FORMAT('     *     ',20('         *   ',a3))
+ 9201    FORMAT('        ',20('   ',i3,'          '))
+ 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+      ENDIF
+
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
+      
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
+      IF(lwp) WRITE(numout,*)
+      
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      
+      IF( jpni > 1 ) THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 ) THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
+            END DO
+         END DO
+      ENDIF
+      
+      ! 3. Subdomain description
+      ! ------------------------
+
+      DO jn = 1, jpnij
+         ii = 1 + MOD( jn-1, jpni )
+         ij = 1 + (jn-1) / jpni
+         nimppt(jn) = iimppt(ii,ij)
+         njmppt(jn) = ijmppt(ii,ij)
+         nlcit (jn) = ilcit (ii,ij)     
+         nlci       = nlcit (jn)     
+         nlcjt (jn) = ilcjt (ii,ij)     
+         nlcj       = nlcjt (jn)
+         nbondj = -1                                   ! general case
+         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
+         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
+         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
+         ibonjt(jn) = nbondj
+         
+         nbondi = 0                                    ! 
+         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
+         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
+         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
+         ibonit(jn) = nbondi
+         
+         nldi =  1   + jpreci
+         nlei = nlci - jpreci
+         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
+         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
+         nldj =  1   + jprecj
+         nlej = nlcj - jprecj
+         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
+         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
+         nldit(jn) = nldi
+         nleit(jn) = nlei
+         nldjt(jn) = nldj
+         nlejt(jn) = nlej
+   !      if(lwp) then
+            write(numout,*) ' proc : ', jn, ' nlcjt/njmppt : ', nlcjt(jn),njmppt(jn)
+   !      endif 
+      END DO
+      
+
+      ! 4. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 5. Subdomain neighbours
+      ! ----------------------
+
+      nproc = narea - 1
+      noso  = nproc - jpni
+      nowe  = nproc - 1
+      noea  = nproc + 1
+      nono  = nproc + jpni
+      ! great neighbours
+      npnw = nono - 1
+      npne = nono + 1
+      npsw = noso - 1
+      npse = noso + 1
+      nbsw = 1
+      nbnw = 1
+      IF( MOD( nproc, jpni ) == 0 ) THEN
+         nbsw = 0
+         nbnw = 0
+      ENDIF
+      nbse = 1
+      nbne = 1
+      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
+         nbse = 0
+         nbne = 0
+      ENDIF
+      IF(nproc < jpni) THEN
+         nbsw = 0
+         nbse = 0
+      ENDIF
+      IF( nproc >= (jpnj-1)*jpni ) THEN
+         nbnw = 0
+         nbne = 0
+      ENDIF
+      nlcj = nlcjt(narea)  
+      nlci = nlcit(narea)  
+      nldi = nldit(narea)
+      nlei = nleit(narea)
+      nldj = nldjt(narea)
+      nlej = nlejt(narea)
+      nbondi = ibonit(narea)
+      nbondj = ibonjt(narea)
+      nimpp  = nimppt(narea)  
+      njmpp  = njmppt(narea)  
+
+     ! Save processor layout in layout.dat file 
+       IF (lwp) THEN
+        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jn = 1, jpnij
+         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
+                                      nldit(jn), nldjt(jn), &
+                                      nleit(jn), nlejt(jn), &
+                                      nimppt(jn), njmppt(jn)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! w a r n i n g  narea (zone) /= nproc (processors)!
+
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+         IF( jpni == 1 )THEN
+            nbondi = 2
+            nperio = 1
+         ELSE
+            nbondi = 0
+         ENDIF
+         IF( MOD( narea, jpni ) == 0 ) THEN
+            noea = nproc-(jpni-1)
+            npne = npne-jpni
+            npse = npse-jpni
+         ENDIF
+         IF( MOD( narea, jpni ) == 1 ) THEN
+            nowe = nproc+(jpni-1)
+            npnw = npnw+jpni
+            npsw = npsw+jpni
+         ENDIF
+         nbsw = 1
+         nbnw = 1
+         nbse = 1
+         nbne = 1
+         IF( nproc < jpni ) THEN
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         IF( nproc >= (jpnj-1)*jpni ) THEN
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+      npolj = 0
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         ijm1 = jpni*(jpnj-1)
+         imil = ijm1+(jpni+1)/2
+         IF( narea > ijm1 ) npolj = 3
+         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
+         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+          ijm1 = jpni*(jpnj-1)
+          imil = ijm1+(jpni+1)/2
+          IF( narea > ijm1) npolj = 5
+          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
+          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
+         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
+         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
+         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+      END IF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+   END SUBROUTINE mpp_init
+
+#  include "mppini_2.h90"
+
+# if defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_dimgout'                  NO use of NetCDF files
+   !!----------------------------------------------------------------------
+   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
+   END SUBROUTINE mpp_init_ioipsl  
+# else
+   SUBROUTINE mpp_init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_ioipsl  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!
+      !! History :
+      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
+      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+      !!----------------------------------------------------------------------
+
+      ! The domain is split only horizontally along i- or/and j- direction
+      ! So we need at the most only 1D arrays with 2 elements.
+      ! Set idompar values equivalent to the jpdom_local_noextra definition
+      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
+      iglo(1) = jpiglo
+      iglo(2) = jpjglo
+      iloc(1) = nlci
+      iloc(2) = nlcj
+      iabsf(1) = nimppt(narea)
+      iabsf(2) = njmppt(narea)
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(1) = nldi - 1
+      ihals(2) = nldj - 1
+      ihale(1) = nlci - nlei
+      ihale(2) = nlcj - nlej
+      idid(1) = 1
+      idid(2) = 2
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
+          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
+          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
+      ENDIF
+      !
+      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
+      !
+   END SUBROUTINE mpp_init_ioipsl  
+
+# endif
+#endif
+
+   !!======================================================================
+END MODULE mppini
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/nemogcm.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/nemogcm.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/nemogcm.F90	(revision 4056)
@@ -0,0 +1,818 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
+   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
+   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
+   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
+   !!             -   ! 1992-06  (L.Terray)  coupling implementation
+   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
+   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
+   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
+   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
+   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
+   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
+   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
+   !!             -   ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
+   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
+   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!                 ! 2012-05  (J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!                 ! 2012-07  -  Add calls to crs_dia_wri 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init      : initialization of the NEMO system
+   !!   nemo_ctl       : initialisation of the contol print 
+   !!   nemo_closefile : close remaining open files
+   !!   nemo_alloc     : dynamical allocation
+   !!   nemo_partition : calculate MPP domain decomposition
+   !!   factorise      : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE step_oce        ! module used in the ocean time stepping module
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE cla             ! cross land advection               (tra_cla routine)
+   USE domcfg          ! domain configuration               (dom_cfg routine)
+   USE mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE domain          ! domain initialization             (dom_init routine)
+   USE obcini          ! open boundary cond. initialization (obc_ini routine)
+   USE bdyini          ! open boundary cond. initialization (bdy_init routine)
+   USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine)
+   USE bdytides        ! open boundary cond. initialization (tide_init routine)
+   USE istate          ! initial state setting          (istate_init routine)
+   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
+   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
+   USE zdfini          ! vertical physics setting          (zdf_init routine)
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
+   USE asmtrj          ! writing out state trajectory
+   USE diaptr          ! poleward transports           (dia_ptr_init routine)
+   USE diadct          ! sections transports           (dia_dct_init routine)
+   USE diaobs          ! Observation diagnostics       (dia_obs_init routine)
+   USE step            ! NEMO time-stepping                 (stp     routine)
+   USE iom_ini
+#if defined key_oasis3
+   USE cpl_oasis3      ! OASIS3 coupling
+#elif defined key_oasis4
+   USE cpl_oasis4      ! OASIS4 coupling (not working)
+#endif
+   USE c1d             ! 1D configuration
+   USE step_c1d        ! Time stepping loop for the 1D configuration
+#if defined key_top
+   USE trcini          ! passive tracer initialisation
+#endif
+   USE lib_mpp         ! distributed memory computing
+#if defined key_iomput
+   USE mod_ioclient
+#endif
+   USE crsini          ! initialise grid coarsening utility
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: nemogcm.F90 3352 2012-04-11 12:56:01Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE nemo_gcm
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_gcm  ***
+      !!
+      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal 
+      !!              curvilinear mesh on the sphere.
+      !!
+      !! ** Method  : - model general initialization
+      !!              - launch the time-stepping (stp routine)
+      !!              - finalize the run by closing files and communications
+      !!
+      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
+      !!              Madec, 2008, internal report, IPSL.
+      !!----------------------------------------------------------------------
+      INTEGER ::   istp       ! time step index
+      !!----------------------------------------------------------------------
+      !
+#if defined key_agrif
+      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
+#endif
+
+      !                            !-----------------------!
+      CALL nemo_init               !==  Initialisations  ==!
+      !                            !-----------------------!
+#if defined key_agrif
+      CALL Agrif_Declare_Var       ! AGRIF: set the meshes
+# if defined key_top
+      CALL Agrif_Declare_Var_Top   ! AGRIF: set the meshes
+# endif
+#endif
+      ! check that all process are still there... If some process have an error,
+      ! they will never enter in step and other processes will wait until the end of the cpu time!
+      IF( lk_mpp )   CALL mpp_max( nstop )
+
+      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
+
+      !                            !-----------------------!
+      !                            !==   time stepping   ==!
+      !                            !-----------------------!
+      istp = nit000
+#if defined key_c1d
+         DO WHILE ( istp <= nitend .AND. nstop == 0 )
+            IF( istp == nit000 )   CALL iom_init   ! iom_put initialization
+            CALL stp_c1d( istp )
+            istp = istp + 1
+         END DO
+#else
+          IF( lk_asminc ) THEN
+             IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 )    ! Output background fields
+             IF( ln_trjwri ) CALL asm_trj_wri( nit000 - 1 )    ! Output trajectory fields
+             IF( ln_asmdin ) THEN                        ! Direct initialization
+                IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 )    ! Tracers
+                IF( ln_dyninc ) THEN 
+                   CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics
+                   IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 )      ! update vertical velocity 
+                ENDIF
+                IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )    ! SSH
+             ENDIF
+          ENDIF
+        
+         DO WHILE ( istp <= nitend .AND. nstop == 0 )
+            IF( istp == nit000 )   CALL iom_init   ! iom_put initialization
+#if defined key_agrif
+            CALL Agrif_Step( stp )           ! AGRIF: time stepping
+#else
+            CALL stp( istp )                 ! standard time stepping
+#endif
+            istp = istp + 1
+            IF( lk_mpp )   CALL mpp_max( nstop )
+         END DO
+#endif
+
+      IF( lk_diaobs ) CALL dia_obs_wri
+       
+      !                            !------------------------!
+      !                            !==  finalize the run  ==!
+      !                            !------------------------!
+      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
+      !
+      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+         WRITE(numout,cform_err)
+         WRITE(numout,*) nstop, ' error have been found' 
+      ENDIF
+      !
+#if defined key_agrif
+      CALL Agrif_ParentGrid_To_ChildGrid()
+      IF( lk_diaobs ) CALL dia_obs_wri
+      IF( nn_timing == 1 )   CALL timing_finalize
+      CALL Agrif_ChildGrid_To_ParentGrid()
+#endif
+      IF( nn_timing == 1 )   CALL timing_finalize
+      !
+      CALL nemo_closefile
+#if defined key_oasis3 || defined key_oasis4
+      CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
+#else
+      IF( lk_mpp )   CALL mppstop       ! end mpp communications
+#endif
+      !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji            ! dummy loop indices
+      INTEGER ::   ilocal_comm   ! local integer
+      CHARACTER(len=80), DIMENSION(16) ::   cltxt
+      !!
+      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_bench, nn_timing
+      !!----------------------------------------------------------------------
+      !
+      !
+      cltxt = ''
+      !
+      !                             ! open Namelist file
+      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+# if defined key_oasis3 || defined key_oasis4
+         CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis
+# endif
+         CALL  init_ioclient( ilocal_comm )                 ! exchange io_server nemo local communicator with the io_server
+      ENDIF
+      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection
+#else
+# if defined key_oasis3 || defined key_oasis4
+      IF( Agrif_Root() ) THEN
+         CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis
+      ENDIF
+      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+# else
+      ilocal_comm = 0
+      narea = mynode( cltxt, numnam, nstop )                 ! Nodes selection (control print return in cltxt)
+# endif
+#endif
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      ! If dimensions of processor grid weren't specified in the namelist file 
+      ! then we calculate them here now that we have our communicator size
+      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+#if   defined key_mpp_mpi
+         IF( Agrif_Root() ) CALL nemo_partition(mppsize)
+#else
+         jpni  = 1
+         jpnj  = 1
+         jpnij = jpni*jpnj
+#endif
+      END IF
+
+      ! Calculate domain dimensions given calculated jpni and jpnj
+      ! This used to be done in par_oce.F90 when they were parameters rather
+      ! than variables
+      IF( Agrif_Root() ) THEN
+         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
+#if defined key_nemocice_decomp
+         jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+#else
+         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
+#endif
+         jpk = jpkdta                                             ! third dim
+         jpim1 = jpi-1                                            ! inner domain indices
+         jpjm1 = jpj-1                                            !   "           "
+         jpkm1 = jpk-1                                            !   "           "
+         jpij  = jpi*jpj                                          !  jpi x j
+      ENDIF
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                  version 3.4  (2011) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt) 
+            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         END DO
+         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set we can 
+      ! allocate arrays
+      CALL nemo_alloc()
+
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+
+ 
+      !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+                            CALL     dom_cfg    ! Domain configuration
+                            CALL     dom_init   ! Domain
+
+      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
+
+      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+
+      IF( lk_obc        )   CALL     obc_init   ! Open boundaries 
+      IF( lk_bdy        )   CALL     bdy_init       ! Open boundaries initialisation
+      IF( lk_bdy        )   CALL     bdy_dta_init   ! Open boundaries initialisation of external data arrays
+      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing
+
+                            CALL flush(numout)
+                            CALL dyn_nept_init  ! simplified form of Neptune effect
+                            CALL flush(numout)
+
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+
+      !                                     ! Grid coarsening
+      IF( ln_crs        )   CALL     crs_init   ! Domain initialization of coarsened grid
+                                            ! Ocean physics
+                            CALL     sbc_init   ! Forcings : surface module 
+                           
+      !                                         ! Vertical physics
+                            CALL     zdf_init      ! namelist read
+                            CALL zdf_bfr_init      ! bottom friction
+      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz
+      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme
+      IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme
+      IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme
+      IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing
+      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
+         &                  CALL zdf_ddm_init      ! double diffusive mixing
+      !                                         ! Lateral physics
+                            CALL ldf_tra_init      ! Lateral ocean tracer physics
+                            CALL ldf_dyn_init      ! Lateral ocean momentum physics
+      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing
+      
+      IF( ln_crs .AND. lk_ldfslp ) THEN
+                            CALL dom_grid_crs
+                            CALL ldf_slp_init_crs
+                            CALL dom_grid_glo
+      ENDIF
+      
+      !jes IF( lk_ldfslp .AND. ln_crs )   CALL ldf_slp_init( ld_crs = .TRUE. )      ! slope of lateral mixing
+
+      !                                     ! Active tracers
+                            CALL tra_qsr_init   ! penetrative solar radiation qsr
+                            CALL tra_bbc_init   ! bottom heat flux
+      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_crs .AND. lk_trabbl     )  THEN
+                            CALL dom_grid_crs
+                            CALL tra_bbl_init_crs   ! advective (and/or diffusive) bottom boundary layer scheme
+                            CALL dom_grid_glo
+      ENDIF
+      IF( ln_tradmp     )   CALL tra_dmp_init   ! internal damping trends
+                            CALL tra_adv_init   ! horizontal & vertical advection
+                            CALL tra_ldf_init   ! lateral mixing
+                            CALL tra_zdf_init   ! vertical mixing and after tracer fields
+
+      !                                     ! Dynamics
+                            CALL dyn_adv_init   ! advection (vector or flux form)
+                            CALL dyn_vor_init   ! vorticity term including Coriolis
+                            CALL dyn_ldf_init   ! lateral mixing
+                            CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure
+                            CALL dyn_zdf_init   ! vertical diffusion
+                            CALL dyn_spg_init   ! surface pressure gradient
+      !                                     ! Misc. options
+      IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection
+      
+#if defined key_top
+      !                                     ! Passive tracers
+      
+                            IF( ln_crs_top ) CALL dom_grid_crs 
+                            CALL  trc_init
+                            IF( ln_crs_top ) CALL dom_grid_glo
+                            
+#endif
+      !                                     ! Diagnostics
+      IF( lk_floats     )   CALL     flo_init   ! drifting Floats
+      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag
+                            CALL dia_ptr_init   ! Poleward TRansports initialization
+      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports
+                            CALL dia_hsb_init   ! heat content, salt content and volume budgets
+                            CALL trd_mod_init   ! Mixed-layer/Vorticity/Integral constraints trends
+      IF( lk_diaobs     ) THEN                  ! Observation & model comparison
+                            CALL dia_obs_init            ! Initialize observational data
+                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+      ENDIF      
+      !                                     ! Assimilation increments
+      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
+      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+      
+      !
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting 
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
+         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+      nbench    = nn_bench
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.                        
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( nbench == 1 ) THEN              ! Benchmark 
+         SELECT CASE ( cp_cfg )
+         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
+         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
+            &                                 ' key_gyre must be used or set nbench = 0' )
+         END SELECT
+      ENDIF
+      !
+      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   &
+         &                                               'with the IOM Input/Output manager. '         ,   &
+         &                                               'Compile with key_iomput enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp      /= -1 )   CLOSE( numstp      )   ! time-step file
+      IF( numsol      /= -1 )   CLOSE( numsol      )   ! solver file
+      IF( numnam      /= -1 )   CLOSE( numnam      )   ! oce namelist
+      IF( numnam_ice  /= -1 )   CLOSE( numnam_ice  )   ! ice namelist
+      IF( numevo_ice  /= -1 )   CLOSE( numevo_ice  )   ! ice variables (temp. evolution)
+      IF( numout      /=  6 )   CLOSE( numout      )   ! standard model output file
+      IF( numdct_vol  /= -1 )   CLOSE( numdct_vol  )   ! volume transports
+      IF( numdct_heat /= -1 )   CLOSE( numdct_heat )   ! heat transports
+      IF( numdct_salt /= -1 )   CLOSE( numdct_salt )   ! salt transports
+
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE diawri    , ONLY: dia_wri_alloc
+      USE dom_oce   , ONLY: dom_oce_alloc
+      USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc
+      USE ldftra_oce, ONLY: ldftra_oce_alloc
+      USE trc_oce   , ONLY: trc_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        oce_alloc       ()          ! ocean 
+      ierr = ierr + dia_wri_alloc   ()
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      ierr = ierr + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics
+      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
+      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
+      !
+      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+
+      ierr = 0
+
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of 
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER :: ilfax(ntest)
+
+      ! lfax contains the set of allowed factors.
+      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
+         &                            128,   64,   32,   16,    8,   4,   2  /
+      !!----------------------------------------------------------------------
+
+      ! Clear the error flag and initialise output vars
+      kerr = 0
+      kfax = 1
+      knfax = 0
+
+      ! Find the factors of n.
+      IF( kn == 1 )   GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! knfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+
+      inu   = kn
+      knfax = 0
+
+      DO jl = ntest, 1, -1
+         !
+         ifac = ilfax(jl)
+         IF( ifac > inu )   CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(inu,ifac) == 0 ) THEN
+            !
+            knfax = knfax + 1            ! Add the factor to the list
+            IF( knfax > kmaxfax ) THEN
+               kerr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+               return
+            ENDIF
+            kfax(knfax) = ifac
+            ! Store the other factor that goes with this one
+            knfax = knfax + 1
+            kfax(knfax) = inu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+         ENDIF
+         !
+      END DO
+
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+   END SUBROUTINE factorise
+
+#if defined key_mpp_mpi
+   SUBROUTINE nemo_northcomms
+      !!======================================================================
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !! 
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
+      !!----------------------------------------------------------------------
+
+      INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices
+      INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange
+      INTEGER ::   northcomms_alloc        ! allocate return status
+      REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace
+      LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc )
+      ALLOCATE( lrankset(jpnij), stat = northcomms_alloc )
+      IF( northcomms_alloc /= 0 ) THEN
+         WRITE(numout,cform_war)
+         WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays'
+         CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' )
+      ENDIF
+      nsndto = 0
+      isendto = -1
+      ijpj   = 4
+      !
+      ! This routine has been called because ln_nnogather has been set true ( nammpp )
+      ! However, these first few exchanges have to use the mpi_allgather method to
+      ! establish the neighbour lists to use in subsequent peer to peer exchanges.
+      ! Consequently, set l_north_nogather to be false here and set it true only after
+      ! the lists have been established.
+      !
+      l_north_nogather = .FALSE.
+      !
+      ! Exchange and store ranks on northern rows
+
+      DO jtyp = 1,4
+
+         lrankset = .FALSE.
+         znnbrs = narea
+         SELECT CASE (jtyp)
+            CASE(1)
+               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points
+            CASE(2)
+               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point
+            CASE(3)
+               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point
+            CASE(4)
+               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point
+         END SELECT
+
+         IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+            DO jj = nlcj-ijpj+1, nlcj
+               ij = jj - nlcj + ijpj
+               DO ji = 1,jpi
+                  IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+               &     lrankset(INT(znnbrs(ji,jj))) = .true.
+               END DO
+            END DO
+
+            DO jj = 1,jpnij
+               IF ( lrankset(jj) ) THEN
+                  nsndto(jtyp) = nsndto(jtyp) + 1
+                  IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                     CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+                  &                 ' jpmaxngh will need to be increased ')
+                  ENDIF
+                  isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+               ENDIF
+            END DO
+         ENDIF
+
+      END DO
+
+      !
+      ! Type 5: I-point
+      !
+      ! ICE point exchanges may involve some averaging. The neighbours list is
+      ! built up using two exchanges to ensure that the whole stencil is covered.
+      ! lrankset should not be reset between these 'J' and 'K' point exchanges
+
+      jtyp = 5
+      lrankset = .FALSE.
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+            &     lrankset(INT(znnbrs(ji,jj))) = .true.
+         END DO
+        END DO
+      ENDIF
+
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) &
+            &       lrankset( INT(znnbrs(ji,jj))) = .true.
+            END DO
+         END DO
+
+         DO jj = 1,jpnij
+            IF ( lrankset(jj) ) THEN
+               nsndto(jtyp) = nsndto(jtyp) + 1
+               IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                  CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+               &                 ' jpmaxngh will need to be increased ')
+               ENDIF
+               isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+            ENDIF
+         END DO
+         !
+         ! For northern row areas, set l_north_nogather so that all subsequent exchanges 
+         ! can use peer to peer communications at the north fold
+         !
+         l_north_nogather = .TRUE.
+         !
+      ENDIF
+      DEALLOCATE( znnbrs )
+      DEALLOCATE( lrankset )
+
+   END SUBROUTINE nemo_northcomms
+#else
+   SUBROUTINE nemo_northcomms      ! Dummy routine
+      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
+   END SUBROUTINE nemo_northcomms
+#endif
+   !!======================================================================
+END MODULE nemogcm
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/obs_read_altbias.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/obs_read_altbias.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/obs_read_altbias.F90	(revision 4056)
@@ -0,0 +1,217 @@
+MODULE obs_read_altbias
+   !!======================================================================
+   !!                       ***  MODULE obs_readaltbias  ***
+   !! Observation diagnostics: Read the bias for SLA data
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_altbias : Driver for reading altimeter bias
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp, &
+      & sp
+   USE par_oce, ONLY : &        ! Domain parameters
+      & jpi, &
+      & jpj, &
+      & jpim1
+   USE in_out_manager, ONLY : & ! I/O manager
+      & lwp,    &
+      & numout 
+   USE obs_surf_def             ! Surface observation definitions
+   USE dom_oce, ONLY : &        ! Domain variables
+      & tmask, &
+      & tmask_i, &
+      & e1t,   &
+      & e2t,   &
+      & gphit
+   USE oce, ONLY : &           ! Model variables
+      & sshn
+   USE obs_inter_h2d
+   USE obs_utils               ! Various observation tools
+   USE obs_inter_sup
+   USE wrk_nemo                ! Memory Allocation
+   USE dom_oce, ONLY : glamt, gphit
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_altbias     ! Read the altimeter bias
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_read_altbias.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_altbias ***
+      !!
+      !! ** Purpose : Read from file the bias data 
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2008-02 (D. Lea) Initial version
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+      !
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
+      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+         & sladata       ! SLA data
+      INTEGER, INTENT(IN) :: k2dint
+      CHARACTER(LEN=128) :: bias_file
+
+      !! * Local declarations
+
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
+
+      INTEGER :: jslano       ! Data set loop variable
+      INTEGER :: jobs         ! Obs loop variable
+      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
+      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias
+      INTEGER :: iico         ! Grid point indicies
+      INTEGER :: ijco
+      INTEGER :: i_nx_id      ! Index to read the NetCDF file
+      INTEGER :: i_ny_id      ! 
+      INTEGER :: i_file_id    ! 
+      INTEGER :: i_var_id
+
+      REAL(wp), DIMENSION(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zbias, &
+         & zglam, &
+         & zgphi
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z_altbias
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER :: numaltbias
+
+      CALL wrk_alloc(jpi,jpj,z_altbias) 
+
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) ' obs_rea_altbias : '
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      IF(lwp)WRITE(numout,*) '   Read altimeter bias'
+
+      ! Open the file
+
+      z_altbias(:,:)=0.0_wp
+      numaltbias=0
+
+      IF(lwp)WRITE(numout,*) 'Opening ',bias_file
+
+      CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. )
+      
+
+      IF (numaltbias .GT. 0) THEN      
+
+         ! Get the Alt bias data
+         
+         CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 )
+         
+         ! Close the file
+         
+         CALL iom_close(numaltbias)     
+         
+      ELSE
+
+         IF(lwp)WRITE(numout,*) 'no file found'
+      
+      ENDIF
+
+      ! Intepolate the bias already on the model grid at the observation point
+  
+      DO jslano = 1, kslano
+
+         ALLOCATE( &
+            & igrdi(2,2,sladata(jslano)%nsurf), &
+            & igrdj(2,2,sladata(jslano)%nsurf), &
+            & zglam(2,2,sladata(jslano)%nsurf), &
+            & zgphi(2,2,sladata(jslano)%nsurf), &
+            & zmask(2,2,sladata(jslano)%nsurf), &
+            & zbias(2,2,sladata(jslano)%nsurf)  &
+            & )
+         
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
+            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
+
+         END DO
+
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, glamt, zglam )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, gphit, zgphi )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, tmask(:,:,1), zmask )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, z_altbias, zbias )
+
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            zlam = sladata(jslano)%rlam(jobs)
+            zphi = sladata(jslano)%rphi(jobs)
+            iico = sladata(jslano)%mi(jobs)
+            ijco = sladata(jslano)%mj(jobs)
+            
+            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+               &                   zmask(:,:,jobs), zweig, zobsmask )
+            
+            CALL obs_int_h2d( 1, 1,      &
+               &              zweig, zbias(:,:,jobs),  zext )
+
+            ! adjust mdt with bias field
+            sladata(jslano)%rext(jobs,2) = &
+               sladata(jslano)%rext(jobs,2) - zext(1)
+            
+         END DO
+
+         DEALLOCATE( &
+            & igrdi, &
+            & igrdj, &
+            & zglam, &
+            & zgphi, &
+            & zmask, &
+            & zbias  &
+            & )
+         
+      END DO
+
+      CALL wrk_dealloc(jpi,jpj,z_altbias) 
+
+   END SUBROUTINE obs_rea_altbias
+
+
+ 
+END MODULE obs_read_altbias
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/oce.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/oce.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/oce.F90	(revision 4056)
@@ -0,0 +1,92 @@
+MODULE oce
+   !!======================================================================
+   !!                      ***  MODULE  oce  ***
+   !! Ocean        :  dynamics and active tracers defined in memory 
+   !!======================================================================
+   !! History :  1.0  !  2002-11  (G. Madec)  F90: Free form and module
+   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
+
+   LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
+
+   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
+   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity           [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn            !: 4D T-S fields        [Celcius,psu] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2   [s-2]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsa             !: 4D T-S trends fields & work array 
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
+
+   !! free surface                                      !  before  ! now    ! after  !
+   !! ------------                                      !  fields  ! fields ! trends !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::            sshf_n          !: sea surface height at f-point [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
+
+   !! interpolated gradient (only used in zps case)
+   !! ---------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: oce.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(3)
+      !!----------------------------------------------------------------------
+      !
+      ierr(:) = 0
+      !
+      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
+         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &      
+         &      wn   (jpi,jpj,jpk)      ,                                                       &
+         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &   
+         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
+         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         &
+         &     rhop(jpi,jpj,jpk) ,                                         &
+         &     sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     &
+         &     sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     &
+         &     sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     &
+         &                         sshf_n(jpi,jpj) ,                       &
+         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) )
+         !
+      ALLOCATE(rke(jpi,jpj,jpk)                                      , STAT=ierr(3) )
+         !
+      oce_alloc = MAXVAL( ierr )
+      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION oce_alloc
+
+   !!======================================================================
+END MODULE oce
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/oce_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/oce_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/oce_trc.F90	(revision 4056)
@@ -0,0 +1,309 @@
+MODULE oce_trc
+   !!======================================================================
+   !!                      ***  MODULE  oce_trc  ***
+   !! TOP :   variables shared between ocean and passive tracers
+   !!======================================================================
+   !! History :   1.0  !  2004-03  (C. Ethe)  original code
+   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  rewritting
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+
+   !* Domain size *
+   USE par_oce , ONLY :   cp_cfg   =>   cp_cfg     !: name of the configuration
+   USE par_oce , ONLY :   jp_cfg   =>   jp_cfg     !: resolution of the configuration
+   USE par_oce , ONLY :   jpiglo   =>   jpiglo     !: first  dimension of global domain --> i
+   USE par_oce , ONLY :   jpjglo   =>   jpjglo     !: second dimension of global domain --> j
+   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i 
+   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j  
+   USE par_oce , ONLY :   jpk      =>   jpk        !: number of levels  
+   USE par_oce , ONLY :   jpim1    =>   jpim1      !: jpi - 1
+   USE par_oce , ONLY :   jpjm1    =>   jpjm1      !: jpj - 1 
+   USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1  
+   USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj
+   USE par_oce , ONLY :   jpidta   =>   jpidta     !: first horizontal dimension  > or = jpi
+   USE par_oce , ONLY :   jpjdta   =>   jpjdta     !: second horizontal dimension > or = jpj
+   USE par_oce , ONLY :   jpkdta   =>   jpkdta     !: number of levels            > or = jpk
+   USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option
+   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature
+   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity
+
+   !* IO manager *
+   USE in_out_manager    
+ 
+   !* Memory Allocation *
+   USE wrk_nemo      
+ 
+   !* Timing *
+   USE timing    
+ 
+   !* MPP library                         
+   USE lib_mpp 
+
+   !* Fortran utilities                         
+   USE lib_fortran
+
+   !* Lateral boundary conditions                         
+   USE lbclnk
+
+   !* physical constants *
+   USE phycst            
+
+   !* 1D configuration
+   USE c1d                                         
+
+   !* model domain *
+   USE dom_oce , ONLY :   lzoom      => lzoom        !: zoom flag
+   USE dom_oce , ONLY :   lzoom_e    => lzoom_e      !: East  zoom type flag
+   USE dom_oce , ONLY :   lzoom_w    => lzoom_w      !: West  zoom type flag
+   USE dom_oce , ONLY :   lzoom_s    => lzoom_s      !: South zoom type flag
+   USE dom_oce , ONLY :   lzoom_n    => lzoom_n      !: North zoom type flag
+   USE dom_oce , ONLY :   lzoom_arct => lzoom_arct   !: ORCA    arctic zoom flag
+   USE dom_oce , ONLY :   lzoom_anta => lzoom_anta   !: ORCA antarctic zoom flag
+   USE dom_oce , ONLY :   nperio     =>   nperio     !: type of lateral boundary condition       
+   USE crs , ONLY :   nimpp      =>   nimpp_crs      !: i index for mpp-subdomain left bottom
+   USE crs , ONLY :   njmpp      =>   njmpp_crs      !: j index for mpp-subdomain left bottom
+   USE dom_oce , ONLY :   nproc      =>   nproc      !: number for local processor
+   USE dom_oce , ONLY :   narea      =>   narea      !: number for local area
+   USE crs , ONLY :   mig        =>   mig_crs        !: local  ==> global  domain i-indice
+   USE crs , ONLY :   mjg        =>   mjg_crs        !: local  ==> global  domain i-indice
+   USE crs , ONLY :   mi0        =>   mi0_crs        !: global ==> local domain i-indice 
+   USE crs , ONLY :   mi1        =>   mi1_crs        !: (mi0=1 and mi1=0 if the global indice is not in the local one)
+   USE crs , ONLY :   mj0        =>   mj0_crs        !: global ==> local domain j-indice 
+   USE crs , ONLY :   mj1        =>   mj1_crs        !: (mj0=1 and mj1=0 if the global indice is not in the local one)
+   USE dom_oce , ONLY :   nidom      => nidom
+   USE dom_oce , ONLY :   nimppt     => nimppt     !:i-indexes for each processor
+   USE dom_oce , ONLY :   njmppt     => njmppt       !:j-indexes for each processor
+   USE dom_oce , ONLY :   ibonit     => ibonit       !:i-processor neighbour existence
+   USE dom_oce , ONLY :   ibonjt     => ibonjt       !:j- processor neighbour existence 
+   USE dom_oce , ONLY :   nlci       => nlci         !:i- & j-dimensions of the local subdomain
+   USE dom_oce , ONLY :   nlcj       => nlcj         !:
+   USE dom_oce , ONLY :   nldi       => nldi         !:first and last indoor i- and j-indexes
+   USE dom_oce , ONLY :   nlei       => nlei         !:
+   USE dom_oce , ONLY :   nldj       => nldj         !:
+   USE dom_oce , ONLY :   nlej       => nlej         !:
+   USE dom_oce , ONLY :   nlcit      => nlcit        !:dimensions of every i-subdomain
+   USE dom_oce , ONLY :   nlcjt      => nlcjt        !:dimensions of every j-subdomain
+   USE dom_oce , ONLY :   nldit      => nldit        !:first indoor index for each i-domain 
+   USE dom_oce , ONLY :   nleit      => nleit        !:last indoor index for each i-domain 
+   USE dom_oce , ONLY :   nldjt      => nldjt        !:first indoor index for each j-domain 
+   USE dom_oce , ONLY :   nlejt      => nlejt        !:last indoor index for each j-domain 
+ 
+   !* horizontal mesh *
+   USE crs , ONLY :   glamt      =>   glamt_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   glamu      =>   glamu_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   glamv      =>   glamv_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   glamf      =>   glamf_crs      !: longitude of t-point (degre)  
+   USE crs , ONLY :   gphit      =>   gphit_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   gphiu      =>   gphiu_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   gphiv      =>   gphiv_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   gphif      =>   gphif_crs      !: latitude  of t-point (degre)   
+   USE crs , ONLY :   e1t        =>   e1t_crs        !: horizontal scale factors at t-point (m)  
+   USE crs , ONLY :   e2t        =>   e2t_crs        !: horizontal scale factors at t-point (m)   
+   USE crs , ONLY :   e1e2t      =>   e1e2t_crs      !: cell surface at t-point (m2)
+   USE crs , ONLY :   e1u        =>   e1u_crs        !: horizontal scale factors at u-point (m)
+   USE crs , ONLY :   e2u        =>   e2u_crs        !: horizontal scale factors at u-point (m)
+   USE crs , ONLY :   e1v        =>   e1v_crs        !: horizontal scale factors at v-point (m)
+   USE crs , ONLY :   e2v        =>   e2v_crs        !: horizontal scale factors at v-point (m)  
+   USE crs , ONLY :   e3t        =>  e3t_crs         !: vertical scale factors at t-
+   USE crs , ONLY :   fse3t      =>  e3t_crs
+   USE crs , ONLY :   fse3t_b      =>  e3t_crs
+   USE crs , ONLY :   fse3t_a      =>  e3t_crs
+   USE crs , ONLY :   fse3w      =>  e3w_crs
+   USE crs , ONLY :   e3u        =>  e3u_crs         !: vertical scale factors at u-
+   USE crs , ONLY :   e3v        =>  e3v_crs         !: vertical scale factors v-
+   USE crs , ONLY :   e3w        =>  e3w_crs         !: w-points (m)
+   USE crs , ONLY :   e3f        =>  e3f_crs         !: f-points (m)
+   USE crs , ONLY :   ff         =>  ff_crs         !: f-points (m)
+   USE dom_oce , ONLY :   e3t_0      => e3t_0        !:first indoor index for each j-domain 
+   USE dom_oce , ONLY :    e3w_0     =>   e3w_0      !:last indoor index for each j-domain 
+
+
+   !* vertical mesh *
+   USE dom_oce , ONLY :   gdept_0    =>   gdept_0    !: reference depth of t-points (m)
+   USE dom_oce , ONLY :   e3t_0      =>   e3t_0      !: reference depth of t-points (m)  
+   USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m)
+   USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m)
+# if ! defined key_zco
+   USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ???
+   USE crs , ONLY :   gdept      =>  gdept_crs       !: depth of t-points (m)
+   USE crs , ONLY :   gdepw      =>  gdepw_crs       !: depth of t-points (m)
+   USE crs , ONLY :   e3t        =>  e3t_crs         !: vertical scale factors at t-
+   USE crs , ONLY :   e3u        =>  e3u_crs         !: vertical scale factors at u-
+   USE crs , ONLY :   e3v        =>  e3v_crs         !: vertical scale factors v-
+   USE crs , ONLY :   e3w        =>  e3w_crs         !: w-points (m)
+   USE crs , ONLY :   e3f        =>  e3f_crs         !: f-points (m)
+   USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m)
+   USE dom_oce , ONLY :   e3vw       =>  e3vw       !: vw-points (m)
+# endif
+   USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag
+   USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag
+   USE dom_oce , ONLY :   ln_zco     =>  ln_zco      !: z-coordinate flag
+   USE dom_oce , ONLY :   hbatt      =>  hbatt       !: ocean depth at the vertical of  t-point (m)
+   USE dom_oce , ONLY :   hbatu      =>  hbatu       !: ocean depth at the vertical of  u-point (m)
+   USE dom_oce , ONLY :   hbatv      =>  hbatv       !: ocean depth at the vertical of w-point (m)
+   USE dom_oce , ONLY :   gsigt      =>  gsigt       !: model level depth coefficient at T-levels
+   USE dom_oce , ONLY :   gsigw      =>  gsigw       !: model level depth coefficient at W-levels
+   USE dom_oce , ONLY :   gsi3w      =>  gsi3w       !: model level depth coef at w-levels (defined as the sum of e3w)
+   USE dom_oce , ONLY :   esigt      =>  esigt       !: vertical scale factor coef. at t-levels
+   USE dom_oce , ONLY :   esigw      =>  esigw       !: vertical scale factor coef. at w-levels
+   USE dom_oce , ONLY :   hu         =>  hu
+   USE dom_oce , ONLY :   hv         =>  hv
+   USE dom_oce , ONLY :   hur        =>  hur
+   USE dom_oce , ONLY :   hvr        =>  hvr
+   USE dom_oce , ONLY :   hu_0       =>  hu_0
+   USE dom_oce , ONLY :   hv_0       =>  hv_0
+   USE dom_oce , ONLY :   lk_vvl     =>  lk_vvl      !: variable grid flag
+# if defined key_vvl
+   USE dom_oce , ONLY :   gdep3w_1   =>  gdep3w_1    !: ???
+   USE dom_oce , ONLY :   gdept_1    =>  gdept_1     !: depth of t-points (m)
+   USE dom_oce , ONLY :   gdepw_1    =>  gdepw_1     !: depth of t-points (m)
+   USE dom_oce , ONLY :   e3t_1      =>  e3t_1       !: vertical scale factors at t-
+   USE dom_oce , ONLY :   e3u_1      =>  e3u_1       !: vertical scale factors at u-
+   USE dom_oce , ONLY :   e3v_1      =>  e3v_1       !: vertical scale factors v-
+   USE dom_oce , ONLY :   e3w_1      =>  e3w_1       !: w-points (m)
+   USE dom_oce , ONLY :   e3f_1      =>  e3f_1       !: f-points (m)
+   USE dom_oce , ONLY :   e3uw_1     =>  e3uw_1      !: uw-points (m)
+   USE dom_oce , ONLY :   e3vw_1     =>  e3vw_1      !: vw-points (m)
+# endif
+   !* masks, bathymetry *
+   USE crs , ONLY :   mbkt       =>   mbkt_crs       !: vertical index of the bottom last T- ocean level
+   USE crs , ONLY :   mbku       =>   mbku_crs       !: vertical index of the bottom last U- ocean level
+   USE crs , ONLY :   mbkv       =>   mbkv_crs       !: vertical index of the bottom last V- ocean level
+   USE crs , ONLY :   tmask_i    =>   tmask_i_crs    !: Interior mask at t-points
+   USE crs , ONLY :   tmask      =>   tmask_crs      !: land/ocean mask at t-points
+   USE crs , ONLY :   umask      =>   umask_crs      !: land/ocean mask at u-points   
+   USE crs , ONLY :   vmask      =>   vmask_crs      !: land/ocean mask at v-points 
+   USE crs , ONLY :   fmask      =>   fmask_crs      !: land/ocean mask at f-points 
+
+   !* time domain *
+   USE dom_oce , ONLY :   neuler     =>   neuler     !: restart euler forward option (0=Euler)
+   USE dom_oce , ONLY :   rdt        =>   rdt        !: time step for the dynamics 
+   USE dom_oce , ONLY :   atfp       =>   atfp       !: asselin time filter parameter
+   USE dom_oce , ONLY :   atfp1      =>   atfp1      !: asselin time filter coeff. (atfp1= 1-2*atfp)
+   USE dom_oce , ONLY :   rdttra     =>   rdttra     !: vertical profile of tracer time step
+   !                                                 !: it is the accumulated duration of previous runs
+   !                                                 !: that may have been run with different time steps.
+   !* calendar variables *
+   USE dom_oce , ONLY :   nyear      =>   nyear      !: current year
+   USE dom_oce , ONLY :   nmonth     =>   nmonth     !: current month
+   USE dom_oce , ONLY :   nday       =>   nday       !: current day of the month
+   USE dom_oce , ONLY :   ndastp     =>   ndastp     !: time step date in yyyymmdd format
+   USE dom_oce , ONLY :   nday_year  =>   nday_year  !: current day counted from jan 1st of the current year
+   USE dom_oce , ONLY :   nsec_year  =>   nsec_year  !: current time step counted in second since 00h jan 1st of the current year
+   USE dom_oce , ONLY :   nsec_month =>   nsec_month !: current time step counted in second since 00h 1st day of the current month
+   USE dom_oce , ONLY :   nsec_day   =>   nsec_day   !: current time step counted in second since 00h of the current day
+   USE dom_oce , ONLY :   fjulday    =>   fjulday    !: julian day
+   USE dom_oce , ONLY :   adatrj     =>   adatrj     !: number of elapsed days since the begining of the whole simulation
+                                                     !: (cumulative duration of previous runs 
+                                                     !: that may have used different time-step size)
+   USE dom_oce , ONLY :   nyear_len  =>   nyear_len  !: length in days of the previous/current year
+   USE dom_oce , ONLY :   nmonth_len =>   nmonth_len !: length in days of the months of the current year
+
+
+   !* ocean fields: here now and after fields *
+   USE crs , ONLY :   ua      =>    ua_crs      !: i-horizontal velocity (m s-1) 
+   USE crs , ONLY :   va      =>    va_crs      !: j-horizontal velocity (m s-1)
+   USE crs , ONLY :   un      =>    un_crs      !: i-horizontal velocity (m s-1) 
+   USE crs , ONLY :   vn      =>    vn_crs      !: j-horizontal velocity (m s-1)
+   USE crs , ONLY :   wn      =>    wn_crs      !: vertical velocity (m s-1)  
+   USE crs , ONLY :   tsn     =>    tsn_crs     !: 4D array contaning ( tn, sn )
+   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb )
+   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa )
+   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3) 
+   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
+   USE crs , ONLY :   hdivn   =>    hdivn_crs   !: horizontal divergence (1/s)
+   USE crs , ONLY :   sshn    =>    sshn_crs    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   sshu_n  =>    sshu_n  !: sea surface height at u-point [m]   
+   USE oce , ONLY :   sshu_b  =>    sshu_b  !: sea surface height at u-point [m]   
+   USE oce , ONLY :   sshu_a  =>    sshu_a  !: sea surface height at u-point [m]   
+   USE oce , ONLY :   sshv_n  =>    sshv_n  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   sshv_b  =>    sshv_b  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   sshv_a  =>    sshv_a  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   sshf_n  =>    sshf_n  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion
+   USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1]
+   USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s)
+   USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1]
+#if defined key_offline
+   USE oce , ONLY :   gtsu    =>    gtsu    !: t-, s- and rd horizontal gradient at u- and
+   USE oce , ONLY :   gtsv    =>    gtsv    !:
+   USE oce , ONLY :   gru     =>    gru     !:
+   USE oce , ONLY :   grv     =>    grv     !: 
+#endif
+
+   USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection 
+
+   !* surface fluxes *
+   USE crs , ONLY :   utau       =>    utau_crs       !: i-surface stress component
+   USE crs , ONLY :   vtau       =>    vtau_crs       !: j-surface stress component
+   USE crs , ONLY :   wndm       =>    wndm_crs       !: 10m wind speed 
+   USE crs , ONLY :   qsr        =>    qsr_crs        !: penetrative solar radiation (w m-2)  
+   USE crs , ONLY :   emp        =>    emp_crs        !: freshwater budget: volume flux               [Kg/m2/s]
+   USE crs , ONLY :   emp_b      =>    emp_b_crs      !: freshwater budget: volume flux               [Kg/m2/s]
+   USE crs , ONLY :   emps       =>    emps_crs       !: freshwater budget: concentration/dillution   [Kg/m2/s]
+   USE crs , ONLY :   rnf        =>    rnf_crs        !: river runoff   [Kg/m2/s]
+   USE crs , ONLY :   fr_i       =>    fr_i_crs       !: ice fraction (between 0 to 1)
+   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Daily mean to Diurnal Cycle short wave (qsr) 
+   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths
+   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface
+   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction
+   USE traqsr  , ONLY :   ln_qsr_bio =>    ln_qsr_bio !: flag to use or not the biological fluxes for light
+   USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.) 
+   USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.)
+   USE sbcrnf , ONLY :    h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s]
+
+   USE trc_oce
+
+   !* lateral diffusivity (tracers) *
+   USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity
+   USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s)
+   USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s)
+   USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s)
+   USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points 
+   USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points 
+   USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points 
+   USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points
+   USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s) 
+   USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)   
+   USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s) 
+   USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s) 
+   USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag
+
+   !* vertical diffusion *
+   USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp  
+# if defined key_zdfddm
+   USE crs  , ONLY :   avs        =>   avs_crs         !: salinity vertical diffusivity coeff. at w-point
+# endif
+
+   !* mixing & mixed layer depth *
+   USE zdfmxl , ONLY :   nmln        =>   nmln        !: number of level in the mixed layer
+   USE zdfmxl , ONLY :   hmld        =>   hmld        !: mixing layer depth (turbocline)
+   USE zdfmxl , ONLY :   hmlp        =>   hmlp        !: mixed layer depth  (rho=rho0+zdcrit) (m)
+   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m)
+
+   !* direction of lateral diffusion *
+   USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag
+# if   defined key_ldfslp
+   USE ldfslp_crs , ONLY :   uslp       =>   uslp_crs         !: i-direction slope at u-, w-points
+   USE ldfslp_crs , ONLY :   vslp       =>   vslp_crs         !: j-direction slope at v-, w-points
+   USE ldfslp_crs , ONLY :   wslpi      =>   wslpi_crs        !: i-direction slope at u-, w-points
+   USE ldfslp_crs , ONLY :   wslpj      =>   wslpj_crs        !: j-direction slope at v-, w-points
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: oce_trc.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE oce_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_AMM_12km.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_AMM_12km.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_AMM_12km.h90	(revision 4056)
@@ -0,0 +1,85 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_AMM_12km.h90  ***  
+   !!   Ocean Domain : 12km resolution atlantic  margin model 
+   !!                  (AMM_12km configuration VN3.3)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "amm"  !: name of the configuration
+   INTEGER            :: jp_cfg = 011    !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! Original data size
+      jpidta  = 198,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  = 224,        &  !: second                     > or = to jpj
+      jpkdta  = 33             !: number of levels           > or = to jpk
+   INTEGER            ::     &
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =    0            !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,  &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,  &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,  &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,  &  !: (non dimensional): gives the approximate
+      !                                     !: layer number above which  stretching will
+      !                                     !: be maximum. Usually of order jpk/2.
+      &     ppacr =    9.00000000000_wp     !: (non dimensional): stretching factor
+      !                                     !: for the grid. The highest zacr, the smallest
+      !                                     !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = 6._wp           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5720._wp              !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R2.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R2.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R2.h90	(revision 4056)
@@ -0,0 +1,92 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R2.h90  ***
+   !!   Ocean Domain : 2 km resolution Channel (EEL_R2 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_EEL_R2.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "eel"  !: name of the configuration
+   INTEGER            :: jp_cfg = 2    !: resolution of the configuration (km)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all the input files *
+      jpidta  = 83,          &  !: 1st horizontal dimension ( >= jpi )
+      jpjdta  = 242,         &  !: 2nd    "            "    ( >= jpj )
+      jpkdta  = 30,          &  !: number of levels         ( >= jpk )
+
+   INTEGER            ::     &
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =     1           !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp  , & !: ???
+      pp_to_be_computed =      0._wp      !: ???
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 3            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 2000.0_wp,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = 2000.0_wp       !: meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R5.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R5.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R5.h90	(revision 4056)
@@ -0,0 +1,92 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R5.h90  ***   
+   !!   Ocean Domain : 5 km resolution Channel (EEL_R5 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_EEL_R5.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "eel"  !: name of the configuration
+   INTEGER            :: jp_cfg = 5    !: resolution of the configuration (km)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all the input files
+      jpidta  =  66   ,      &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  66   ,      &  !: second                     > or = to jpj
+      jpkdta  =  31             !: number of levels           > or = to jpk
+
+   INTEGER ::     &
+      ! total domain size      !!! * full domain *
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =   1             !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp ,  &  !:
+      pp_to_be_computed =      0._wp       !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 2            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = 43.436430714_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 8000.0_wp,   &  !: zonal      grid-spacing (meters)
+      ppe2_m   = 8000.0_wp       !: meridional grid-spacing (meters)
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+   REAL(wp), PARAMETER  ::       &   !:
+      &     ppsur = -4762.96143546300_wp    ,  &  !: Computed in domzgr, set ppdzmin, pphmax below
+      &     ppa0  =   255.58049070440_wp    ,  &  !:
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      !
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R6.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R6.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_EEL_R6.h90	(revision 4056)
@@ -0,0 +1,92 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R6.h90  ***   
+   !!   Ocean Domain : 6 km resolution Channel (EEL_R6 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_EEL_R6.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "eel"  !: name of the configuration
+   INTEGER            :: jp_cfg = 6      !: resolution of the configuration (km)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all the input files *
+      jpidta  = 29,          &  !: 1st lateral dimension ( >= jpi )
+      jpjdta  = 83,          &  !: 2nd    "         "    ( >= jpj )
+      jpkdta  = 30,          &  !: number of levels      ( >= jpk )
+
+   INTEGER            ::     &
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+
+      ! Domain characteristics
+      jperio  =      1          !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp ,  &  !: ???
+      pp_to_be_computed =      0._wp       !: ???
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 3            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 6000.0_wp,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = 6000.0_wp       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+   REAL(wp), PARAMETER  ::       &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_GYRE.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_GYRE.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_GYRE.h90	(revision 4056)
@@ -0,0 +1,97 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_GYRE.h90  ***
+   !!   Ocean Domain : GYRE configuration at 1/jp_cfg degree resolution 
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_GYRE.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "gyre"  !: name of the configuration
+   INTEGER            :: jp_cfg = 1       !: resolution of the configuration 
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all the input files *
+      jpidta  = 30*jp_cfg+2, &  !: 1st horizontal dimension ( >= jpi )
+      jpjdta  = 20*jp_cfg+2, &  !: 2nd    "            "    ( >= jpj )
+      jpkdta  = 31              !: number of levels         ( >= jpk )
+
+   INTEGER            ::     &
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =     0           !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp  , & !: ???
+      pp_to_be_computed =      0._wp      !: ???
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 5            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+      !                        ! =5  beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   29.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,    &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used        !: meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+
+   REAL(wp), PARAMETER  ::       &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: 
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !    layer number above which  stretching will
+      !                                           !    be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !    for the grid. The highest zacr, the smallest
+      !                                           !    the stretching.
+
+   !!
+   !!  If all ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = pp_not_used   ,  &  !: (meters): depth of the top (first) model layer
+      !                             !            depth of second "w" level
+      &     pphmax  = pp_not_used         !: (meters): maximum depth of the ocean
+      !                             !            depth of the last "w" level
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R025.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R025.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R025.h90	(revision 4056)
@@ -0,0 +1,118 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R025.h90  ***  
+   !!   Ocean Domain : 0.25 degrees resolution global ocean
+   !!                  (0RCA_R025 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_ORCA_R025.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 025       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! Original data size
+      jpidta  = 1442,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  = 1021,        &  !: second                     > or = to jpj
+#if key_orca_r025==75
+      jpkdta  = 75              !: number of levels           > or = to jpk
+#else
+      jpkdta  = 46              !: number of levels           > or = to jpk
+#endif
+   INTEGER  ::     &
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =    4            !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+#if key_orca_r025==75
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur =  -3958.951371276829_wp  ,  &  !: ORCA r025 coefficients
+      &     ppa0  =   103.9530096000000_wp  ,  &  !: (75 levels case)
+      &     ppa1  =   2.415951269000000_wp  ,  &  !:
+      &     ppkth =   15.35101370000000_wp  ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =       7.00000000000_wp        !: (non dimensional): stretching factor
+      !                                           !: for the grid. The higher zacr, the smaller
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .TRUE.                    !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2  =   100.7609285000000_wp  ,  &  !: Double tanh function parameters
+      &     ppkth2=   48.02989372000000_wp  ,  &  !:
+      &     ppacr2=    13.00000000000_wp          !:
+      !
+#else
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,        &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,        &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,        &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,        &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =   9.00000000000_wp            !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = 6._wp           ,        &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+#endif
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R05.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R05.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R05.h90	(revision 4056)
@@ -0,0 +1,114 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R05.h90  ***  
+   !!   Ocean Domain : 0.5 degrees resolution global ocean
+   !!                  (0RCA_R05 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_ORCA_R05.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 05       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all input files *
+      jpidta  = 722,         &  !: 1st lateral dimension > or = to jpiglo
+      jpjdta  = 511,         &  !: 2nd   "         "     > or = to jpjglo
+      jpkdta  =  31             !: number of levels      > or = to jpkglo
+
+#if defined key_antarctic
+      ! zoom domain size       !!! *  antarctic zoom  * 
+   INTEGER   ::   &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 187   ,      &  !: 2nd     "                 "    --> j 
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1             !: lateral cond. type (between 0 and 6)
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+   INTEGER   ::  
+      ! zoom domain size       !!! *  arctic zoom  *
+      jpiglo  = 562,         &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta-301+1,&  !: 2nd     "                 "    --> j
+      ! zoom starting position
+      jpizoom =  81   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom = 301   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   5             !: lateral cond. type (between 0 and 6)
+
+#else
+      ! global domain size     !!! *  global domain  *
+   INTEGER    ::  &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd     "                 "    --> j
+      ! zoom starting position    
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =    6            !: lateral cond. type (between 0 and 6)
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999._wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER, PARAMETER   ::   & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! =====================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R1.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R1.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R1.h90	(revision 4056)
@@ -0,0 +1,122 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R1.h90  ***  
+   !!   Ocean Domain : 1 degrees resolution global ocean
+   !!                  (0RCA_R1 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_ORCA_R1.h90 2379 2010-11-12 14:51:18Z acc $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Andrew Coward, 12/11/2010.
+   !! Parameters appropriate to ORCA1
+   !! Use: key_orca_r1=75 to set 75 levels
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 1       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! Original data size
+      jpidta  =  362,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  292,        &  !: second                     > or = to jpj
+#if key_orca_r1==75
+      jpkdta  = 75              !: number of levels           > or = to jpk
+#else
+      jpkdta  = 46              !: number of levels           > or = to jpk
+#endif
+
+   INTEGER ::     &
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =   6             !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+#if key_orca_r1==75
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur =  -3958.951371276829_wp  ,  &  !: ORCA r1 coefficients
+      &     ppa0  =   103.9530096000000_wp  ,  &  !: (75 levels case)
+      &     ppa1  =   2.415951269000000_wp  ,  &  !:
+      &     ppkth =   15.35101370000000_wp  ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =       7.00000000000_wp        !: (non dimensional): stretching factor
+      !                                           !: for the grid. The higher zacr, the smaller
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .TRUE.                    !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2  =   100.7609285000000_wp  ,  &  !: Double tanh function parameters
+      &     ppkth2=   48.02989372000000_wp  ,  &  !:
+      &     ppacr2=    13.00000000000_wp          !:
+      !
+#else
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,        &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,        &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,        &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,        &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =   9.00000000000_wp            !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = 6._wp           ,        &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+#endif
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R2.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R2.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R2.h90	(revision 4056)
@@ -0,0 +1,138 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R2.h90  ***  
+   !!   Ocean Domain : 2 degrees resolution global ocean
+   !!                  (0RCA_R2 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_ORCA_R2.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 2       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all input files *
+      jpidta  = 182,         &  !: 1st lateral dimension ( >= jpiglo )
+      jpjdta  = 149,         &  !: 2nd    "       "      ( >= jpjglo )
+      jpkdta  = 31              !: number of levels      ( >= jpk    ) 
+
+#if defined key_antarctic
+      ! zoom domain size       !!! *  antarctic zoom  * 
+   INTEGER  ::   &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 50,          &  !: 2nd    "                  "    --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1             !: lateral cond. type (between 0 and 6)
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+   INTEGER  ::  &
+      jpiglo  = 142   ,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta-97+1, &  !: 2nd    "                  "    --> j
+      ! zoom starting position 
+      jpizoom =  21   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =  97   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   3             !: lateral cond. type (between 0 and 6)
+
+#elif defined key_c1d
+      ! global domain size     !!! *  global domain  *
+   INTEGER  ::   &
+      jpiglo  = 3     ,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 3     ,      &  !: 2nd    "                  "    --> j
+      ! starting position of the zoom 
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   133  ,    &  !: in data domain indices (160W,75N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   110  ,    &  !: in data domain indices (160W,50N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   97   ,    &  !: in data domain indices (160W,30N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   86   ,    &  !: in data domain indices (160W,10N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   49   ,    &  !: in data domain indices (160W,30S)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   27   ,    &  !: in data domain indices (160W,60S)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =    7   ,    &  !: in data domain indices (160W,75S)
+      jpizoom =   110   ,    &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   97   ,    &  !: in data domain indices (64W,31.5N) BATS site
+      ! Domain characteristics
+      jperio  =   0            !: lateral cond. type (between 0 and 6)
+#else
+      ! global domain size     !!! *  global domain  *
+   INTEGER   ::  &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! starting position of the zoom 
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   4             !: lateral cond. type (between 0 and 6)
+
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R4.h90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R4.h90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_ORCA_R4.h90	(revision 4056)
@@ -0,0 +1,87 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R4.h90  ***   
+   !!   Ocean Domain : 4 degrees resolution global ocean
+   !!                  (0RCA_R4 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_ORCA_R4.h90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 4       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all input files *
+      jpidta  =  92   ,      &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  76   ,      &  !: second                     > or = to jpj
+      jpkdta  =  31             !: number of levels           > or = to jpk
+   
+   INTEGER           ::     &
+      ! global domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =   4             !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_my_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_my_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_my_trc.F90	(revision 4056)
@@ -0,0 +1,73 @@
+MODULE par_my_trc
+   !!======================================================================
+   !!                        ***  par_my_trc  ***
+   !! TOP :   set the MY_TRC parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: par_my_trc.F90 3897 2013-05-02 14:29:49Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER
+
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_2d       !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_3d       !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_trd      !: number of tracers in CFC
+
+   USE par_c14b   , ONLY : jp_c14b         !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_2d      !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_3d      !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_trd     !: number of tracers in C14
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lm      = jp_lobster     + jp_pisces     + jp_cfc     + jp_c14b     !: 
+   INTEGER, PARAMETER ::   jp_lm_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !:
+   INTEGER, PARAMETER ::   jp_lm_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !:
+   INTEGER, PARAMETER ::   jp_lm_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !:
+
+#if defined key_my_trc
+   !!---------------------------------------------------------------------
+   !!   'key_my_trc'                     user defined tracers (MY_TRC)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .TRUE.   !: PTS flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  1       !: number of PTS tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: additional 2d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: additional 3d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC
+
+   ! assign an index in trc arrays for each PTS prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpmyt1 = jp_lm + 1     !: 1st MY_TRC tracer
+#else
+   !!---------------------------------------------------------------------
+   !!   Default                           No user defined tracers (MY_TRC)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .FALSE.  !: MY_TRC flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  0       !: No MY_TRC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: No MY_TRC additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: No MY_TRC additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC
+#endif
+
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0     = jp_lm     + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1     = jp_lm     + jp_my_trc      !: Last  index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_2d  = jp_lm_2d  + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_2d  = jp_lm_2d  + jp_my_trc_2d   !: Last  index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_3d  = jp_lm_3d  + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_3d  = jp_lm_3d  + jp_my_trc_3d   !: Last  index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_trd = jp_lm_trd + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_trd = jp_lm_trd + jp_my_trc_trd  !: Last  index of MY_TRC passive tracers
+
+   !!======================================================================
+END MODULE par_my_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_oce.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_oce.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_oce.F90	(revision 4056)
@@ -0,0 +1,205 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! History :  OPA  !  1991     (Imbard, Levy, Madec)  Original code
+   !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal
+   !!            3.3  !  2012-07  (J. Simeon) renounced parameter status for jpiglo, jpjglo 
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
+   INTEGER, PUBLIC            ::   jpni         !: number of processors following i 
+   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j
+   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj )
+   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpreci = 1   !: number of columns for overlap 
+   INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap 
+
+   !! Ocean Domain sizes
+   !! ------------------
+   !!   data           domain   (jpidta,jpjdta)
+   !!   global or zoom domain   (jpiglo,jpjglo)
+   !!   local          domain   ( jpi  , jpj  )
+   
+#if   defined key_orca_r4
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r4'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R4.h90"
+#elif defined key_orca_r2
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r2'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R2.h90"
+#elif defined key_orca_r1
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r1'   :                           global ocean : ORCA R1
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R1.h90"
+#elif defined key_orca_r05
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r05'  :                          global ocean : ORCA R05
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R05.h90"
+#elif defined key_orca_r025
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r025' :                         global ocean : ORCA R025
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R025.h90"
+#elif defined key_eel_r2
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r2'    :                                 channel : EEL R2
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R2.h90"
+#elif defined key_eel_r5
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r5'    :                                 channel : EEL R5
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R5.h90"
+#elif defined key_eel_r6
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r6'    :                                 channel : EEL R6
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R6.h90"
+#elif defined key_gyre
+   !!---------------------------------------------------------------------
+   !!   'key_gyre'      :                        mid-latitude basin : GYRE
+   !!---------------------------------------------------------------------
+#             include "par_GYRE.h90"
+#elif defined key_pomme_r025
+   !!---------------------------------------------------------------------
+   !!   'key_pomme_r025':                        regional basin : POMME025
+   !!---------------------------------------------------------------------
+#             include "par_POMME_R025.h90"
+#elif defined key_amm_12km
+   !!---------------------------------------------------------------------
+   !!   'key_amm_12km':                    Atlantic Margin Model : AMM12km 
+   !!---------------------------------------------------------------------
+#             include "par_AMM_12km.h90"
+#else
+   !!---------------------------------------------------------------------
+   !!   default option  :                               small closed basin
+   !!---------------------------------------------------------------------
+   CHARACTER(len=16), PUBLIC ::   cp_cfg = "default"   !: name of the configuration
+   INTEGER          , PUBLIC ::   jp_cfg = 0           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi )
+   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj )
+   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size (formerly parameters) !!! * computational domain *
+   INTEGER, PUBLIC            ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
+   INTEGER, PUBLIC            ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
+
+   ! zoom starting position 
+   INTEGER, PUBLIC ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
+   INTEGER, PUBLIC ::   jpjzoom =   1      !: in data domain indices
+
+   ! Domain characteristics
+   INTEGER, PUBLIC ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
+   !                                                  !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                                  !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                                  !  = 5 North fold F-point pivot
+   !                                                  !  = 6 cyclic East-West AND North fold F-point pivot
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+
+
+   !! Horizontal grid parameters for domhgr
+   !! =====================================
+   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh
+   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                                !  = 2 f-plane with regular grid-spacing
+   !                                                !  = 3 beta-plane with regular grid-spacing
+   !                                                !  = 4 Mercator grid with T/U point at the equator
+
+   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients
+   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients)
+   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing
+   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth
+   !
+   LOGICAL , PUBLIC, PARAMETER ::   ldbletanh = .TRUE.   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PUBLIC, PARAMETER ::   ppa2  =   100.760928500000_wp   !: Double tanh function parameters
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth2=    48.029893720000_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr2=    13.000000000000_wp   !:
+   !
+#endif
+
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size  (if AGRIF, they are not all parameters)
+   !!---------------------------------------------------------------------
+#if defined key_agrif
+   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells
+   INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction
+   INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction
+   !
+#endif
+   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC  ::   jpk   ! = jpkdta
+   INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
+
+   !!---------------------------------------------------------------------
+   !! Optimization/control flags
+   !!---------------------------------------------------------------------
+#if defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
+#endif
+
+#if defined key_vectopt_loop
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_oce.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_oce
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/par_trc.F90	(revision 4056)
@@ -0,0 +1,45 @@
+MODULE par_trc
+   !!======================================================================
+   !!                        ***  par_trc  ***
+   !! TOP :   set the passive tracers parameters
+   !!======================================================================
+   !! History :    -   !  1996-01  (M. Levy)  original code
+   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model
+   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
+   !!             1.0  !  2004-03  (C. Ethe) Free form and module
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+   !
+   USE par_lobster   ! LOBSTER model
+   USE par_pisces    ! PISCES  model
+   USE par_c14b      ! C14 bomb tracer
+   USE par_cfc       ! CFC 11 and 12 tracers
+   USE par_my_trc    ! user defined passive tracers
+
+   IMPLICIT NONE
+
+   ! Passive tracers : Total size
+   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays
+   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_lobster    + jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_lobster_2d + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_lobster_3d + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d
+   !                     ! total number of sms diagnostic arrays
+   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd
+   
+   !  1D configuration ("key_c1d")
+   ! -----------------
+# if defined key_c1d
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .TRUE.   !: 1D pass. tracer configuration flag
+# else   
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .FALSE.  !: 1D pass. tracer configuration flag
+# endif
+
+   REAL(wp), PUBLIC  :: rtrn  = 1.e-15      !: truncation value     
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: par_trc.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/step.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/step.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/step.F90	(revision 4056)
@@ -0,0 +1,310 @@
+MODULE step
+   !!======================================================================
+   !!                       ***  MODULE step  ***
+   !! Time-stepping    : manager of the ocean, tracer and ice time stepping
+   !!======================================================================
+   !! History :  OPA  !  1991-03  (G. Madec)  Original code
+   !!             -   !  1991-11  (G. Madec)
+   !!             -   !  1992-06  (M. Imbard)  add a first output record
+   !!             -   !  1996-04  (G. Madec)  introduction of dynspg
+   !!             -   !  1996-04  (M.A. Foujols)  introduction of passive tracer
+   !!            8.0  !  1997-06  (G. Madec)  new architecture of call
+   !!            8.2  !  1997-06  (G. Madec, M. Imbard, G. Roullet)  free surface
+   !!             -   !  1999-02  (G. Madec, N. Grima)  hpg implicit
+   !!             -   !  2000-07  (J-M Molines, M. Imbard)  Open Bondary Conditions
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  free form, suppress macro-tasking
+   !!             -   !  2004-08  (C. Talandier) New trends organization
+   !!             -   !  2005-01  (C. Ethe) Add the KPP closure scheme
+   !!             -   !  2005-11  (G. Madec)  Reorganisation of tra and dyn calls
+   !!             -   !  2006-01  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   !  2006-07  (S. Masson)  restart using iom
+   !!            3.2  !  2009-02  (G. Madec, R. Benshila)  reintroduicing z*-coordinate
+   !!             -   !  2009-06  (S. Masson, G. Madec)  TKE restart compatible with key_cpl
+   !!            3.3  !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
+   !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal
+   !!                 !  2012-07  (J. Simeon, G. Madec. C. Ethe) call to crs_dia_wri added
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp             : OPA system time-stepping
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules 
+#if defined key_top
+   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+#endif
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+#endif
+   USE sbc_oce
+
+ 
+   
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp   ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: step.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_agrif
+   SUBROUTINE stp( )
+      INTEGER             ::   kstp   ! ocean time-step index
+#else
+   SUBROUTINE stp( kstp )
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+#endif
+      !!----------------------------------------------------------------------
+      !!                     ***  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.)
+      !! 
+      !! ** Method  : -1- Update forcings and data  
+      !!              -2- Update ocean physics 
+      !!              -3- Compute the t and s trends 
+      !!              -4- Update t and s 
+      !!              -5- Compute the momentum trends
+      !!              -6- Update the horizontal velocity
+      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
+      !!              -8- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk       ! dummy loop indice
+      INTEGER ::   indic    ! error indicator if < 0
+      !! ---------------------------------------------------------------------
+
+#if defined key_agrif
+      kstp = nit000 + Agrif_Nb_Step()
+!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
+!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
+# if defined key_iomput
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap
+# endif   
+#endif   
+                             indic = 0                ! reset to no error condition
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp )   ! say to iom that we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update data, open boundaries, surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+      IF( lk_tide    )   CALL sbc_tide( kstp )
+      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries
+      IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries
+      IF( lk_bdy     )   CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries
+      emp(:,:) = 0._wp
+      emps(:,:) = 0._wp
+!      un(:,:,:) = 0._wp
+!      vn(:,:,:) = 0._wp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Ocean dynamics : ssh, wn, hdiv, rot                                 !
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL ssh_wzv( kstp )         ! after ssh & vertical velocity
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update                (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency
+                         CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency
+
+                             
+      !
+      !  VERTICAL PHYSICS   
+                         CALL zdf_bfr( kstp )         ! bottom friction
+
+                         
+      !                                               ! Vertical eddy viscosity and diffusivity coefficients
+      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz
+      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
+      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
+      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
+      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
+         avt (:,:,:) = rn_avt0 * tmask(:,:,:)
+         avmu(:,:,:) = rn_avm0 * umask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * vmask(:,:,:)
+      ENDIF
+      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
+      ENDIF
+      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
+
+      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
+
+   !!cc   IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
+   !!cc      &               CALL zdf_ddm( kstp )         ! double diffusive mixing
+         
+                         CALL zdf_mxl( kstp )         ! mixed layer depth
+   !!cc                      CALL zdf_mxl_crs(kstp)
+
+                                                      ! write TKE or GLS information in the restart file
+      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
+      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
+      !
+      !  LATERAL  PHYSICS 
+      !
+      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing
+                         CALL eos( tsb, rhd )                ! before in situ density
+         IF( ln_zps )    CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
+            &                                      rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         IF( ln_traldf_grif ) THEN                           ! before slope for Griffies operator
+                         CALL ldf_slp_grif( kstp )
+!jes                         IF( ln_crs ) CALL ldf_slp_grif( kstp, ld_crs=.TRUE. )
+         ELSE
+                         CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator
+!jes                         IF( ln_crs ) CALL ldf_slp( kstp, rhd, rn2b, ld_crs=.TRUE. )     ! before slope for Madec operator
+         ENDIF
+      ENDIF
+#if defined key_traldf_c2d
+      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs             (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
+      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
+      IF( lk_diafwb  )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
+      IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics
+      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports
+      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag
+      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
+                         CALL dia_wri( kstp )         ! ocean model: outputs
+      IF( ln_crs     )   CALL crs_dia_wri( kstp )     ! ocean model: output on coarsened grid
+
+
+#if defined key_top
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                        IF( ln_crs     )   THEN
+                             CALL dom_grid_crs
+                             CALL eos_crs(tsn_crs , rhd_crs, rhop_crs)                             
+                    !         CALL bn2_crs(tsn_crs , rn2_crs)
+                             CALL bn2_crs(tsb_crs , rb2_crs)
+                             IF( ln_zps )   &
+                             &  CALL zps_hde_crs( kstp, 1, tsb_crs, gtsu_crs, gtsv_crs, rhd_crs, gru_crs, grv_crs )
+                             CALL zdf_mxl_crs(kstp)
+                             IF( lk_ldfslp ) THEN 
+                                CALL eos_crs( tsb_crs, rhd_crs )
+                                IF( .NOT. ln_traldf_grif )   CALL ldf_slp_crs( kstp, rhd_crs, rb2_crs )
+                             ENDIF
+                             
+                             CALL dom_grid_glo
+                         ENDIF
+                         IF( ln_crs_top ) CALL dom_grid_crs
+                         IF(lwp) WRITE(numout,*) 'jpj_crs', jpj
+                         IF(lwp) WRITE(numout,*) 'jpi_crs', jpi
+
+                         CALL trc_stp( kstp )         ! time-stepping
+                         IF( ln_crs_top ) CALL dom_grid_glo
+                         
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers                              (ua, va used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
+
+      IF(  ln_asmiau .AND. &
+         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
+                             CALL tra_sbc    ( kstp )       ! surface boundary condition
+      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr
+      IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux
+      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends
+                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection
+      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
+                             CALL tra_ldf    ( kstp )       ! lateral mixing
+#if defined key_agrif
+      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge
+#endif
+                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields
+
+      IF( ln_dynhpg_imp  ) THEN                             ! semi-implicit hpg (time stepping then eos)
+         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
+                             CALL tra_nxt( kstp )                ! tracer fields at next time step
+                             CALL eos    ( tsa, rhd, rhop )      ! Time-filtered in situ density for hpg computation
+
+         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv,  &    ! zps: time filtered hor. derivative
+            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         
+      ELSE                                                  ! centered hpg  (eos then time stepping)
+                             CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation
+         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative
+            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
+                             CALL tra_nxt( kstp )                ! tracer fields at next time step
+      ENDIF 
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Dynamics                                    (tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero
+                               va(:,:,:) = 0.e0
+
+      IF(  ln_asmiau .AND. &
+         & ln_dyninc       )   CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
+      IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified)
+                               CALL dyn_adv( kstp )         ! advection (vector or flux form)
+                               CALL dyn_vor( kstp )         ! vorticity term including Coriolis
+                               CALL dyn_ldf( kstp )         ! lateral mixing
+      IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! add Neptune velocities (simplified)
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())   CALL Agrif_Sponge_dyn        ! momemtum sponge
+#endif
+                               CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure
+                               CALL dyn_bfr( kstp )         ! bottom friction   
+                               CALL dyn_zdf( kstp )         ! vertical diffusion
+                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient
+                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step
+
+                               CALL ssh_nxt( kstp )         ! sea surface height at next time step
+
+      IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
+      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control and restarts
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                               CALL stp_ctl( kstp, indic )
+      IF( indic < 0        )   THEN
+                               CALL ctl_stop( 'step: indic < 0' )
+                               CALL dia_wri_state( 'output.abort', kstp )
+      ENDIF
+      IF( kstp == nit000   )   CALL iom_close( numror )     ! close input  ocean restart file
+      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+      IF( lk_obc           )   CALL obc_rst_write( kstp )   ! write open boundary restart file
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Trends                              (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( nstop == 0 ) THEN                         
+         IF( lk_trddyn     )   CALL trd_dwr( kstp )         ! trends: dynamics 
+         IF( lk_trdtra     )   CALL trd_twr( kstp )         ! trends: active tracers
+         IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer 
+         IF( lk_trdvor     )   CALL trd_vor( kstp )         ! trends: vorticity budget
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Coupled mode
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_cpl           )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
+      !
+      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
+      !
+   END SUBROUTINE stp
+
+   !!======================================================================
+END MODULE step
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/step_oce.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/step_oce.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/step_oce.F90	(revision 4056)
@@ -0,0 +1,124 @@
+MODULE step_oce
+   !!======================================================================
+   !!                       ***  MODULE step_oce  ***
+   !! Ocean time-stepping : module used in both initialisation phase and time stepping
+   !!======================================================================
+   !! History :   3.3  ! 2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
+   !!                  ! 2012-07  (J. Simeon, G. Madec, C. Ethe) add crsdiawri 
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers variables
+   USE dom_oce          ! ocean space and time domain variables 
+   USE zdf_oce          ! ocean vertical physics variables
+   USE ldftra_oce       ! ocean tracer   - trends
+   USE ldfdyn_oce       ! ocean dynamics - trends
+   USE in_out_manager   ! I/O manager
+   USE iom              !
+   USE lbclnk
+   !!cc
+   USE crs
+   USE eosbn2_crs 
+   USE zdfmxl_crs
+   USE ldfslp_crs 
+   USE zpshde_crs
+   USE trabbl_crs
+   USE trc, ONLY : trn
+   
+   !!cc
+
+   USE daymod           ! calendar                         (day     routine)
+
+   USE sbcmod           ! surface boundary condition       (sbc     routine)
+   USE sbcrnf           ! surface boundary condition: runoff variables
+   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
+   USE cpl_oasis3, ONLY : lk_cpl
+   USE sbctide          ! Tide initialisation
+
+   USE traqsr           ! solar radiation penetration      (tra_qsr routine)
+   USE trasbc           ! surface boundary condition       (tra_sbc routine)
+   USE trabbc           ! bottom boundary condition        (tra_bbc routine)
+   USE trabbl           ! bottom boundary layer            (tra_bbl routine)
+   USE tradmp           ! internal damping                 (tra_dmp routine)
+   USE traadv           ! advection scheme control     (tra_adv_ctl routine)
+   USE traldf           ! lateral mixing                   (tra_ldf routine)
+   !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine)
+   USE trazdf           ! vertical mixing                  (tra_zdf routine)
+   USE tranxt           ! time-stepping                    (tra_nxt routine)
+   USE tranpc           ! non-penetrative convection       (tra_npc routine)
+
+   USE eosbn2           ! equation of state                (eos_bn2 routine)
+
+   USE dynadv           ! advection                        (dyn_adv routine)
+   USE dynbfr           ! Bottom friction terms            (dyn_bfr routine)
+   USE dynvor           ! vorticity term                   (dyn_vor routine)
+   USE dynhpg           ! hydrostatic pressure grad.       (dyn_hpg routine)
+   USE dynldf           ! lateral momentum diffusion       (dyn_ldf routine)
+   USE dynzdf           ! vertical diffusion               (dyn_zdf routine)
+   USE dynspg_oce       ! surface pressure gradient        (dyn_spg routine)
+   USE dynspg           ! surface pressure gradient        (dyn_spg routine)
+   USE dynnept          ! simp. form of Neptune effect(dyn_nept_cor routine)
+
+   USE dynnxt           ! time-stepping                    (dyn_nxt routine)
+
+   USE obc_par          ! open boundary condition variables
+   USE obcdta           ! open boundary condition data     (obc_dta routine)
+   USE obcrst           ! open boundary cond. restart      (obc_rst routine)
+   USE obcrad           ! open boundary cond. radiation    (obc_rad routine)
+
+   USE bdy_par          ! for lk_bdy
+   USE bdydta           ! open boundary condition data     (bdy_dta routine)
+
+   USE sshwzv           ! vertical velocity and ssh        (ssh_wzv routine)
+
+   USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
+   USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine)
+
+   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
+   USE zdfbfr           ! bottom friction                  (zdf_bfr routine)
+   USE zdftke           ! TKE vertical mixing              (zdf_tke routine)
+   USE zdfgls           ! GLS vertical mixing              (zdf_gls routine)
+   USE zdfkpp           ! KPP vertical mixing              (zdf_kpp routine)
+   USE zdfddm           ! double diffusion mixing          (zdf_ddm routine)
+   USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine)
+   USE zdfric           ! Richardson vertical mixing       (zdf_ric routine)
+   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine)
+
+   USE zpshde           ! partial step: hor. derivative     (zps_hde routine)
+
+   USE diawri           ! Standard run outputs             (dia_wri routine)
+   USE trdicp           ! Ocean momentum/tracers trends    (trd_wri routine)
+   USE trdmld           ! mixed-layer trends               (trd_mld routine)
+   USE trdmld_rst       ! restart for mixed-layer trends
+   USE trdmod_oce       ! ocean momentum/tracers trends
+   USE trdmod           ! momentum/tracers trends   
+   USE trdvor           ! vorticity budget                 (trd_vor routine)
+   USE diaptr           ! poleward transports              (dia_ptr routine)
+   USE diadct           ! sections transports              (dia_dct routine)
+   USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine)
+   USE diahth           ! thermocline depth                (dia_hth routine)
+   USE diafwb           ! freshwater budget                (dia_fwb routine)
+   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine)
+   USE diaharm
+   USE flo_oce          ! floats variables
+   USE floats           ! floats computation               (flo_stp routine)
+   USE crsdiawri        ! Standard output on coarse grid   (crs_dia_wri routine)
+
+   USE asminc           ! assimilation increments      (tra_asm_inc routine)
+   !                                                   (dyn_asm_inc routine)
+
+   USE stpctl           ! time stepping control            (stp_ctl routine)
+   USE restart          ! ocean restart                    (rst_wri routine)
+   USE prtctl           ! Print control                    (prt_ctl routine)
+
+   USE diaobs           ! Observation operator
+
+   USE timing           ! Timing            
+
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: step_oce.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE step_oce
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/tide_mod.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/tide_mod.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/tide_mod.F90	(revision 4056)
@@ -0,0 +1,494 @@
+MODULE tide_mod
+  !!=================================================================================
+  !!                       ***  MODULE  tide_mod  ***
+  !! Compute nodal modulations corrections and pulsations
+  !!=================================================================================
+  !!---------------------------------------------------------------------------------
+  !!   OPA 9.0 , LODYC-IPSL  (2003)
+  !!---------------------------------------------------------------------------------
+  USE par_kind
+  USE dom_oce         ! ocean space and time domain
+  USE phycst
+  USE daymod
+
+  IMPLICIT NONE
+  PRIVATE
+
+  REAL(wp) :: sh_T, sh_s, sh_h, sh_p, sh_p1, &
+       sh_xi, sh_nu, sh_nuprim, sh_nusec, sh_R, &
+       sh_I, sh_x1ra, sh_N
+
+  INTEGER,PUBLIC, PARAMETER ::   &
+       jpmax_harmo = 19             ! maximum number of harmonic
+
+  TYPE tide
+     CHARACTER(LEN=4)  :: cname_tide
+     REAL(wp) :: equitide
+     INTEGER  :: nutide
+     INTEGER  ::  nt,ns,nh,np,np1,shift
+     INTEGER  ::  nksi,nnu0,nnu1,nnu2,R
+     INTEGER  :: nformula
+  END TYPE tide
+
+  TYPE(tide), PUBLIC, DIMENSION(jpmax_harmo) :: Wave
+
+  !! * Accessibility
+  PUBLIC tide_harmo
+  PUBLIC nodal_factort
+  PUBLIC tide_init_Wave
+
+CONTAINS
+
+  SUBROUTINE tide_init_Wave
+
+#  include "tide.h90"
+
+  END SUBROUTINE tide_init_Wave
+
+  SUBROUTINE tide_harmo( pomega, pvt, put , pcor, ktide ,kc)
+
+    INTEGER, DIMENSION(kc), INTENT( in ) ::   &
+         ktide      ! Indice of tidal constituents
+
+    INTEGER, INTENT( in ) :: &
+         kc         ! Total number of tidal constituents
+
+    REAL (wp), DIMENSION(kc), INTENT( out ) ::   &
+         pomega      ! pulsation in radians/s
+
+    REAL (wp), DIMENSION(kc), INTENT( out ) ::   &
+         pvt, &      !
+         put, &      !
+         pcor         !
+
+    CALL astronomic_angle
+    CALL tide_pulse(pomega, ktide ,kc)
+    CALL tide_vuf( pvt, put, pcor, ktide ,kc)
+
+  END SUBROUTINE tide_harmo
+
+  SUBROUTINE astronomic_angle
+
+    !!----------------------------------------------------------------------
+    !!
+    !!  tj is time elapsed since 1st January 1900, 0 hour, counted in julian
+    !!  century (e.g. time in days divide by 36525)
+    !!----------------------------------------------------------------------
+
+    REAL(wp) ::  cosI,p,q,t2,t4,sin2I,s2,tgI2,P1,sh_tgn2,at1,at2
+    REAL(wp) :: zqy,zsy,zday,zdj,zhfrac
+
+    zqy=AINT((nyear-1901.)/4.)
+    zsy=nyear-1900.
+
+    zdj=dayjul(nyear,nmonth,nday)
+    zday=zdj+zqy-1.
+
+    zhfrac=nsec_day/3600.
+
+    !----------------------------------------------------------------------
+    !  Sh_n Longitude of ascending lunar node
+    !----------------------------------------------------------------------
+
+    sh_N=(259.1560564-19.328185764*zsy-.0529539336*zday-.0022064139*zhfrac)*rad
+    !----------------------------------------------------------------------
+    ! T mean solar angle (Greenwhich time)
+    !----------------------------------------------------------------------
+    sh_T=(180.+zhfrac*(360./24.))*rad
+    !----------------------------------------------------------------------
+    ! h mean solar Longitude
+    !----------------------------------------------------------------------
+
+    sh_h=(280.1895014-.238724988*zsy+.9856473288*zday+.0410686387*zhfrac)*rad
+    !----------------------------------------------------------------------
+    ! s mean lunar Longitude
+    !----------------------------------------------------------------------
+
+    sh_s=(277.0256206+129.38482032*zsy+13.176396768*zday+.549016532*zhfrac)*rad
+    !----------------------------------------------------------------------
+    ! p1 Longitude of solar perigee
+    !----------------------------------------------------------------------
+
+    sh_p1=(281.2208569+.01717836*zsy+.000047064*zday+.000001961*zhfrac)*rad
+    !----------------------------------------------------------------------
+    ! p Longitude of lunar perigee
+    !----------------------------------------------------------------------
+
+    sh_p=(334.3837214+40.66246584*zsy+.111404016*zday+.004641834*zhfrac)*rad
+
+    sh_N =mod(sh_N ,2*rpi)
+    sh_s =mod(sh_s ,2*rpi)
+    sh_h =mod(sh_h, 2*rpi)
+    sh_p =mod(sh_p, 2*rpi)
+    sh_p1=mod(sh_p1,2*rpi)
+
+    cosI=0.913694997 -0.035692561 *cos(sh_N)
+
+    sh_I=acos(cosI)
+
+    sin2I=sin(sh_I)
+    sh_tgn2=tan(sh_N/2.0)
+
+    at1=atan(1.01883*sh_tgn2)
+    at2=atan(0.64412*sh_tgn2)
+
+    sh_xi=-at1-at2+sh_N
+
+    if (sh_N > rpi) sh_xi=sh_xi-2.0*rpi
+
+    sh_nu=at1-at2
+
+    !----------------------------------------------------------------------
+    ! For constituents l2 k1 k2
+    !----------------------------------------------------------------------
+
+    tgI2=tan(sh_I/2.0)
+    P1=sh_p-sh_xi
+
+    t2=tgI2*tgI2
+    t4=t2*t2
+    sh_x1ra=sqrt(1.0-12.0*t2*cos(2.0*P1)+36.0*t4)
+
+    p=sin(2.0*P1)
+    q=1.0/(6.0*t2)-cos(2.0*P1)
+    sh_R=atan(p/q)
+
+    p=sin(2.0*sh_I)*sin(sh_nu)
+    q=sin(2.0*sh_I)*cos(sh_nu)+0.3347
+    sh_nuprim=atan(p/q)
+
+    s2=sin(sh_I)*sin(sh_I)
+    p=s2*sin(2.0*sh_nu)
+    q=s2*cos(2.0*sh_nu)+0.0727
+    sh_nusec=0.5*atan(p/q)
+
+  END SUBROUTINE astronomic_angle
+
+  SUBROUTINE tide_pulse( pomega, ktide ,kc)
+    !!----------------------------------------------------------------------
+    !!                     ***  ROUTINE tide_pulse  ***
+    !!                      
+    !! ** Purpose : Compute tidal frequencies
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, DIMENSION(kc), INTENT( in ) ::   &
+         ktide      ! Indice of tidal constituents
+
+    INTEGER, INTENT( in ) :: &
+         kc         ! Total number of tidal constituents
+
+    REAL (wp), DIMENSION(kc), INTENT( out ) ::   &
+         pomega      ! pulsation in radians/s
+
+    !! * Local declarations
+    INTEGER :: jh
+    REAL(wp) :: zscale  =  36525*24.0
+    REAL(wp) :: zomega_T=  13149000.0
+    REAL(wp) :: zomega_s=    481267.892
+    REAL(wp) :: zomega_h=     36000.76892
+    REAL(wp) :: zomega_p=      4069.0322056
+    REAL(wp) :: zomega_n=      1934.1423972
+    REAL(wp) :: zomega_p1=        1.719175
+    !!----------------------------------------------------------------------
+
+    DO jh=1,kc
+       pomega(jh) = zomega_T * Wave(ktide(jh))%nT &
+            + zomega_s * Wave(ktide(jh))%ns &
+            + zomega_h * Wave(ktide(jh))%nh &
+            + zomega_p * Wave(ktide(jh))%np &
+            + zomega_p1* Wave(ktide(jh))%np1
+       pomega(jh) = (pomega(jh)/zscale)*rad/3600.
+    END DO
+
+  END SUBROUTINE tide_pulse
+
+  SUBROUTINE tide_vuf( pvt, put, pcor, ktide ,kc)
+    !!----------------------------------------------------------------------
+    !!                     ***  ROUTINE tide_vuf  ***
+    !!                      
+    !! ** Purpose : Compute nodal modulation corrections
+    !!
+    !! ** Outputs :
+    !!          vt: Pase of tidal potential relative to Greenwich (radians)
+    !!          ut: Phase correction u due to nodal motion (radians)
+    !!          ft: Nodal correction factor
+    !!
+    !! ** Inputs :
+    !!          tname: array of constituents names (dimension<=nc) 
+    !!             nc: number of constituents
+    !!   
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, DIMENSION(kc), INTENT( in ) ::   &
+         ktide      ! Indice of tidal constituents
+    INTEGER, INTENT( in ) :: &
+         kc         ! Total number of tidal constituents
+    REAL (wp), DIMENSION(kc), INTENT( out ) ::   &
+         pvt, &      !
+         put, &      !
+         pcor         !
+    !! * Local declarations
+    INTEGER :: jh
+    !!----------------------------------------------------------------------
+
+    DO jh =1,kc
+       !  Phase of the tidal potential relative to the Greenwhich 
+       !  meridian (e.g. the position of the fictuous celestial body). Units are
+       !  radian:
+       pvt(jh) = sh_T *Wave(ktide(jh))%nT        &
+            +sh_s *Wave(ktide(jh))%ns        &
+            +sh_h *Wave(ktide(jh))%nh        &
+            +sh_p *Wave(ktide(jh))%np        &
+            +sh_p1*Wave(ktide(jh))%np1       &
+            +Wave(ktide(jh))%shift*rad
+       !
+       !  Phase correction u due to nodal motion. Units are radian:
+       put(jh) = sh_xi    *Wave(ktide(jh))%nksi  &
+            +sh_nu    *Wave(ktide(jh))%nnu0  &
+            +sh_nuprim*Wave(ktide(jh))%nnu1  &
+            +sh_nusec *Wave(ktide(jh))%nnu2  &
+            +sh_R     *Wave(ktide(jh))%R
+
+       !  Nodal correction factor:
+       pcor(jh) = nodal_factort(Wave(ktide(jh))%nformula)
+    END DO
+
+  END SUBROUTINE tide_vuf
+
+  recursive function nodal_factort(kformula) result (zf)
+    !!----------------------------------------------------------------------
+    INTEGER, INTENT(IN) :: kformula
+    REAL(wp) :: zf
+    REAL(wp) :: zs,zf1,zf2
+
+    SELECT CASE (kformula)
+
+       !!  formule 0, solar waves
+
+    case ( 0 )
+       zf=1.0
+
+       !! formule 1, compound waves (78 x 78)
+
+    case ( 1 )
+       zf=nodal_factort(78)
+       zf=zf*zf
+
+       !! formule 2, compound waves (78 x 0)  ===  (78) 
+
+    case ( 2 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(0)
+       zf=zf1*zf
+
+       !! formule 4,  compound waves (78 x 235) 
+
+    case ( 4 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(235)
+       zf=zf1*zf
+
+       !! formule 5,  compound waves (78 *78 x 235)
+
+    case ( 5 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(235)
+       zf=zf*zf1*zf1
+
+       !! formule 6,  compound waves (78 *78 x 0)
+
+    case ( 6 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(0)
+       zf=zf*zf1*zf1 
+
+       !! formule 7, compound waves (75 x 75)
+
+    case ( 7 )
+       zf=nodal_factort(75)
+       zf=zf*zf
+
+       !! formule 8,  compound waves (78 x 0 x 235)
+
+    case ( 8 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf2=nodal_factort(235)
+       zf=zf*zf1*zf2
+
+       !! formule 9,  compound waves (78 x 0 x 227)
+
+    case ( 9 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf2=nodal_factort(227)
+       zf=zf*zf1*zf2
+
+       !! formule 10,  compound waves (78 x 227)
+
+    case ( 10 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(227)
+       zf=zf*zf1
+
+       !! formule 11,  compound waves (75 x 0)
+
+    case ( 11 )
+       zf=nodal_factort(75)
+       zf=nodal_factort(0)
+       zf=zf*zf1
+
+       !! formule 12,  compound waves (78 x 78 x 78 x 0) 
+
+    case ( 12 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(0)
+       zf=zf*zf1*zf1*zf1
+
+       !! formule 13, compound waves (78 x 75)
+
+    case ( 13 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(75)
+       zf=zf*zf1
+
+       !! formule 14, compound waves (235 x 0)  ===  (235)
+
+    case ( 14 )
+       zf=nodal_factort(235)
+       zf1=nodal_factort(0)
+       zf=zf*zf1
+
+       !! formule 15, compound waves (235 x 75) 
+
+    case ( 15 )
+       zf=nodal_factort(235)
+       zf1=nodal_factort(75)
+       zf=zf*zf1
+
+       !! formule 16, compound waves (78 x 0 x 0)  ===  (78)
+
+    case ( 16 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf=zf*zf1*zf1
+
+       !! formule 17,  compound waves (227 x 0) 
+
+    case ( 17 )
+       zf1=nodal_factort(227)
+       zf=nodal_factort(0)
+       zf=zf*zf1
+
+       !! formule 18,  compound waves (78 x 78 x 78 )
+
+    case ( 18 ) 
+       zf1=nodal_factort(78)
+       zf=zf1*zf1*zf1
+
+       !! formule 19, compound waves (78 x 0 x 0 x 0)  ===  (78)
+
+    case ( 19 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf=zf*zf1*zf1
+
+       !! formule 73
+
+    case ( 73 )
+       zs=sin(sh_I)
+       zf=(2./3.-zs*zs)/0.5021
+
+       !! formule 74
+
+    case ( 74 )
+       zs=sin(sh_I)
+       zf=zs*zs/0.1578
+
+       !! formule 75
+
+    case ( 75 )
+       zs=cos (sh_I/2)
+       zf=sin (sh_I)*zs*zs/0.3800
+
+       !! formule 76
+
+    case ( 76 )
+       zf=sin (2*sh_I)/0.7214
+
+       !! formule 77
+
+    case ( 77 )
+       zs=sin (sh_I/2)
+       zf=sin (sh_I)*zs*zs/0.0164
+
+       !! formule 78
+
+    case ( 78 )
+       zs=cos (sh_I/2)
+       zf=zs*zs*zs*zs/0.9154
+
+       !! formule 79
+
+    case ( 79 )
+       zs=sin(sh_I)
+       zf=zs*zs/0.1565
+
+       !! formule 144
+
+    case ( 144 )
+       zs=sin (sh_I/2)
+       zf=(1-10*zs*zs+15*zs*zs*zs*zs)*cos(sh_I/2)/0.5873
+
+       !! formule 149
+
+    case ( 149 )
+       zs=cos (sh_I/2)
+       zf=zs*zs*zs*zs*zs*zs/0.8758
+
+       !! formule 215
+
+    case ( 215 )
+       zs=cos (sh_I/2)
+       zf=zs*zs*zs*zs/0.9154*sh_x1ra
+
+       !! formule 227 
+
+    case ( 227 )
+       zs=sin (2*sh_I)
+       zf=sqrt (0.8965*zs*zs+0.6001*zs*cos (sh_nu)+0.1006)
+
+       !! formule 235 
+
+    case ( 235 )
+       zs=sin (sh_I)
+       zf=sqrt (19.0444*zs*zs*zs*zs+2.7702*zs*zs*cos (2*sh_nu)+.0981)
+
+    END SELECT
+
+  end function nodal_factort
+
+  function dayjul(kyr,kmonth,kday)
+    !
+    !*** THIS ROUTINE COMPUTES THE JULIAN DAY (AS A REAL VARIABLE)
+    !
+    INTEGER,INTENT(IN) :: kyr,kmonth,kday
+    INTEGER,DIMENSION(12) ::  idayt,idays
+    INTEGER :: inc,ji
+    REAL(wp) :: dayjul,zyq
+
+    DATA idayt/0.,31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334./
+    idays(1)=0.
+    idays(2)=31.
+    inc=0.
+    zyq=MOD((kyr-1900.),4.)
+    IF(zyq .eq. 0.) inc=1.
+    DO ji=3,12
+       idays(ji)=idayt(ji)+inc
+    END DO
+    dayjul=idays(kmonth)+kday
+
+  END FUNCTION dayjul
+
+END MODULE tide_mod
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/timing.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/timing.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/timing.F90	(revision 4056)
@@ -0,0 +1,798 @@
+MODULE timing
+   !!========================================================================
+   !!                     ***  MODULE  timing  ***
+   !!========================================================================
+   !! History : 4.0  ! 2001-05  (R. Benshila)   
+   !!------------------------------------------------------------------------
+
+   !!------------------------------------------------------------------------
+   !!   timming_init    : initialize timing process 
+   !!   timing_start    : start Timer
+   !!   timing_stop     : stop  Timer
+   !!   timing_reset    : end timing variable creation
+   !!   timing_finalize : compute stats and write output in calling w*_info 
+   !!   timing_ini_var  : create timing variables 
+   !!   timing_listing  : print instumented subroutines in ocean.output
+   !!   wcurrent_info   : compute and print detailed stats on the current CPU
+   !!   wave_info       : compute and print averaged statson all processors
+   !!   wmpi_info       : compute and write global stats  
+   !!   supress         : suppress an element of the timing linked list  
+   !!   insert          : insert an element of the timing linked list  
+   !!------------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager 
+ !  USE dom_oce         ! ocean domain
+   USE dom_oce , ONLY : narea
+   USE lib_mpp          
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   timing_init, timing_finalize   ! called in nemogcm module 
+   PUBLIC   timing_reset                   ! called in step module 
+   PUBLIC   timing_start, timing_stop      ! called in each routine to time 
+   
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+
+   ! Variables for fine grain timing
+   TYPE timer
+      CHARACTER(LEN=20)  :: cname
+   	  REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock
+      INTEGER :: ncount, ncount_max, ncount_rate  
+      INTEGER :: niter
+      LOGICAL :: l_tdone
+      TYPE(timer), POINTER :: next => NULL()
+      TYPE(timer), POINTER :: prev => NULL()
+      TYPE(timer), POINTER :: parent_section => NULL()
+   END TYPE timer
+    
+   TYPE alltimer
+      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL()
+   	  REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL()
+   	  REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL()
+   	  INTEGER, DIMENSION(:), POINTER :: niter => NULL()
+      TYPE(alltimer), POINTER :: next => NULL()
+      TYPE(alltimer), POINTER :: prev => NULL()
+   END TYPE alltimer 
+ 
+   TYPE(timer), POINTER :: s_timer_root => NULL()
+   TYPE(timer), POINTER :: s_timer      => NULL()
+   TYPE(timer), POINTER :: s_wrk        => NULL()
+   REAL(wp) :: t_overclock, t_overcpu
+   LOGICAL :: l_initdone = .FALSE.
+   INTEGER :: nsize
+   
+   ! Variables for coarse grain timing
+   REAL(wp) :: tot_etime, tot_ctime
+   REAL(kind=wp), DIMENSION(2)     :: t_elaps, t_cpu
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime
+   INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max
+   INTEGER, DIMENSION(8)           :: nvalues
+   CHARACTER(LEN=8), DIMENSION(2)  :: cdate
+   CHARACTER(LEN=10), DIMENSION(2) :: ctime
+   CHARACTER(LEN=5)                :: czone
+    
+   ! From of ouput file (1/proc or one global)   !RB to put in nammpp or namctl
+   LOGICAL :: ln_onefile = .TRUE. 
+   LOGICAL :: lwriter
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: timing.F90 3352 2012-04-11 12:56:01Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE timing_start(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_start  ***
+      !! ** Purpose :   collect execution time
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      !
+       
+      ! Create timing structure at first call
+      IF( .NOT. l_initdone ) THEN
+         CALL timing_ini_var(cdinfo)
+      ELSE
+         s_timer => s_timer_root
+         DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+            IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO
+      ENDIF         
+      s_timer%l_tdone = .FALSE.
+      s_timer%niter = s_timer%niter + 1
+      s_timer%t_cpu = 0.
+      s_timer%t_clock = 0.
+                  
+      ! CPU time collection
+      CALL CPU_TIME( s_timer%t_cpu  )
+      ! clock time collection
+#if defined key_mpp_mpi
+      s_timer%t_clock= MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=s_timer%ncount_rate, COUNT_MAX=s_timer%ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = s_timer%ncount)
+#endif
+      !
+   END SUBROUTINE timing_start
+
+
+   SUBROUTINE timing_stop(cdinfo, csection)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_stop  ***
+      !! ** Purpose :   finalize timing and output
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      CHARACTER(len=*), INTENT(in), OPTIONAL :: csection
+      !
+      INTEGER  :: ifinal_count, iperiods    
+      REAL(wp) :: zcpu_end, zmpitime
+      !
+      s_wrk => NULL()
+
+      ! clock time collection
+#if defined key_mpp_mpi
+      zmpitime = MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+#endif
+      ! CPU time collection
+      CALL CPU_TIME( zcpu_end )
+
+      s_timer => s_timer_root
+      DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+      END DO
+ 
+      ! CPU time correction
+      s_timer%t_cpu  = zcpu_end - s_timer%t_cpu - t_overcpu - s_timer%tsub_cpu
+  
+      ! clock time correction
+#if defined key_mpp_mpi
+      s_timer%t_clock = zmpitime - s_timer%t_clock - t_overclock - s_timer%tsub_clock
+#else
+      iperiods = ifinal_count - s_timer%ncount
+      IF( ifinal_count < s_timer%ncount )  &
+          iperiods = iperiods + s_timer%ncount_max 
+      s_timer%t_clock  = REAL(iperiods) / s_timer%ncount_rate - t_overclock - s_timer%tsub_clock
+#endif
+      
+      ! Correction of parent section
+      IF( .NOT. PRESENT(csection) ) THEN
+         s_wrk => s_timer
+         DO WHILE ( ASSOCIATED(s_wrk%parent_section ) )
+            s_wrk => s_wrk%parent_section
+            s_wrk%tsub_cpu   = s_wrk%tsub_cpu   + s_timer%t_cpu 
+            s_wrk%tsub_clock = s_wrk%tsub_clock + s_timer%t_clock              
+         END DO
+      ENDIF
+            
+      ! time diagnostics 
+      s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock 
+      s_timer%tsum_cpu   = s_timer%tsum_cpu   + s_timer%t_cpu
+!RB to use to get min/max during a time integration
+!      IF( .NOT. l_initdone ) THEN
+!         s_timer%tmin_clock = s_timer%t_clock 
+!         s_timer%tmin_cpu   = s_timer%t_cpu 
+!      ELSE
+!         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock ) 
+!         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   ) 
+!      ENDIF   
+!      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock ) 
+!      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   )  
+      !
+      s_timer%tsub_clock = 0.
+      s_timer%tsub_cpu = 0.
+      s_timer%l_tdone = .TRUE.
+      !
+   END SUBROUTINE timing_stop
+ 
+ 
+   SUBROUTINE timing_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_init  ***
+      !! ** Purpose :   open timing output file
+      !!----------------------------------------------------------------------
+      INTEGER :: iperiods, istart_count, ifinal_count
+      REAL(wp) :: zdum
+      LOGICAL :: ll_f
+             
+      IF( ln_onefile ) THEN
+         IF( lwp) CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.TRUE., narea )
+         lwriter = lwp
+      ELSE
+         CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.FALSE., narea )
+         lwriter = .TRUE.
+      ENDIF
+      
+      IF( lwriter) THEN      
+         WRITE(numtime,*)
+         WRITE(numtime,*) '      CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV'
+         WRITE(numtime,*) '                             NEMO team'
+         WRITE(numtime,*) '                  Ocean General Circulation Model'
+         WRITE(numtime,*) '                        version 3.3  (2010) '
+         WRITE(numtime,*)
+         WRITE(numtime,*) '                        Timing Informations '
+         WRITE(numtime,*)
+         WRITE(numtime,*)
+      ENDIF   
+      
+      ! Compute clock function overhead
+#if defined key_mpp_mpi        
+      t_overclock = MPI_WTIME()
+      t_overclock = MPI_WTIME() - t_overclock
+#else        
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = istart_count)
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+      iperiods = ifinal_count - istart_count
+      IF( ifinal_count < istart_count )  &
+          iperiods = iperiods + ncount_max 
+      t_overclock = REAL(iperiods) / ncount_rate
+#endif
+
+      ! Compute cpu_time function overhead
+      CALL CPU_TIME(zdum)
+      CALL CPU_TIME(t_overcpu)
+      
+      ! End overhead omputation  
+      t_overcpu = t_overcpu - zdum        
+      t_overclock = t_overcpu + t_overclock        
+
+      ! Timing on date and time
+      CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues)
+    
+      CALL CPU_TIME(t_cpu(1))      
+#if defined key_mpp_mpi        
+      ! Start elapsed and CPU time counters
+      t_elaps(1) = MPI_WTIME()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = ncount)
+#endif                 
+      !
+   END SUBROUTINE timing_init
+
+
+   SUBROUTINE timing_finalize
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_finalize ***
+      !! ** Purpose :  compute average time 
+      !!               write timing output file
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER :: s_temp
+      INTEGER :: idum, iperiods, icode
+      LOGICAL :: ll_ord, ll_averep
+      CHARACTER(len=120) :: clfmt            
+      
+      ll_averep = .TRUE.
+    
+      ! total CPU and elapse
+      CALL CPU_TIME(t_cpu(2))
+      t_cpu(2)   = t_cpu(2)    - t_cpu(1)   - t_overcpu
+#if defined key_mpp_mpi
+      t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock
+#else
+      CALL SYSTEM_CLOCK(COUNT = nfinal_count)
+      iperiods = nfinal_count - ncount
+      IF( nfinal_count < ncount )  &
+          iperiods = iperiods + ncount_max 
+      t_elaps(2) = REAL(iperiods) / ncount_rate - t_overclock
+#endif      
+
+      ! End of timings on date & time
+      CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues)
+       
+      ! Compute the numer of routines
+      nsize = 0 
+      s_timer => s_timer_root
+      DO WHILE( ASSOCIATED(s_timer) )
+         nsize = nsize + 1
+         s_timer => s_timer%next
+      END DO
+      idum = nsize
+      IF(lk_mpp) CALL mpp_sum(idum)
+      IF( idum/jpnij /= nsize ) THEN
+         IF( lwriter ) WRITE(numtime,*) '        ===> W A R N I N G: '
+         IF( lwriter ) WRITE(numtime,*) ' Some CPU have different number of routines instrumented for timing'
+         IF( lwriter ) WRITE(numtime,*) ' No detailed report on averaged timing can be provided'
+         IF( lwriter ) WRITE(numtime,*) ' The following detailed report only deals with the current processor'
+         IF( lwriter ) WRITE(numtime,*)
+         ll_averep = .FALSE.
+      ENDIF   
+
+#if defined key_mpp_mpi      
+      ! in MPI gather some info
+      ALLOCATE( all_etime(jpnij), all_ctime(jpnij) )
+      CALL MPI_ALLGATHER(t_elaps(2), 1, MPI_DOUBLE_PRECISION,   &
+                         all_etime , 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OPA, icode)
+      CALL MPI_ALLGATHER(t_cpu(2) , 1, MPI_DOUBLE_PRECISION,   &
+                         all_ctime, 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OPA, icode)
+      tot_etime = SUM(all_etime(:))
+      tot_ctime = SUM(all_ctime(:))
+#else
+      tot_etime = t_elaps(2)
+      tot_ctime = t_cpu  (2)           
+#endif
+
+      ! write output file
+      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :'
+      IF( lwriter ) WRITE(numtime,*) '--------------------'
+      IF( lwriter ) WRITE(numtime,"('Elapsed Time (s)  CPU Time (s)')")
+      IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)')  tot_etime, tot_ctime
+      IF( lwriter ) WRITE(numtime,*) 
+#if defined key_mpp_mpi
+      IF( ll_averep ) CALL waver_info
+      CALL wmpi_info
+#endif      
+      IF( lwriter ) CALL wcurrent_info
+      
+      clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4),   &
+      &       ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6),   &
+      &       czone(1:3),    czone(4:5)                     
+      clfmt='(1X,  "Timing   ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4),   &
+      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   &
+      &       czone(1:3),    czone(4:5)
+
+      IF( lwriter ) CLOSE(numtime) 
+      !
+   END SUBROUTINE timing_finalize
+   
+
+   SUBROUTINE wcurrent_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write timing output file
+      !!----------------------------------------------------------------------
+      LOGICAL :: ll_ord
+      CHARACTER(len=2048) :: clfmt            
+   
+      ! reorder the current list by elapse time      
+      s_wrk => NULL()
+      s_timer => s_timer_root
+      DO
+         ll_ord = .TRUE.
+         s_timer => s_timer_root
+         DO WHILE ( ASSOCIATED( s_timer%next ) )
+         IF (.NOT. ASSOCIATED(s_timer%next)) EXIT
+            IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 
+               ALLOCATE(s_wrk)
+               s_wrk = s_timer%next
+               CALL insert  (s_timer, s_timer_root, s_wrk)
+               CALL suppress(s_timer%next)            
+               ll_ord = .FALSE.
+               CYCLE            
+            ENDIF           
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO         
+         IF( ll_ord ) EXIT
+      END DO
+            
+      ! write current info
+      WRITE(numtime,*) 'Detailed timing for proc :', narea-1
+      WRITE(numtime,*) '--------------------------'
+      WRITE(numtime,*) 'Section             ',            &
+      &   'Elapsed Time (s)  ','Elapsed Time (%)  ',   &
+      &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency' 
+      s_timer => s_timer_root  
+      clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)'
+      DO WHILE ( ASSOCIATED(s_timer) )
+         WRITE(numtime,TRIM(clfmt))   s_timer%cname,   &
+         &   s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2),            &
+         &   s_timer%tsum_cpu  ,s_timer%tsum_cpu*100./t_cpu(2)    ,            &
+         &   s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter
+         s_timer => s_timer%next
+      END DO
+      WRITE(numtime,*)
+      !                  
+   END SUBROUTINE wcurrent_info
+
+#if defined key_mpp_mpi     
+   SUBROUTINE waver_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write averaged timing informations
+      !!----------------------------------------------------------------------
+      TYPE(alltimer), POINTER :: sl_timer_glob_root => NULL()
+      TYPE(alltimer), POINTER :: sl_timer_glob      => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave_root => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave      => NULL()
+      INTEGER :: icode
+      INTEGER :: ierr
+      LOGICAL :: ll_ord           
+      CHARACTER(len=200) :: clfmt              
+                 
+      ! Initialised the global strucutre   
+      ALLOCATE(sl_timer_glob_root, Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+
+      ALLOCATE(sl_timer_glob_root%cname     (jpnij), &
+               sl_timer_glob_root%tsum_cpu  (jpnij), &
+               sl_timer_glob_root%tsum_clock(jpnij), &
+               sl_timer_glob_root%niter     (jpnij), Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+      sl_timer_glob_root%cname(:)       = ''
+      sl_timer_glob_root%tsum_cpu(:)   = 0._wp
+      sl_timer_glob_root%tsum_clock(:) = 0._wp
+      sl_timer_glob_root%niter(:)      = 0
+      sl_timer_glob_root%next => NULL()
+      sl_timer_glob_root%prev => NULL()
+      !ARPDBG - don't need to allocate a pointer that's immediately then
+      !         set to point to some other object.
+      !ALLOCATE(sl_timer_glob)
+      !ALLOCATE(sl_timer_glob%cname     (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_cpu  (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_clock(jpnij))
+      !ALLOCATE(sl_timer_glob%niter     (jpnij))
+      sl_timer_glob => sl_timer_glob_root
+      !
+      IF( narea .EQ. 1 ) THEN
+         ALLOCATE(sl_timer_ave_root)
+         sl_timer_ave_root%cname       = ''
+         sl_timer_ave_root%t_cpu      = 0._wp
+         sl_timer_ave_root%t_clock    = 0._wp
+         sl_timer_ave_root%tsum_cpu   = 0._wp
+         sl_timer_ave_root%tsum_clock = 0._wp
+         sl_timer_ave_root%tmax_cpu   = 0._wp
+         sl_timer_ave_root%tmax_clock = 0._wp
+         sl_timer_ave_root%tmin_cpu   = 0._wp
+         sl_timer_ave_root%tmin_clock = 0._wp
+         sl_timer_ave_root%tsub_cpu   = 0._wp
+         sl_timer_ave_root%tsub_clock = 0._wp
+         sl_timer_ave_root%ncount      = 0
+         sl_timer_ave_root%ncount_rate = 0
+         sl_timer_ave_root%ncount_max  = 0
+         sl_timer_ave_root%niter       = 0
+         sl_timer_ave_root%l_tdone  = .FALSE.
+         sl_timer_ave_root%next => NULL()
+         sl_timer_ave_root%prev => NULL()
+         ALLOCATE(sl_timer_ave)
+         sl_timer_ave => sl_timer_ave_root            
+      ENDIF 
+
+      ! Gather info from all processors
+      s_timer => s_timer_root
+      DO WHILE ( ASSOCIATED(s_timer) )
+         CALL MPI_GATHER(s_timer%cname     , 20, MPI_CHARACTER,   &
+                         sl_timer_glob%cname, 20, MPI_CHARACTER,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%tsum_clock     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_clock, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%tsum_cpu     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_cpu, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%niter     , 1, MPI_INTEGER,   &
+                         sl_timer_glob%niter, 1, MPI_INTEGER,   &
+                         0, MPI_COMM_OPA, icode)
+
+         IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN
+            ALLOCATE(sl_timer_glob%next)
+            ALLOCATE(sl_timer_glob%next%cname     (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_cpu  (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_clock(jpnij))
+            ALLOCATE(sl_timer_glob%next%niter     (jpnij))
+            sl_timer_glob%next%prev => sl_timer_glob
+            sl_timer_glob%next%next => NULL()
+            sl_timer_glob           => sl_timer_glob%next
+         ENDIF              
+         s_timer => s_timer%next
+      END DO      
+
+         WRITE(*,*) 'ARPDBG: timing: done gathers'
+      
+      IF( narea == 1 ) THEN    
+         ! Compute some stats
+         sl_timer_glob => sl_timer_glob_root
+         DO WHILE( ASSOCIATED(sl_timer_glob) )
+            sl_timer_ave%cname  = sl_timer_glob%cname(1)
+            sl_timer_ave%tsum_cpu   = SUM   (sl_timer_glob%tsum_cpu  (:)) / jpnij
+            sl_timer_ave%tsum_clock = SUM   (sl_timer_glob%tsum_clock(:)) / jpnij
+            sl_timer_ave%tmax_cpu   = MAXVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmax_clock = MAXVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%tmin_cpu   = MINVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmin_clock = MINVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%niter      = SUM   (sl_timer_glob%niter     (:))
+            !
+            IF( ASSOCIATED(sl_timer_glob%next) ) THEN
+               ALLOCATE(sl_timer_ave%next)          
+               sl_timer_ave%next%prev => sl_timer_ave
+               sl_timer_ave%next%next => NULL()           
+               sl_timer_ave           => sl_timer_ave%next
+            ENDIF
+            sl_timer_glob => sl_timer_glob%next                                
+         END DO
+
+         WRITE(*,*) 'ARPDBG: timing: done computing stats'
+      
+         ! reorder the averaged list by CPU time      
+         s_wrk => NULL()
+         sl_timer_ave => sl_timer_ave_root
+         DO
+            ll_ord = .TRUE.
+            sl_timer_ave => sl_timer_ave_root
+            DO WHILE( ASSOCIATED( sl_timer_ave%next ) )
+
+               IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT
+
+               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 
+                  ALLOCATE(s_wrk)
+                  ! Copy data into the new object pointed to by s_wrk
+                  s_wrk = sl_timer_ave%next
+                  ! Insert this new timer object before our current position
+                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk)
+                  ! Remove the old object from the list
+                  CALL suppress(sl_timer_ave%next)            
+                  ll_ord = .FALSE.
+                  CYCLE            
+               ENDIF           
+               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next
+            END DO         
+            IF( ll_ord ) EXIT
+         END DO
+
+         ! write averaged info
+         WRITE(numtime,"('Averaged timing on all processors :')")
+         WRITE(numtime,"('-----------------------------------')")
+         WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, &
+         &   'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x,   &
+         &   'Max elap(%)',2x,'Min elap(%)',2x,            &           
+         &   'Freq')")
+         sl_timer_ave => sl_timer_ave_root  
+         clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)'
+         DO WHILE ( ASSOCIATED(sl_timer_ave) )
+            WRITE(numtime,TRIM(clfmt))   sl_timer_ave%cname(1:18),                            &
+            &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   &
+            &   sl_timer_ave%tsum_cpu  ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime  ,   &
+            &   sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock,                          &
+            &   sl_timer_ave%tmax_clock*100.*jpnij/tot_etime,                           &
+            &   sl_timer_ave%tmin_clock*100.*jpnij/tot_etime,                           &                                               
+            &   sl_timer_ave%niter/REAL(jpnij)
+            sl_timer_ave => sl_timer_ave%next
+         END DO
+         WRITE(numtime,*)
+         !
+         DEALLOCATE(sl_timer_ave_root)
+      ENDIF
+      !
+      DEALLOCATE(sl_timer_glob_root)
+      !                  
+   END SUBROUTINE waver_info
+  
+  
+   SUBROUTINE wmpi_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wmpi_time  ***
+      !! ** Purpose :   compute and write a summary of MPI infos 
+      !!----------------------------------------------------------------------   
+      !   
+      INTEGER                            :: idum, icode
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank
+      REAL(wp) :: ztot_ratio
+      REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio
+      REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio
+      CHARACTER(LEN=128), dimension(8) :: cllignes
+      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date
+      CHARACTER(LEN=2048)              :: clfmt    
+   
+      ! Gather all times
+      ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) )
+      IF( narea == 1 ) THEN
+         iall_rank(:) = (/ (idum,idum=0,jpnij-1) /)
+   
+         ! Compute elapse user time
+         zavg_etime = tot_etime/REAL(jpnij,wp)
+         zmax_etime = MAXVAL(all_etime(:))
+         zmin_etime = MINVAL(all_etime(:))
+
+         ! Compute CPU user time
+         zavg_ctime = tot_ctime/REAL(jpnij,wp)
+         zmax_ctime = MAXVAL(all_ctime(:))
+         zmin_ctime = MINVAL(all_ctime(:))
+   
+         ! Compute cpu/elapsed ratio
+         zall_ratio(:) = all_ctime(:) / all_etime(:)
+         ztot_ratio    = SUM(zall_ratio(:))
+         zavg_ratio    = ztot_ratio/REAL(jpnij,wp)
+         zmax_ratio    = MAXVAL(zall_ratio(:))
+         zmin_ratio    = MINVAL(zall_ratio(:))   
+   
+         ! Output Format
+         clhline    ='1x,13("-"),"|",18("-"),"|",14("-"),"|",18("-"),/,'
+         cllignes(1)='(1x,"MPI summary report :",/,'
+         cllignes(2)='1x,"--------------------",//,'
+         cllignes(3)='1x,"Process Rank |"," Elapsed Time (s) |"," CPU Time (s) |"," Ratio CPU/Elapsed",/,'
+         cllignes(4)='    (1x,i4,9x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
+         WRITE(cllignes(4)(1:4),'(I4)') jpnij
+         cllignes(5)='1x,"Total        |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(6)='1x,"Minimum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(7)='1x,"Maximum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(8)='1x,"Average      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3)'
+         clfmt=TRIM(cllignes(1))// TRIM(cllignes(2))//TRIM(cllignes(3))//          &
+           & TRIM(clhline)//TRIM(cllignes(4))//TRIM(clhline)//TRIM(cllignes(5))//  &
+           & TRIM(clhline)//TRIM(cllignes(6))//TRIM(clhline)//TRIM(cllignes(7))//  &
+           & TRIM(clhline)//TRIM(cllignes(8))
+         WRITE(numtime, TRIM(clfmt)) &
+             (iall_rank(idum),all_etime(idum),all_ctime(idum),zall_ratio(idum),idum=1, jpnij), &
+             tot_etime,     tot_ctime,     ztot_ratio,   &
+             zmin_etime,    zmin_ctime,    zmin_ratio,   &
+             zmax_etime,    zmax_ctime,    zmax_ratio,   &
+             zavg_etime,    zavg_ctime,    zavg_ratio
+         WRITE(numtime,*)    
+      END IF
+      !
+      DEALLOCATE(zall_ratio, iall_rank)
+      !
+   END SUBROUTINE wmpi_info
+#endif   
+
+
+   SUBROUTINE timing_ini_var(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_ini_var  ***
+      !! ** Purpose :   create timing structure 
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      LOGICAL :: ll_section
+       
+      !
+      IF( .NOT. ASSOCIATED(s_timer_root) ) THEN
+         ALLOCATE(s_timer_root)
+         s_timer_root%cname       = cdinfo
+         s_timer_root%t_cpu      = 0._wp
+         s_timer_root%t_clock    = 0._wp
+         s_timer_root%tsum_cpu   = 0._wp
+         s_timer_root%tsum_clock = 0._wp
+         s_timer_root%tmax_cpu   = 0._wp
+         s_timer_root%tmax_clock = 0._wp
+         s_timer_root%tmin_cpu   = 0._wp
+         s_timer_root%tmin_clock = 0._wp
+         s_timer_root%tsub_cpu   = 0._wp
+         s_timer_root%tsub_clock = 0._wp
+         s_timer_root%ncount      = 0
+         s_timer_root%ncount_rate = 0
+         s_timer_root%ncount_max  = 0
+         s_timer_root%niter       = 0
+         s_timer_root%l_tdone  = .FALSE.
+         s_timer_root%next => NULL()
+         s_timer_root%prev => NULL()
+         s_timer => s_timer_root
+         !
+         ALLOCATE(s_wrk)
+         s_wrk => NULL()
+         
+      ELSE
+         s_timer => s_timer_root
+         ! case of already existing area (typically inside a loop)
+         DO WHILE( ASSOCIATED(s_timer) ) 
+            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) RETURN
+            s_timer => s_timer%next
+         END DO
+         
+         ! end of the chain
+         s_timer => s_timer_root
+         DO WHILE( ASSOCIATED(s_timer%next) )
+            s_timer => s_timer%next
+         END DO
+          
+         ALLOCATE(s_timer%next)      
+         s_timer%next%cname       = cdinfo
+         s_timer%next%t_cpu      = 0._wp
+         s_timer%next%t_clock    = 0._wp
+         s_timer%next%tsum_cpu   = 0._wp
+         s_timer%next%tsum_clock = 0._wp  
+         s_timer%next%tmax_cpu   = 0._wp
+         s_timer%next%tmax_clock = 0._wp
+         s_timer%next%tmin_cpu   = 0._wp
+         s_timer%next%tmin_clock = 0._wp
+         s_timer%next%tsub_cpu   = 0._wp
+         s_timer%next%tsub_clock = 0._wp
+         s_timer%next%ncount      = 0
+         s_timer%next%ncount_rate = 0
+         s_timer%next%ncount_max  = 0
+         s_timer%next%niter       = 0
+         s_timer%next%l_tdone  = .FALSE.
+         s_timer%next%parent_section => NULL()
+         s_timer%next%prev => s_timer
+         s_timer%next%next => NULL()
+         s_timer => s_timer%next
+
+         ! are we inside a section
+         s_wrk => s_timer%prev
+         ll_section = .FALSE.
+         DO WHILE( ASSOCIATED(s_wrk) .AND. .NOT. ll_section )
+            IF( .NOT. s_wrk%l_tdone ) THEN
+               ll_section = .TRUE.
+               s_timer%parent_section => s_wrk 
+            ENDIF
+            s_wrk => s_wrk%prev
+         END DO 
+      ENDIF         
+      !
+   END SUBROUTINE timing_ini_var
+
+
+   SUBROUTINE timing_reset
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_reset  ***
+      !! ** Purpose :   go to root of timing tree 
+      !!----------------------------------------------------------------------
+      l_initdone = .TRUE. 
+!      IF(lwp) WRITE(numout,*)
+!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'
+!      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+!      CALL timing_list(s_timer_root)
+!      WRITE(numout,*)
+      !
+   END SUBROUTINE timing_reset
+
+
+   RECURSIVE SUBROUTINE timing_list(ptr)
+   
+      TYPE(timer), POINTER, INTENT(inout) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next)
+      IF(lwp) WRITE(numout,*)'   ', ptr%cname   
+      !
+   END SUBROUTINE timing_list
+
+
+   SUBROUTINE insert(sd_current, sd_root ,sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE insert  ***
+      !! ** Purpose :   insert an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr
+      !
+     
+      IF( ASSOCIATED( sd_current, sd_root ) ) THEN
+         ! If our current element is the root element then
+         ! replace it with the one being inserted
+         sd_root => sd_ptr
+      ELSE
+         sd_current%prev%next => sd_ptr
+      END IF
+      sd_ptr%next     => sd_current
+      sd_ptr%prev     => sd_current%prev
+      sd_current%prev => sd_ptr
+      ! Nullify the pointer to the new element now that it is held
+      ! within the list. If we don't do this then a subsequent call
+      ! to ALLOCATE memory to this pointer will fail.
+      sd_ptr => NULL()
+      !    
+   END SUBROUTINE insert
+  
+  
+   SUBROUTINE suppress(sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE suppress  ***
+      !! ** Purpose :   supress an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_ptr
+      !
+      TYPE(timer), POINTER :: sl_temp
+    
+      sl_temp => sd_ptr
+      sd_ptr => sd_ptr%next    
+      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev
+      DEALLOCATE(sl_temp)
+      sl_temp => NULL()
+      !
+    END SUBROUTINE suppress
+
+   !!=====================================================================
+END MODULE timing
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv.F90	(revision 4056)
@@ -0,0 +1,207 @@
+MODULE traadv
+   !!==============================================================================
+   !!                       ***  MODULE  traadv  ***
+   !! Ocean active tracers:  advection trend 
+   !!==============================================================================
+   !! History :  2.0  !  2005-11  (G. Madec)  Original code
+   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv      : compute ocean tracer advection trend
+   !!   tra_adv_ctl  : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
+   USE traadv_tvd  ! TVD      scheme           (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
+   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
+   USE cla             ! cross land advection      (cla_traadv     routine)
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE prtctl          ! Print control
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv        ! routine called by step module
+   PUBLIC   tra_adv_init   ! routine called by opa module
+
+   !                                        !!* Namelist namtra_adv *
+   LOGICAL ::   ln_traadv_cen2   = .TRUE.    ! 2nd order centered scheme flag
+   LOGICAL ::   ln_traadv_tvd    = .FALSE.   ! TVD scheme flag
+   LOGICAL ::   ln_traadv_muscl  = .FALSE.   ! MUSCL scheme flag
+   LOGICAL ::   ln_traadv_muscl2 = .FALSE.   ! MUSCL2 scheme flag
+   LOGICAL ::   ln_traadv_ubs    = .FALSE.   ! UBS scheme flag
+   LOGICAL ::   ln_traadv_qck    = .FALSE.   ! QUICKEST scheme flag
+
+   INTEGER ::   nadv   ! choice of the type of advection scheme
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traadv.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv  ***
+      !!
+      !! ** Purpose :   compute the ocean tracer advection trend.
+      !!
+      !! ** Method  : - Update (ua,va) with the advection term following nadv
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk   ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !                                          ! set time step
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
+         r2dtra(:) = 2._wp * rdttra(:)                   ! = 2 rdttra (leapfrog)
+      ENDIF
+      !
+      IF( nn_cla == 1 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection)
+      !
+      !                                               !==  effective transport  ==!
+      DO jk = 1, jpkm1
+         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
+         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+      END DO
+      zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+      !
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &
+         &              CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the eiv transport (if necessary)
+      !
+      CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport      
+      CALL iom_put( "vocetr_eff", zvn )
+      CALL iom_put( "wocetr_eff", zwn )
+
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
+      !
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+         CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      END SELECT
+      !
+      !                                              ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv')
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !                                          
+   END SUBROUTINE tra_adv
+
+
+   SUBROUTINE tra_adv_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_init  ***
+      !!                
+      !! ** Purpose :   Control the consistency between namelist options for 
+      !!              tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!
+      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     &
+         &                 ln_traadv_muscl, ln_traadv_muscl2,  &
+         &                 ln_traadv_ubs  , ln_traadv_qck
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )                ! Read Namelist namtra_adv : tracer advection scheme
+      READ  ( numnam, namtra_adv )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2
+         WRITE(numout,*) '      TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd
+         WRITE(numout,*) '      MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl
+         WRITE(numout,*) '      MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2
+         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs
+         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck
+      ENDIF
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_traadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_traadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_traadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_traadv_muscl2 )   ioptio = ioptio + 1
+      IF( ln_traadv_ubs    )   ioptio = ioptio + 1
+      IF( ln_traadv_qck    )   ioptio = ioptio + 1
+      IF( lk_esopa         )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
+
+      !                              ! Set nadv
+      IF( ln_traadv_cen2   )   nadv =  1
+      IF( ln_traadv_tvd    )   nadv =  2
+      IF( ln_traadv_muscl  )   nadv =  3
+      IF( ln_traadv_muscl2 )   nadv =  4
+      IF( ln_traadv_ubs    )   nadv =  5
+      IF( ln_traadv_qck    )   nadv =  6
+      IF( lk_esopa         )   nadv = -1
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
+         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
+         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
+         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
+      ENDIF
+      !
+   END SUBROUTINE tra_adv_init
+
+  !!======================================================================
+END MODULE traadv
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv_tvd.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv_tvd.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv_tvd.F90	(revision 4056)
@@ -0,0 +1,365 @@
+MODULE traadv_tvd
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_tvd  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+   !! History :  OPA  !  1995-12  (L. Mortier)  Original code
+   !!                 !  2000-01  (H. Loukos)  adapted to ORCA 
+   !!                 !  2000-10  (MA Foujols E.Kestenare)  include file not routine
+   !!                 !  2000-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
+   !!                 !  2001-07  (E. Durand G. Madec)  adaptation to ORCA config
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!    NEMO    1.0  !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
+   !!            2.0  !  2008-04  (S. Cravatte) add the i-, j- & k- trends computation
+   !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_tvd  : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a TVD scheme
+   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
+   !!                  algorithm 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_tvd    ! routine called by step.F90
+
+   LOGICAL ::   l_trd   ! flag to compute trends
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traadv_tvd.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_tvd ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_tvd  ***
+      !! 
+      !! **  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 : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
+      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+      ENDIF
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0
+      ENDIF
+      !
+      zwi(:,:,:) = 0.e0
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
+         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
+
+         ! 2. upstream advection with initial mass fluxes & intermediate update
+         ! --------------------------------------------------------------------
+         ! upstream tracer flux in the i and j direction
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+
+         ! upstream tracer flux in the k direction
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
+               END DO
+            END DO
+         END DO
+
+         ! total advective trend
+         DO jk = 1, jpkm1
+            z2dtt = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! total intermediate advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
+         CALL lbc_lnk( zwi, 'T', 1. )  
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ! store intermediate advective trends
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! 3. antidiffusive flux : high order minus low order
+         ! --------------------------------------------------
+         ! antidiffusive flux on i and j
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      
+         ! antidiffusive flux on k
+         zwz(:,:,1) = 0.e0         ! Surface value
+         !
+         DO jk = 2, jpkm1          ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! total advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! add them to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+         ENDIF
+         !
+      END DO
+      !
+                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz )
+      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd')
+      !
+   END SUBROUTINE tra_adv_tvd
+
+
+   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  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), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('nonosc')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+
+      zbig  = 1.e+40_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp
+
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask - zbig * ( 1.e0 - tmask ),   &
+         &        paft * tmask - zbig * ( 1.e0 - tmask )  )
+      zbdo = MIN( pbef * tmask + zbig * ( 1.e0 - tmask ),   &
+         &        paft * tmask + zbig * ( 1.e0 - tmask )  )
+
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         z2dtt = p2dt(jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+               ! search maximum in neighbourhood
+               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+               ! search minimum in neighbourhood
+               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+               ! positive part of the flux
+               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+
+               ! negative part of the flux
+               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+
+               ! up & down beta terms
+               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu )
+
+               zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv )
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
+               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
+      !
+   END SUBROUTINE nonosc
+
+   !!======================================================================
+END MODULE traadv_tvd
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv_tvd_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv_tvd_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traadv_tvd_crs.F90	(revision 4056)
@@ -0,0 +1,390 @@
+MODULE traadv_tvd_crs
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_tvd  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+   !! History :  OPA  !  1995-12  (L. Mortier)  Original code
+   !!                 !  2000-01  (H. Loukos)  adapted to ORCA 
+   !!                 !  2000-10  (MA Foujols E.Kestenare)  include file not routine
+   !!                 !  2000-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
+   !!                 !  2001-07  (E. Durand G. Madec)  adaptation to ORCA config
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!    NEMO    1.0  !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
+   !!            2.0  !  2008-04  (S. Cravatte) add the i-, j- & k- trends computation
+   !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_tvd  : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a TVD scheme
+   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
+   !!                  algorithm 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce , ONLY : lk_vvl
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+   USE crslbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_tvd_crs    ! routine called by step.F90
+
+   LOGICAL ::   l_trd   ! flag to compute trends
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traadv_tvd.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_tvd_crs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_tvd  ***
+      !! 
+      !! **  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 : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
+      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
+      !!----------------------------------------------------------------------
+      !
+ !     IF(lwp) WRITE(numout,*) 'TEST', kt
+ !     IF(lwp) WRITE(numout,*) 'kit000', kit000
+ !     IF(lwp) WRITE(numout,*) 'cdtype', cdtype
+ !     IF(lwp) WRITE(numout,*) 'p2dt', p2dt
+ !     IF(lwp) WRITE(numout,*) 'pun', pun(30:40,10:20,1)
+ !     IF(lwp) WRITE(numout,*) 'pvn', pvn(30:40,10:20,1)
+ !    IF(lwp) WRITE(numout,*) 'pwn', pwn(30:40,10:20,1)
+ !     IF(lwp) WRITE(numout,*) 'ptb', ptb
+ !     IF(lwp) WRITE(numout,*) 'ptn', ptn
+ !     IF(lwp) WRITE(numout,*) 'kjpt', kjpt
+      
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+      ENDIF
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0
+      ENDIF
+      !
+      zwi(:,:,:) = 0.e0
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
+         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
+
+         ! 2. upstream advection with initial mass fluxes & intermediate update
+         ! --------------------------------------------------------------------
+         ! upstream tracer flux in the i and j direction
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+         !         WRITE(numout,*) 'zfp_ui', zfp_ui
+         !         WRITE(numout,*) 'zfp_vj', zfp_vj
+         !         WRITE(numout,*) 'zfm_ui', zfm_ui
+         !         WRITE(numout,*) 'zfm_vj', zfm_vj
+         !         WRITE(numout,*) 'zwx', zwx(ji,jj,jk)
+         !         WRITE(numout,*) 'ptb', ptb(ji,jj,jk,jn)
+               END DO
+            END DO
+         END DO
+
+         ! upstream tracer flux in the k direction
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
+               END DO
+            END DO
+         END DO
+WRITE(numout,*) 'test64561_tra', pta(10,10,1,1)
+         ! total advective trend
+         DO jk = 1, jpkm1
+            z2dtt = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk) 
+                  ! total intermediate advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask_crs(ji,jj,jk)
+      !         WRITE(numout,*) 'zwz(ji,jj,jk)', zwz(ji,jj,jk)
+      !         WRITE(numout,*) 'zbtr', zbtr
+      !         WRITE(numout,*) 'zwx(ji,jj,jk)', zwx(ji,jj,jk)
+      !         WRITE(numout,*) 'zwy(ji,jj,jk)', zwy(ji,jj,jk) 
+               END DO
+            END DO
+         END DO
+         WRITE(numout,*) 'test64561_tra', pta(10,10,1,1)
+         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
+         CALL crs_lbc_lnk( zwi, 'T', 1. )  
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ! store intermediate advective trends
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! 3. antidiffusive flux : high order minus low order
+         ! --------------------------------------------------
+         ! antidiffusive flux on i and j
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      
+         ! antidiffusive flux on k
+         zwz(:,:,1) = 0.e0         ! Surface value
+         !
+         DO jk = 2, jpkm1          ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL crs_lbc_lnk( zwx, 'U', -1. )   ;   CALL crs_lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL crs_lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc_crs( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = r1_bt_crs(ji,jj,jk)
+                  ! total advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! add them to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+         ENDIF
+         !
+      END DO
+      !
+                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz )
+      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd')
+  !    IF(lwp) WRITE(numout,*) 'TEST2', pta
+      !
+   END SUBROUTINE tra_adv_tvd_crs
+
+
+   SUBROUTINE nonosc_crs( pbef, paa, pbb, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  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), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('nonosc')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+
+      zbig  = 1.e+40_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp
+
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask_crs - zbig * ( 1.e0 - tmask_crs ),   &
+         &        paft * tmask_crs - zbig * ( 1.e0 - tmask_crs )  )
+      zbdo = MIN( pbef * tmask_crs + zbig * ( 1.e0 - tmask_crs ),   &
+         &        paft * tmask_crs + zbig * ( 1.e0 - tmask_crs )  )
+
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         z2dtt = p2dt(jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+               ! search maximum in neighbourhood
+               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+               ! search minimum in neighbourhood
+               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+               ! positive part of the flux
+               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+
+               ! negative part of the flux
+               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+
+               ! up & down beta terms
+               zbt = bt_crs(ji,jj,jk) / z2dtt
+               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu )
+
+               zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv )
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
+               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb )
+            END DO
+         END DO
+      END DO
+      CALL crs_lbc_lnk( paa, 'U', -1. )   ;   CALL crs_lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
+      !
+   END SUBROUTINE nonosc_crs
+
+   !!======================================================================
+END MODULE traadv_tvd_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trabbl.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trabbl.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trabbl.F90	(revision 4056)
@@ -0,0 +1,677 @@
+MODULE trabbl
+   !!==============================================================================
+   !!                       ***  MODULE  trabbl  ***
+   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
+   !!==============================================================================
+   !! History :  OPA  ! 1996-06  (L. Mortier)  Original code
+   !!            8.0  ! 1997-11  (G. Madec)    Optimization
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  free form + modules
+   !!             -   ! 2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
+   !!            3.3  ! 2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
+   !!             -   ! 2010-04  (G. Madec)  Campin & Goosse advective bbl 
+   !!             -   ! 2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
+   !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!----------------------------------------------------------------------
+#if   defined key_trabbl   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl'   or                             bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   tra_bbl_alloc : allocate trabbl arrays
+   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
+   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend
+   !!   tra_bbl_adv   : generic routine to compute bbl advective trend
+   !!   bbl           : computation of bbl diffu. flux coef. & transport in bottom boundary layer
+   !!   tra_bbl_init  : initialization, namelist read, parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE eosbn2         ! equation of state
+   USE trdmod_oce     ! trends: ocean variables
+   USE trdtra         ! trends: active tracers
+   USE iom            ! IOM server               
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_bbl       !  routine called by step.F90
+   PUBLIC   tra_bbl_init  !  routine called by opa.F90
+   PUBLIC   tra_bbl_dif   !  routine called by trcbbl.F90
+   PUBLIC   tra_bbl_adv   !  -          -          -              -
+   PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag
+
+   !                                           !!* Namelist nambbl * 
+   INTEGER , PUBLIC ::   nn_bbl_ldf = 0         !: =1   : diffusive bbl or not (=0)
+   INTEGER , PUBLIC ::   nn_bbl_adv = 0         !: =1/2 : advective bbl or not (=0)
+   !                                            !  =1 : advective bbl using the bottom ocean velocity
+   !                                            !  =2 :     -      -  using utr_bbl proportional to grad(rho)
+   REAL(wp), PUBLIC ::   rn_ahtbbl  = 1.e3_wp   !: along slope bbl diffusive coefficient [m2/s]
+   REAL(wp), PUBLIC ::   rn_gambbl  = 10.0_wp   !: lateral coeff. for bottom boundary layer scheme [s]
+
+   LOGICAL , PUBLIC ::   l_bbl                  !: flag to compute bbl diffu. flux coef and transport
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coeff. at u & v-pts
+
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trabbl.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION tra_bbl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION tra_bbl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d  (jpi,jpj) , mgrhu(jpi,jpj) ,     &
+         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     &
+         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          &
+         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj)                  , STAT= tra_bbl_alloc )
+         !
+      IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc )
+      IF( tra_bbl_alloc > 0 )   CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.')
+   END FUNCTION tra_bbl_alloc
+
+
+   SUBROUTINE tra_bbl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!              with the bottom boundary layer and add it to the general
+      !!              trend of tracer equations.
+      !!
+      !! ** Method  :   Depending on namtra_bbl namelist parameters the bbl
+      !!              diffusive and/or advective contribution to the tracer trend
+      !!              is added to the general tracer trend
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl')
+      !
+      IF( l_trdtra )   THEN                        !* Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      IF( l_bbl )  CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl)
+ 
+      IF( nn_bbl_ldf == 1 ) THEN                   !* Diffusive bbl
+         !
+      !   CALL tra_bbl_dif( tsb, tsa, jpts )
+         IF( ln_ctl )  &
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL lbc_lnk( ahu_bbl, 'U', 1. )     ;     CALL lbc_lnk( ahv_bbl, 'V', 1. )
+         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef     
+         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
+         !
+      END IF
+
+      IF( nn_bbl_adv /= 0 ) THEN                !* Advective bbl
+         !
+         CALL tra_bbl_adv( tsb, tsa, jpts )
+         IF(ln_ctl)   &
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL lbc_lnk( utr_bbl, 'U', 1. )     ;   CALL lbc_lnk( vtr_bbl, 'V', 1. )
+         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport     
+         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
+         !
+      END IF
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl')
+      !
+   END SUBROUTINE tra_bbl
+
+
+   SUBROUTINE tra_bbl_dif( ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_dif  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!
+      !! ** Action  :   pta   increased by the bbl diffusive trend
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      !
+      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   ik           ! local integers
+      REAL(wp) ::   zbtr         ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zptb
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif')
+      !
+      CALL wrk_alloc( jpi, jpj, zptb )
+      !
+      DO jn = 1, kjpt                                     ! tracer loop
+         !                                                ! ===========
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = 1, jpij
+#else
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+#endif
+               ik = mbkt(ji,jj)                        ! bottom T-level index
+               zptb(ji,jj) = ptb(ji,jj,ik,jn)              ! bottom before T and S
+            END DO
+         END DO
+         !                                                ! Compute the trend
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = jpi+1, jpij-jpi-1
+#  else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+#  endif
+               ik = mbkt(ji,jj)                            ! bottom T-level index
+               zbtr = r1_e1e2t(ji,jj)  / fse3t(ji,jj,ik)
+               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         &
+                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
+                  &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
+                  &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
+                  &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
+            END DO
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      CALL wrk_dealloc( jpi, jpj, zptb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif')
+      !
+   END SUBROUTINE tra_bbl_dif
+   
+
+   SUBROUTINE tra_bbl_adv( ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbl  ***
+      !!
+      !! ** Purpose :   Compute the before passive tracer trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
+      !! ** Method  :   advective bbl (nn_bbl_adv = 1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean near bottom velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e. 
+      !!                       transport proportional to the along-slope density gradient                   
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
+      INTEGER  ::   iis , iid , ijs , ijd    ! local integers
+      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
+      REAL(wp) ::   zbtr, ztra               ! local scalars
+      REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_adv')
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========         
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+# endif
+               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
+                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj)
+                  zu_bbl = ABS( utr_bbl(ji,jj) )
+                  !
+                  !                                               ! up  -slope T-point (shelf bottom point)
+                  zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus)
+                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
+                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
+                  !                   
+                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk)
+                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
+                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
+                  END DO
+                  ! 
+                  zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud)
+                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
+                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
+               ENDIF
+               !
+               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
+                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj)
+                  zv_bbl = ABS( vtr_bbl(ji,jj) )
+                  ! 
+                  ! up  -slope T-point (shelf bottom point)
+                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs)
+                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
+                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
+                  !                   
+                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk)
+                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
+                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
+                  END DO
+                  !                                               ! down-slope T-point (deep bottom point)
+                  zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd)
+                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
+                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
+               ENDIF
+            END DO
+            !
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv')
+      !
+   END SUBROUTINE tra_bbl_adv
+
+
+   SUBROUTINE bbl( kt, kit000, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!        * advective bbl (nn_bbl_adv=1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
+      !!        i.e. transport proportional to the along-slope density gradient
+      !!
+      !!      NB: the along slope density gradient is evaluated using the
+      !!      local density (i.e. referenced at a common local depth).
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      !
+      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER         , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      !!
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      INTEGER  ::   ik                        ! local integers
+      INTEGER  ::   iis , iid , ijs , ijd     !   -       -
+      INTEGER  ::   ikus, ikud, ikvs, ikvd    !   -       -
+      REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars
+      REAL(wp) ::   zgdrho, zt, zs, zh        !   -      -
+      !!
+      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function
+      REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb, ztb, zsb, zdep
+      !!----------------------- zv_bbl-----------------------------------------------
+      ! ratio alpha/beta = fsalbt : ratio of thermal over saline expension coefficients
+      ! ================            pft :  potential temperature in degrees celcius
+      !                             pfs :  salinity anomaly (s-35) in psu
+      !                             pfh :  depth in meters
+      ! nn_eos = 0  (Jackett and McDougall 1994 formulation)
+      fsalbt( pft, pfs, pfh ) =                                              &   ! alpha/beta
+         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
+                                   - 0.203814e-03 ) * pft                    &
+                                   + 0.170907e-01 ) * pft                    &
+                                   + 0.665157e-01                            &
+         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
+         +  ( ( - 0.302285e-13 * pfh                                         &
+                - 0.251520e-11 * pfs                                         &
+                + 0.512857e-12 * pft * pft          ) * pfh                  &
+                                     - 0.164759e-06   * pfs                  &
+             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
+                                     + 0.380374e-04 ) * pfh
+      fsbeta( pft, pfs, pfh ) =                                              &   ! beta
+         ( ( -0.415613e-09 * pft + 0.555579e-07 ) * pft                      &
+                                 - 0.301985e-05 ) * pft                      &
+                                 + 0.785567e-03                              &
+         + (     0.515032e-08 * pfs                                          &
+               + 0.788212e-08 * pft - 0.356603e-06 ) * pfs                   &
+               +(  (   0.121551e-17 * pfh                                    &
+                     - 0.602281e-15 * pfs                                    &
+                     - 0.175379e-14 * pft + 0.176621e-12 ) * pfh             &
+                                          + 0.408195e-10   * pfs             &
+                 + ( - 0.213127e-11 * pft + 0.192867e-09 ) * pft             &
+                                          - 0.121555e-07 ) * pfh
+      !!----------------------------------------------------------------------
+      
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'bbl')
+      !
+      CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
+      !
+     
+      IF( kt == kit000 )  THEN
+         IF(lwp)  WRITE(numout,*)
+         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
+         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      
+      !                                        !* bottom temperature, salinity, velocity and depth
+#if defined key_vectopt_loop
+      DO jj = 1, 1   ! vector opt. (forced unrolling)
+         DO ji = 1, jpij
+#else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#endif
+            ik = mbkt(ji,jj)                        ! bottom T-level index
+            ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1)      ! bottom before T and S
+            zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) * tmask(ji,jj,1)
+            zdep(ji,jj) = fsdept_0(ji,jj,ik)        ! bottom T-level reference depth
+            !
+            zub(ji,jj) = un(ji,jj,mbku(ji,jj))      ! bottom velocity
+            zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
+         END DO
+      END DO
+      
+      !                                   !-------------------!
+      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
+         !                                !-------------------!
+         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
+            DO ji = 1, jpim1              
+               !                                                ! i-direction 
+               zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )  ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+               !                                                         ! masked bbl i-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+               !                                                     
+               zsign          = SIGN(  0.5, - zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
+               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)                  ! masked diffusive flux coeff.
+               !
+               !                                                ! j-direction 
+               zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+               !                                                         ! masked bbl j-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+               !                                                    
+               zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
+               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
+               !
+            END DO
+         END DO
+         !
+      ENDIF
+
+      !                                   !-------------------!
+      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
+         !                                !-------------------!
+         SELECT CASE ( nn_bbl_adv )             !* bbl transport type
+         !
+         CASE( 1 )                                   != use of upper velocity
+            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                               ! i-direction
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  !                                                           ! masked bbl i-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+                  !                                                         
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )    ! sign of i-gradient * i-slope
+                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
+                  !
+                  !                                               ! j-direction
+                  zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+                  !                                                           ! masked bbl j-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )    ! sign of j-gradient * j-slope
+                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
+               END DO
+            END DO
+            !
+         CASE( 2 )                                 != bbl velocity = F( delta rho )
+            zgbbl = grav * rn_gambbl
+            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                         ! i-direction
+                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )     ;    iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                   ;    ikus = mbku(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    &  
+                     &                             - ( zsb(iid,jj) - zsb(iis,jj) )  ) * umask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
+                  !
+                  !                                         ! j-direction
+                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )      ;    ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                    ;    ikvs = mbkv(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji,jj+1) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji,jj+1) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    &  
+                     &                             - ( zsb(ji,ijd) - zsb(ji,ijs) )  ) * vmask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
+               END DO
+            END DO
+         END SELECT
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'bbl')
+      !
+   END SUBROUTINE bbl
+
+
+   SUBROUTINE tra_bbl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_init  ***
+      !!
+      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
+      !!
+      !! ** Method  :   Read the nambbl namelist and check the parameters
+      !!              called by nemo_init at the first timestep (kit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj               ! dummy loop indices
+      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer
+      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
+      !!
+      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init')
+      !
+      CALL wrk_alloc( jpi, jpj, zmbk ) 
+      !
+
+      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme
+      READ   ( numnam, nambbl )
+      !
+      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport
+      !
+      IF(lwp) THEN                   !* Parameter control and print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
+         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
+         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
+         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
+         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
+      ENDIF
+
+      !                              ! allocate trabbl arrays
+      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' )
+     
+      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
+      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
+
+      IF( nn_eos /= 0 )   CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' )
+
+
+      !                             !* inverse of surface of T-cells
+      r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) )
+      
+      !                             !* vertical index of  "deep" bottom u- and v-points
+      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv)
+         DO ji = 1, jpim1
+            mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land
+            mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+
+                                        !* sign of grad(H) at u- and v-points
+      mgrhu(jpi,:) = 0.    ;    mgrhu(:,jpj) = 0.   ;    mgrhv(jpi,:) = 0.    ;    mgrhv(:,jpj) = 0.
+      DO jj = 1, jpjm1                
+         DO ji = 1, jpim1
+            mgrhu(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
+            mgrhv(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji,jj+1,mbkt(ji,jj+1)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
+         END DO
+      END DO
+
+      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
+         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0)
+            e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj  )), fse3u_0(ji,jj,mbkt(ji,jj)) )  
+            e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji  ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) )  
+         END DO 
+      END DO
+      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
+
+      !                             !* masked diffusive flux coefficients 
+      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
+
+!! cc verification with coarsening
+
+!      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl
+         !
+!         SELECT CASE ( jp_cfg )
+!         CASE ( 2 )                          ! ORCA_R2
+!            ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL
+!            ii0 = 139   ;   ii1 = 140  
+!            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!            !
+!            ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL
+!            ii0 = 161   ;   ii1 = 162
+!            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!            !
+!         CASE ( 4 )                          ! ORCA_R4
+!            ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL
+!            ii0 =  70   ;   ii1 =  71  
+!            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+!         END SELECT
+!         !
+!      ENDIF
+!      !
+      CALL wrk_dealloc( jpi, jpj, zmbk ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init')
+      !
+   END SUBROUTINE tra_bbl_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bbl flag
+CONTAINS
+   SUBROUTINE tra_bbl_init               ! Dummy routine
+   END SUBROUTINE tra_bbl_init
+   SUBROUTINE tra_bbl( kt )              ! Dummy routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE tra_bbl
+#endif
+
+   !!======================================================================
+END MODULE trabbl
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf.F90	(revision 4056)
@@ -0,0 +1,350 @@
+MODULE traldf
+   !!======================================================================
+   !!                       ***  MODULE  traldf  ***
+   !! Ocean Active tracers : lateral diffusive trends 
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf      : update the tracer trend with the lateral diffusion
+   !!   tra_ldf_init : initialization, namelist read, and parameters control
+   !!       ldf_ano  : compute lateral diffusion for constant T-S profiles
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE ldfslp          ! ???
+   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
+   USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
+   USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
+   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
+   USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
+   USE trdmod_oce      ! ocean space and time domain
+   USE trdtra          ! ocean active tracers trends
+   USE prtctl          ! Print control
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf         ! called by step.F90 
+   PUBLIC   tra_ldf_init    ! called by opa.F90 
+   !
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
+
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile
+   !                                                               !  (key_traldf_ano only)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traldf.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf  ***
+      !! 
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf')
+      !
+      rldf = 1     ! For active tracers the 
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian
+      CASE ( 1 )                                                                              ! rotated laplacian
+         IF( ln_traldf_grif ) THEN                                                          
+                       CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator
+         ELSE                                                                                
+                       CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator
+         ENDIF
+      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, nit000, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap.
+         !
+      CASE ( -1 )                                ! esopa: test all possibility with control print
+         CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         IF( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )
+         ELSE
+            CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  
+         ENDIF
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_ldf_bilapg( kt, nit000, 'TRA',             tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      END SELECT
+
+#if defined key_traldf_ano
+      tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
+      tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)
+#endif
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_ldf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_ldf, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf')
+      !
+   END SUBROUTINE tra_ldf
+
+
+   SUBROUTINE tra_ldf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_init  ***
+      !! 
+      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !!
+      !! ** Method  :   set nldf from the namtra_ldf logicals
+      !!      nldf == -1   ESOPA test: ALL operators are used
+      !!      nldf ==  0   laplacian operator
+      !!      nldf ==  1   Rotated laplacian operator
+      !!      nldf ==  2   bilaplacian operator
+      !!      nldf ==  3   Rotated bilaplacian
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr         ! temporary integers 
+      !!----------------------------------------------------------------------
+
+      !  Define the lateral mixing oparator for tracers
+      ! ===============================================
+    
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_ldf already read in ldftra module'
+         WRITE(numout,*) '   see ldf_tra_init report for lateral mixing parameters'
+         WRITE(numout,*)
+      ENDIF
+
+      !                               ! control the input
+      ioptio = 0
+      IF( ln_traldf_lap   )   ioptio = ioptio + 1
+      IF( ln_traldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
+      ioptio = 0
+      IF( ln_traldf_level )   ioptio = ioptio + 1
+      IF( ln_traldf_hor   )   ioptio = ioptio + 1
+      IF( ln_traldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+
+      ! defined the type of lateral diffusion from ln_traldf_... logicals
+      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
+      ierr = 0
+      IF( ln_traldf_lap ) THEN       ! laplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation)
+            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ln_traldf_bilap ) THEN      ! bilaplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
+            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation)
+            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
+      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   &
+           CALL ctl_stop( '          eddy induced velocity on tracers',   &
+           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
+         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
+         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
+      ENDIF
+
+      IF( lk_esopa ) THEN
+         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
+         nldf = -1
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
+         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
+         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
+         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
+      ENDIF
+
+      ! Reference T & S diffusivity (if necessary)
+      ! ===========================
+      CALL ldf_ano
+      !
+   END SUBROUTINE tra_ldf_init
+
+#if defined key_traldf_ano
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_ano'               T & S lateral diffusion on anomalies
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_ano
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_ano  ***
+      !!
+      !! ** Purpose :   initializations of 
+      !!----------------------------------------------------------------------
+      !
+      USE zdf_oce         ! vertical mixing
+      USE trazdf          ! vertical mixing: double diffusion
+      USE zdfddm          ! vertical mixing: double diffusion
+      !
+      INTEGER  ::   jk              ! Dummy loop indice
+      INTEGER  ::   ierr            ! local integer
+      LOGICAL  ::   llsave          ! local logical
+      REAL(wp) ::   zt0, zs0, z12   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt     
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_ano')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
+      !
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      !                              ! allocate trabbl arrays
+      ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr )
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' )
+
+      ! defined the T & S reference profiles
+      ! ------------------------------------
+      zt0 =10.e0                               ! homogeneous ocean
+      zs0 =35.e0
+      zt_ref(:,:,:) = 10.0 * tmask(:,:,:)
+      zs_ref(:,:,:) = 35.0 * tmask(:,:,:)
+      IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0
+
+      !                                        ! T & S profile (to be coded +namelist parameter
+
+      ! prepare the ldf computation
+      ! ---------------------------
+      llsave = l_trdtra
+      l_trdtra = .false.      ! desactivate trend computation
+      t0_ldf(:,:,:) = 0.e0
+      s0_ldf(:,:,:) = 0.e0
+      ztb   (:,:,:) = tsb (:,:,:,jp_tem)
+      zsb   (:,:,:) = tsb (:,:,:,jp_sal)
+      ua    (:,:,:) = tsa (:,:,:,jp_tem)
+      va    (:,:,:) = tsa (:,:,:,jp_sal)
+      zavt  (:,:,:) = avt(:,:,:)
+      IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )
+      ! set tb, sb to reference values and avr to zero
+      tsb (:,:,:,jp_tem) = zt_ref(:,:,:)
+      tsb (:,:,:,jp_sal) = zs_ref(:,:,:)
+      tsa (:,:,:,jp_tem) = 0.e0
+      tsa (:,:,:,jp_sal) = 0.e0
+      avt(:,:,:)         = 0.e0
+
+      ! Compute the ldf trends
+      ! ----------------------
+      CALL tra_ldf( nit000 + 1 )      ! horizontal components (+1: no more init)
+      CALL tra_zdf( nit000     )      ! vertical component (if necessary nit000 to performed the init)
+
+      ! finalise the computation and recover all arrays
+      ! -----------------------------------------------
+      l_trdtra = llsave
+      z12 = 2.e0
+      IF( neuler == 1)   z12 = 1.e0
+      IF( ln_zdfexp ) THEN      ! ta,sa are the trends
+         t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)
+         s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
+      ELSE
+         DO jk = 1, jpkm1
+            t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
+            s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
+         END DO
+      ENDIF
+      tsb(:,:,:,jp_tem) = ztb (:,:,:)
+      tsb(:,:,:,jp_sal) = zsb (:,:,:)
+      tsa(:,:,:,jp_tem) = ua  (:,:,:)
+      tsa(:,:,:,jp_sal) = va  (:,:,:)
+      avt(:,:,:)        = zavt(:,:,:)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_ano')
+      !
+   END SUBROUTINE ldf_ano
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO T & S background profiles
+   !!----------------------------------------------------------------------
+   SUBROUTINE ldf_ano
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+   END SUBROUTINE ldf_ano
+#endif
+
+   !!======================================================================
+END MODULE traldf
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf_iso_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf_iso_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf_iso_crs.F90	(revision 4056)
@@ -0,0 +1,326 @@
+MODULE traldf_iso_crs
+   !!======================================================================
+   !!                   ***  MODULE  traldf_iso  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History :  OPA  !  1994-08  (G. Madec, M. Imbard)
+   !!            8.0  !  1997-05  (G. Madec)  split into traldf and trazdf
+   !!            NEMO !  2002-08  (G. Madec)  Free form, F90
+   !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-)
+   !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso  : update the tracer trend with the horizontal 
+   !!                  component of a iso-neutral laplacian operator
+   !!                  and with the vertical part of
+   !!                  the isopycnal or geopotential s-coord. operator 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfslp          ! iso-neutral slopes
+   USE diaptr          ! poleward transport diagnostics
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+#if defined key_diaar5
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+#endif
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_iso_crs   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traldf_iso.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_iso_crs( kt, kit000, cdtype, pgu, pgv,              &
+      &                                ptb, pta, kjpt, pahtb0 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 
+      !!      add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
+      !!      ========    with partial cell update if ln_zps=T.
+      !!
+      !!      2nd part :  horizontal fluxes of the lateral mixing operator
+      !!      ========    
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      3rd part: vertical trends of the lateral mixing operator
+      !!      ========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
+#if defined key_diaar5
+      REAL(wp)                         ::   zztmp               ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso')
+      !
+      CALL wrk_alloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      !
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         !!----------------------------------------------------------------------
+         !!   I - masked horizontal derivative 
+         !!----------------------------------------------------------------------
+         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
+         zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
+         !!end
+
+         ! Horizontal tracer gradient 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask_crs(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask_crs(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku_crs(ji,jj)) = pgu(ji,jj,jn)          
+                  zdjt(ji,jj,mbkv_crs(ji,jj)) = pgv(ji,jj,jn)      
+               END DO
+            END DO
+         ENDIF
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            ! 1. Vertical tracer gradient at level jk and jk+1
+            ! ------------------------------------------------
+            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask_crs(:,:,jk+1)
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask_crs(:,:,jk)
+            ENDIF
+
+            ! 2. Horizontal fluxes
+            ! --------------------   
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj)
+                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj)
+                  !
+                  zmsku = 1. / MAX(  tmask_crs(ji+1,jj,jk  ) + tmask_crs(ji,jj,jk+1)   &
+                     &             + tmask_crs(ji+1,jj,jk+1) + tmask_crs(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  tmask_crs(ji,jj+1,jk  ) + tmask_crs(ji,jj,jk+1)   &
+                     &             + tmask_crs(ji,jj+1,jk+1) + tmask_crs(ji,jj,jk  ), 1. )
+                  !
+                  zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk))
+                  zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))
+                  !
+  !                WRITE(numout,*) ' zcof1 ', zcof1
+  !                WRITE(numout,*) ' zcof2 ', zcof2
+                  zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   &
+                     &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask_crs(ji,jj,jk)
+                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
+                     &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask_crs(ji,jj,jk)                  
+               END DO
+            END DO
+
+            ! II.4 Second derivative (divergence) and add to the general trend
+            ! ----------------------------------------------------------------
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk)
+                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                          ! ===============
+         END DO                                        !   End of slab  
+         !                                             ! ===============
+         !
+         ! "Poleward" diffusive heat or salt transports (T-S case only)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) )
+         ENDIF
+ 
+#if defined key_diaar5
+         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+            z2d(:,:) = 0._wp 
+            zztmp = rau0 * rcp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL crs_lbc_lnk( z2d, 'U', -1. )
+         !   CALL crs_iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0._wp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL crs_lbc_lnk( z2d, 'V', -1. )
+            !CALL crs_iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+         END IF
+#endif
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend of T & S (extra diagonal terms only)
+         !!----------------------------------------------------------------------
+         
+         ! Local constant initialization
+         ! -----------------------------
+         ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
+         
+         ! Vertical fluxes
+         ! ---------------
+         
+         ! Surface and bottom vertical fluxes set to zero
+         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
+         
+         ! interior (2=<jk=<jpk-1)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef0 = - fsahtw(ji,jj,jk) * tmask_crs(ji,jj,jk)
+                  !
+                  zmsku = 1./MAX(   umask_crs(ji  ,jj,jk-1) + umask_crs(ji-1,jj,jk)      &
+                     &            + umask_crs(ji-1,jj,jk-1) + umask_crs(ji  ,jj,jk), 1.  )
+                  zmskv = 1./MAX(   vmask_crs(ji,jj  ,jk-1) + vmask_crs(ji,jj-1,jk)      &
+                     &            + vmask_crs(ji,jj-1,jk-1) + vmask_crs(ji,jj  ,jk), 1.  )
+                  !
+                  zcoef3 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmsku * wslpi (ji,jj,jk) / e1t_crs(ji,jj)
+                  zcoef4 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmskv * wslpj (ji,jj,jk) / e2t_crs(ji,jj)
+                  !
+   !               WRITE(numout,*) ' zcoef0 ', zcoef0
+   !               WRITE(numout,*) ' zcoef4 ', zcoef4 
+   !               WRITE(numout,*) ' zcoef3 ', zcoef3
+                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
+                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
+                     &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
+                     &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
+               END DO
+            END DO
+         END DO
+         
+         
+         ! I.5 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk)
+                  ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')
+      !
+   END SUBROUTINE tra_ldf_iso_crs
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_iso_crs( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine
+      INTEGER:: kt, kit000
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype,   &
+         &                       pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
+   END SUBROUTINE tra_ldf_iso_crs
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf_lap_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf_lap_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/traldf_lap_crs.F90	(revision 4056)
@@ -0,0 +1,161 @@
+MODULE traldf_lap_crs
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_lap  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code
+   !!                 !  91-11  (G. Madec)
+   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
+   !!                 !  96-01  (G. Madec)  statement function for e3
+   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module
+   !!            1.0  !  04-08  (C. Talandier) New trends organization
+   !!                 !  05-11  (G. Madec)  add zps case
+   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
+   !!                 using a iso-level harmonic (laplacien) operator.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce , ONLY : lk_vvl         ! ocean space and time domain
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE in_out_manager  ! I/O manager
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_lap_crs   ! routine called by step.F90
+
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: traldf_lap.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_lap_crs( kt, kit000, cdtype, pgu, pgv,      &
+      &                                ptb, pta, kjpt ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_lap  ***
+      !!                   
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   Second order diffusive operator evaluated using before
+      !!      fields (forward time scheme). The horizontal diffusive trends of 
+      !!      the tracer is given by:
+      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
+      !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
+      !!      Add this trend to the general tracer trend pta :
+      !!          pta = pta + difft
+      !!
+      !! ** Action  : - Update pta arrays with the before iso-level 
+      !!                harmonic mixing trend.
+      !!----------------------------------------------------------------------
+      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      INTEGER  ::   iku, ikv, ierr       ! local integers
+      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      CALL timing_start('tra_ldf_lap')
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         IF( .NOT. ALLOCATED( e1ur ) ) THEN
+            ! This routine may be called for both active and passive tracers. 
+            ! Allocate and set saved arrays on first call only.
+            ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr )
+            IF( lk_mpp    )   CALL mpp_sum( ierr )
+            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' )
+            !
+            e1ur(:,:) = 1._wp / e1u_crs(:,:)             !!cc
+            e2vr(:,:) = 1._wp / e2v_crs(:,:)             !!cc
+         ENDIF
+      ENDIF
+
+      !                                                          ! =========== !
+      DO jn = 1, kjpt                                            ! tracer loop !
+         !                                                       ! =========== !    
+         DO jk = 1, jpkm1                                            ! slab loop
+            !                                           
+            ! 1. First derivative (gradient)
+            ! -------------------
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = fsahtu(ji,jj,jk) * umask_crs(ji,jj,jk) * e1ur(ji,jj) * e2e3u_msk(ji,jj,jk)
+                  zabe2 = fsahtv(ji,jj,jk) * vmask_crs(ji,jj,jk) * e2vr(ji,jj) * e1e3v_msk(ji,jj,jk)
+                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+ !!cc           IF( ln_zps ) THEN      ! set gradient at partial step level
+ !              DO jj = 1, jpjm1
+ !                 DO ji = 1, fs_jpim1   ! vector opt.
+ !                    ! last level
+ !                    iku = mbku(ji,jj)
+ !                    ikv = mbkv(ji,jj)
+ !                    IF( iku == jk ) THEN
+ !                       zabe1 = fsahtu(ji,jj,iku) * umask_crs(ji,jj,iku) * e1ur(ji,jj) * e3u_crs(ji,jj,iku)
+ !                       ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
+ !                    ENDIF
+ !                    IF( ikv == jk ) THEN
+ !                       zabe2 = fsahtv(ji,jj,ikv) * vmask_crs(ji,jj,ikv) * e2vr(ji,jj) * e3v_crs(ji,jj,ikv)
+ !                       ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
+ !                    ENDIF
+ !                 END DO
+ !              END DO
+ !!cc           ENDIF
+         
+         
+            ! 2. Second derivative (divergence) added to the general tracer trends
+            ! ---------------------------------------------------------------------
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = r1_bt_crs(ji,jj,jk) 
+                  ! horizontal diffusive trends added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+               END DO
+            END DO
+            !
+         END DO                                             !  End of slab  
+         !
+         ! "Poleward" diffusive heat or salt transports
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) )
+            IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) )
+         ENDIF
+         !                                                  ! ==================
+      END DO                                                ! end of tracer loop
+      !                                                     ! ==================
+      CALL timing_stop('tra_ldf_lap')
+      !
+   END SUBROUTINE tra_ldf_lap_crs
+
+   !!==============================================================================
+END MODULE traldf_lap_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/tranxt_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/tranxt_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/tranxt_crs.F90	(revision 4056)
@@ -0,0 +1,342 @@
+MODULE tranxt_crs
+   !!======================================================================
+   !!                       ***  MODULE  tranxt  ***
+   !! Ocean active tracers:  time stepping on temperature and salinity
+   !!======================================================================
+   !! History :  OPA  !  1991-11  (G. Madec)  Original code
+   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
+   !!            8.0  !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
+   !!             -   !  1996-04  (A. Weaver)  Euler forward step
+   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
+   !!             -   !  2005-04  (C. Deltel) Add Asselin trend in the ML budget
+   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
+   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
+   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  semi-implicit hpg with asselin filter + modified LF-RA
+   !!             -   !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_nxt       : time stepping on tracers
+   !!   tra_nxt_fix   : time stepping on tracers : fixed    volume case
+   !!   tra_nxt_vvl   : time stepping on tracers : variable volume case
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE zdf_oce         ! ???
+   USE domvvl          ! variable volume
+   USE dynspg_oce      ! surface     pressure gradient variables
+   USE dynhpg          ! hydrostatic pressure gradient 
+   USE trdmod_oce      ! ocean space and time domain variables 
+   USE trdtra          ! ocean active tracers trends 
+   USE phycst
+   USE obc_oce
+   USE obctra          ! open boundary condition (obc_tra routine)
+   USE bdy_oce
+   USE bdytra          ! open boundary condition (bdy_tra routine)
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE traqsr          ! penetrative solar radiation (needed for nksr)
+   USE crs
+#if defined key_agrif
+   USE agrif_opa_update
+   USE agrif_opa_interp
+#endif
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_nxt_crs       ! routine called by step.F90
+   PUBLIC   tra_nxt_fix_crs   ! to be used in trcnxt
+   PUBLIC   tra_nxt_vvl_crs   ! to be used in trcnxt
+
+   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
+   !! $Id: tranxt.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_nxt_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tranxt  ***
+      !!
+      !! ** Purpose :   Apply the boundary condition on the after temperature  
+      !!             and salinity fields, achieved the time stepping by adding
+      !!             the Asselin filter on now fields and swapping the fields.
+      !! 
+      !! ** Method  :   At this stage of the computation, ta and sa are the 
+      !!             after temperature and salinity as the time stepping has
+      !!             been performed in trazdf_imp or trazdf_exp module.
+      !!
+      !!              - Apply lateral boundary conditions on (ta,sa) 
+      !!             at the local domain   boundaries through lbc_lnk call, 
+      !!             at the one-way open boundaries (lk_obc=T), 
+      !!             at the AGRIF zoom     boundaries (lk_agrif=T)
+      !!
+      !!              - Update lateral boundary conditions on AGRIF children
+      !!             domains (lk_agrif=T)
+      !!
+      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
+      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  ::   jk, jn    ! dummy loop indices
+      REAL(wp) ::   zfact     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         !
+         rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg
+      ENDIF
+
+      ! Update after tracer on domain lateral boundaries
+      ! 
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
+      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+      !
+#if defined key_obc 
+      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries
+#endif
+#if defined key_bdy 
+      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
+#endif
+#if defined key_agrif
+      CALL Agrif_tra                     ! AGRIF zoom boundaries
+#endif
+ 
+      ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
+      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
+      ENDIF
+
+      ! trends computation initialisation
+      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
+         ztrds(:,:,:) = tsn(:,:,:,jp_sal)
+      ENDIF
+
+      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
+         DO jn = 1, jpts
+            DO jk = 1, jpkm1
+               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)    
+            END DO
+         END DO
+      ELSE                                            ! Leap-Frog + Asselin filter time stepping
+         !
+         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)     
+         ELSE                 ;   CALL tra_nxt_fix_crs( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
+         ENDIF
+      ENDIF 
+      !
+#if defined key_agrif
+      ! Update tracer at AGRIF zoom boundaries
+      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
+#endif      
+      !
+      ! trends computation
+      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
+         DO jk = 1, jpkm1
+            zfact = 1.e0 / r2dtra(jk)             
+            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
+            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
+         END DO
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+      END IF
+      !
+      !                        ! control print
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask_crs,   &
+         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask_crs )
+      !
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_nxt')
+      !
+   END SUBROUTINE tra_nxt_crs
+
+
+   SUBROUTINE tra_nxt_fix_crs( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_nxt_fix  ***
+      !!
+      !! ** Purpose :   fixed volume: apply the Asselin time filter and 
+      !!                swap the tracer fields.
+      !! 
+      !! ** Method  : - Apply a Asselin time filter on now fields.
+      !!              - save in (ta,sa) an average over the three time levels 
+      !!             which will be used to compute rdn and thus the semi-implicit
+      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
+      !!              - swap tracer fields to prepare the next time_step.
+      !!                This can be summurized for tempearture as:
+      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
+      !!             ztm = 0                                   otherwise
+      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
+      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
+      !!             tn  = ta  
+      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
+      !!
+      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
+      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
+      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi_crs,jpj_crs,jpk,kjpt)  ::   ptb      ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi_crs,jpj_crs,jpk,kjpt)  ::   ptn      ! now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi_crs,jpj_crs,jpk,kjpt)  ::   pta      ! tracer trend
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      LOGICAL  ::   ll_tra_hpg       ! local logical
+      REAL(wp) ::   ztn, ztd         ! local scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg    
+      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
+      ENDIF
+      !
+      DO jn = 1, kjpt
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj_crs
+               DO ji = 1, jpi_crs
+                  ztn = ptn(ji,jj,jk,jn)                                    
+                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
+                  !
+                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn 
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
+                  !
+                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
+               END DO
+           END DO
+         END DO
+         !
+      END DO
+      !
+   END SUBROUTINE tra_nxt_fix_crs
+
+
+   SUBROUTINE tra_nxt_vvl_crs( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_nxt_vvl  ***
+      !!
+      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
+      !!                and swap the tracer fields.
+      !! 
+      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
+      !!              - save in (ta,sa) a thickness weighted average over the three 
+      !!             time levels which will be used to compute rdn and thus the semi-
+      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
+      !!              - swap tracer fields to prepare the next time_step.
+      !!                This can be summurized for tempearture as:
+      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
+      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
+      !!             ztm = 0                                                       otherwise
+      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
+      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
+      !!             tn  = ta 
+      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
+      !!
+      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
+      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
+      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+      !!     
+      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
+      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      IF( cdtype == 'TRA' )  THEN   
+         ll_tra     = .TRUE.           ! active tracers case  
+         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
+         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
+      ELSE                          
+         ll_tra     = .FALSE.          ! passive tracers case
+         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
+         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
+      ENDIF
+      !
+      DO jn = 1, kjpt      
+         DO jk = 1, jpkm1
+            zfact1 = atfp * rdttra(jk)
+            zfact2 = zfact1 / rau0
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ze3t_b = fse3t_b(ji,jj,jk)
+                  ze3t_n = fse3t_n(ji,jj,jk)
+                  ze3t_a = fse3t_a(ji,jj,jk)
+                  !                                         ! tracer content at Before, now and after
+                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
+                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
+                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
+                  !
+                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
+                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
+                  !
+                  ze3t_f = ze3t_n + atfp * ze3t_d
+                  ztc_f  = ztc_n  + atfp * ztc_d
+                  !
+                  IF( ll_tra .AND. jk == 1 ) THEN           ! first level only for T & S
+                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
+                      ztc_f  = ztc_f  - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
+                  ENDIF
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
+                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
+
+                   ze3t_f = 1.e0 / ze3t_f
+                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
+                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
+                   !
+                   IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
+                      ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
+                      pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
+                   ENDIF
+               END DO
+            END DO
+         END DO
+         ! 
+      END DO
+      !
+   END SUBROUTINE tra_nxt_vvl_crs
+
+   !!======================================================================
+END MODULE tranxt_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trazdf.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trazdf.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trazdf.F90	(revision 4056)
@@ -0,0 +1,156 @@
+MODULE trazdf
+   !!==============================================================================
+   !!                 ***  MODULE  trazdf  ***
+   !! Ocean active tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
+   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_zdf      : Update the tracer trend with the vertical diffusion
+   !!   tra_zdf_init : initialisation of the computation
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE domvvl          ! variable volume
+   USE phycst          ! physical constant
+   USE zdf_oce         ! ocean vertical physics variables
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE dynspg_oce
+
+   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine)
+
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE trdmod_oce      ! ocean active tracers: lateral physics
+   USE trdtra      ! ocean tracers trends 
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_zdf        ! routine called by step.F90
+   PUBLIC   tra_zdf_init   ! routine called by nemogcm.F90
+
+   INTEGER ::   nzdf = 0   ! type vertical diffusion algorithm used (defined from ln_zdf...  namlist logicals)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trazdf.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_zdf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf  ***
+      !!
+      !! ** Purpose :   compute the vertical ocean tracer physics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER  ::   jk                   ! Dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf')
+      !
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
+         r2dtra(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog)
+      ENDIF
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme 
+      CASE ( -1 )                                       ! esopa: test all possibility with control print
+         CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      END SELECT
+
+      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         DO jk = 1, jpkm1
+            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk)
+         END DO
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+      ENDIF
+
+      !                                          ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf')
+      !
+   END SUBROUTINE tra_zdf
+
+
+   SUBROUTINE tra_zdf_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_zdf_init  ***
+      !!
+      !! ** Purpose :   Choose the vertical mixing scheme
+      !!
+      !! ** Method  :   Set nzdf from ln_zdfexp
+      !!      nzdf = 0   explicit (time-splitting) scheme (ln_zdfexp=T)
+      !!           = 1   implicit (euler backward) scheme (ln_zdfexp=F)
+      !!      NB: rotation of lateral mixing operator or TKE or KPP scheme,
+      !!      the implicit scheme is required.
+      !!----------------------------------------------------------------------
+      USE zdftke
+      USE zdfgls
+      USE zdfkpp
+      !!----------------------------------------------------------------------
+
+      ! Choice from ln_zdfexp already read in namelist in zdfini module
+      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
+      ELSE                   ;   nzdf = 1           ! use implicit scheme
+      ENDIF
+
+      ! Force implicit schemes
+      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1      ! TKE, GLS or KPP physics
+      IF( ln_traldf_iso                           )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco              )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
+            &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
+
+      ! Test: esopa
+      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+      !
+   END SUBROUTINE tra_zdf_init
+
+   !!==============================================================================
+END MODULE trazdf
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trazdf_imp_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trazdf_imp_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trazdf_imp_crs.F90	(revision 4056)
@@ -0,0 +1,247 @@
+MODULE trazdf_imp_crs
+   !!======================================================================
+   !!                 ***  MODULE  trazdf_imp  ***
+   !! Ocean  tracers:  vertical component of the tracer mixing trend
+   !!======================================================================
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            7.0  !  1991-11  (G. Madec)
+   !!                 !  1992-06  (M. Imbard) correction on tracer trend loops
+   !!                 !  1996-01  (G. Madec) statement function for e3
+   !!                 !  1997-05  (G. Madec) vertical component of isopycnal
+   !!                 !  1997-07  (G. Madec) geopotential diffusion in s-coord
+   !!                 !  2000-08  (G. Madec) double diffusive mixing
+   !!   NEMO     1.0  !  2002-08  (G. Madec) F90: Free form and module
+   !!            2.0  !  2006-11  (G. Madec) New step reorganisation
+   !!            3.2  !  2009-03  (G. Madec)  heat and salt content trends
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!             -   !  2011-02  (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition
+   !!----------------------------------------------------------------------
+  
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical  
+   !!                 part of the mixing tensor.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+  ! USE dom_oce, ONLY : lk_vvl        ! ocean space and time domain variables 
+   USE dom_oce,         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE trc_oce         ! share passive tracers/ocean variables
+   USE domvvl          ! variable volume
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldftra          ! lateral mixing type
+   USE ldfslp          ! lateral physics: slope of diffusion
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE traldf_iso_grif ! active tracers: Griffies operator
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_zdf_imp_crs   !  routine called by step.F90
+
+   REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trazdf_imp.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+   SUBROUTINE tra_zdf_imp_crs( kt, kit000, cdtype, p2dt, ptb, pta, kjpt ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_imp  ***
+      !!
+      !! ** Purpose :   Compute the after tracer through a implicit computation
+      !!     of the vertical tracer diffusion (including the vertical component 
+      !!     of lateral mixing (only for 2nd order operator, for fourth order 
+      !!     it is already computed and add to the general trend in traldf) 
+      !!
+      !! ** Method  :  The vertical diffusion of the tracer t  is given by:
+      !!                  difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=ta).
+      !!      If lk_zdfddm=T, use avs for salinity or for passive tracers
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      If iso-neutral mixing, add to avt the contribution due to lateral mixing.
+      !!
+      !! ** Action  : - pta  becomes the after tracer
+      !!---------------------------------------------------------------------
+      USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt ) 
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
+         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         IF( lk_vvl ) THEN   ;    r_vvl = 1._wp       ! Variable volume indicator
+         ELSE                ;    r_vvl = 0._wp       
+         ENDIF
+      ENDIF
+      !
+      !                                               ! ============= !
+      DO jn = 1, kjpt                                 !  tracer loop  !
+         !                                            ! ============= !
+         !
+         !  Matrix construction
+         ! --------------------
+         ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer
+         !
+         IF(  ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR.   &
+            & ( cdtype == 'TRC' .AND. jn == 1 )  )  THEN
+            !
+            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
+            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk)
+            ELSE                                            ;   zwt(:,:,2:jpk) = avs_crs(:,:,2:jpk)
+            ENDIF
+            zwt(:,:,1) = 0._wp
+            !
+#if defined key_ldfslp
+            ! isoneutral diffusion: add the contribution 
+            IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)       
+                     END DO
+                  END DO
+               END DO
+            ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       &
+                           &                          * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                           &                             + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+#endif
+            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+              !        ze3ta =  ( 1. - r_vvl ) +        r_vvl   * ocean_volume_crs_t(ji,jj,jk)   ! after scale factor at T-point
+             !         ze3tn =         r_vvl   + ( 1. - r_vvl ) * ocean_volume_crs_t(ji,jj,jk)   ! now   scale factor at T-point
+                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * e3t_crs(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * e3t_crs(ji,jj,jk)   ! now   scale factor at T-point
+                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_0(jk  ) )  !cc
+                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_0(jk+1) )  !cc
+                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+                 END DO
+               END DO
+            END DO
+            !
+            !! Matrix inversion from the first level
+            !!----------------------------------------------------------------------
+            !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+            !
+            !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+            !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+            !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+            !        (        ...               )( ...  ) ( ...  )
+            !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+            !
+            !   m is decomposed in the product of an upper and lower triangular matrix.
+            !   The 3 diagonal terms are in 3d arrays: zwd, zws, zwi.
+            !   Suffices i,s and d indicate "inferior" (below diagonal), diagonal
+            !   and "superior" (above diagonal) components of the tridiagonal system.
+            !   The solution will be in the 4d array pta.
+            !   The 3d array zwt is used as a work space array.
+            !   En route to the solution pta is used a to evaluate the rhs and then 
+            !   used as a work space array: its value is modified.
+            !
+            ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+            ! done once for all passive tracers (so included in the IF instruction)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zwt(ji,jj,1) = zwd(ji,jj,1)
+               END DO
+            END DO
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                    zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+                  END DO
+               END DO
+            END DO
+            !
+         END IF 
+         !         
+         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+           !     ze3tb = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,1)
+           !     ze3tn = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,1)
+               ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1)
+               ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1)
+               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+           !        ze3tb = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,jk)
+           !        ze3tn = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,jk)
+                  ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk)
+                  ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk)
+                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
+               END DO
+            END DO
+         END DO
+
+         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask_crs(ji,jj,jpkm1)
+            END DO
+         END DO
+         DO jk = jpk-2, 1, -1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
+                     &             / zwt(ji,jj,jk) * tmask_crs(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                            ! ================= !
+      END DO                                          !  end tracer loop  !
+      !                                               ! ================= !
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwt ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp')
+      !
+   END SUBROUTINE tra_zdf_imp_crs
+
+   !!==============================================================================
+END MODULE trazdf_imp_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trc.F90	(revision 4056)
@@ -0,0 +1,192 @@
+MODULE trc
+   !!======================================================================
+   !!                      ***  MODULE  trc  ***
+   !! Passive tracers   :  module for tracers defined
+   !!======================================================================
+   !! History :   OPA  !  1996-01  (M. Levy)  Original code
+   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model
+   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
+   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+   
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   trc_alloc   ! called by nemogcm.F90
+
+   !! parameters for the control of passive tracers
+   !! --------------------------------------------------
+   INTEGER, PUBLIC                                                 ::   numnat        !: logicla unit for the passive tracer NAMELIST
+   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics
+
+   !! passive tracers fields (before,now,after)
+   !! --------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)               ::  trai           !: initial total tracer
+   REAL(wp), PUBLIC                                                ::  areatot        !: total volume 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step
+
+   !! interpolated gradient
+   !!--------------------------------------------------  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtru           !: hor. gradient at u-points at bottom ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrv           !: hor. gradient at v-points at bottom ocean level
+   
+   !! passive tracers  (input and output)
+   !! ------------------------------------------  
+   LOGICAL             , PUBLIC                                    ::  ln_rsttr       !: boolean term for restart i/o for passive tracers (namelist)
+   LOGICAL             , PUBLIC                                    ::  lrst_trc       !: logical to control the trc restart write
+   INTEGER             , PUBLIC                                    ::  nn_dttrc       !: frequency of step on passive tracers
+   INTEGER             , PUBLIC                                    ::  nn_writetrc    !: time step frequency for concentration outputs (namelist)
+   INTEGER             , PUBLIC                                    ::  nutwrs         !: output FILE for passive tracers restart
+   INTEGER             , PUBLIC                                    ::  nutrst         !: logical unit for restart FILE for passive tracers
+   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr.
+   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input)
+   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
+   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step
+   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files
+   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag
+   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model
+
+   !! information for outputs
+   !! --------------------------------------------------
+   TYPE, PUBLIC :: PTRACER                                                            !: Passive tracer type
+       CHARACTER(len = 20)  :: clsname  !: short name
+       CHARACTER(len = 80)  :: cllname  !: long name
+       CHARACTER(len = 20)  :: clunit   !: unit
+       LOGICAL              :: llinit   !: read in a file or not
+       LOGICAL              :: llsave   !: save the tracer or not
+   END TYPE PTRACER
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name 
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit
+   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file
+   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_wri     !: save the tracer or not
+
+   TYPE, PUBLIC :: DIAG                                                               !: passive trcacer ddditional diagnostic type
+      CHARACTER(len = 20)  :: sname    !: short name
+      CHARACTER(len = 80)  :: lname    !: long name
+      CHARACTER(len = 20)  :: units    !: unit
+   END TYPE DIAG
+
+   !! additional 2D/3D outputs namelist
+   !! --------------------------------------------------
+   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d         !: additional 2d outputs array 
+   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d         !: additional 3d outputs array 
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2d        !: 2d field short name
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2l        !: 2d field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2u        !: 2d field unit
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3d        !: 3d field short name
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3l        !: 3d field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3u        !: 3d field unit
+   LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic
+   INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs
+
+   !! Biological trends
+   !! -----------------
+   LOGICAL            , PUBLIC                                        ::  ln_diabio      !: boolean term for biological diagnostic
+   INTEGER            , PUBLIC                                        ::  nn_writebio    !: frequency of biological outputs
+   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trbio          !: biological trends
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbio         !: bio field short name
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbil         !: bio field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbiu         !: bio field unit
+
+   !! variables to average over physics over passive tracer sub-steps.
+   !! ----------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_tm       !: i-horizontal velocity average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vn_tm       !: j-horizontal velocity average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !: 
+# if defined key_zdfddm
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s]
+# endif
+#if defined key_ldfslp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points
+#endif
+#if defined key_trabbl
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm  !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm  !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm  !: j-direction slope at u-, w-points
+#endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm     !: average ssh for the now step [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_tm   !: average ssh for the now step [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_tm   !: average ssh for the now step [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_b_hold !:hold sshb from the beginning of each sub-stepping[m]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_b_hold !:hold sshb from the beginning of each sub-stepping[m] 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  rnf_tm     !: river runoff
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm   !: depth in metres to the bottom of the relevant grid box
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_tm    !: mixed layer depth average [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fr_i_tm    !: average ice fraction     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_tm     !: freshwater budget: volume flux [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emps_tm    !: freshwater budget:concentration/dilution [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_b_hold !: hold emp from the beginning of each sub-stepping[m]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_tm     !: solar radiation average [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  wndm_tm    !: 10m wind average [m]
+   !
+#if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 3D coefficients ** at T-,U-,V-,W-points
+#elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 2D coefficients ** at T-,U-,V-,W-points
+#elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 1D coefficients ** at T-,U-,V-,W-points
+#else
+   REAL(wp), PUBLIC                                        ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 0D coefficients ** at T-,U-,V-,W-points
+#endif
+   !
+#if defined key_traldf_eiv
+#  if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 3D coefficients **
+#  elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 2D coefficients **
+#  elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_tm , aeiv_tm, aeiw_tm   !: ** 1D coefficients **
+#  else
+   REAL(wp), PUBLIC                                        ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 0D coefficients **
+#  endif
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
+   !! $Id: trc.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_alloc()
+      !!-------------------------------------------------------------------
+      !!                    *** ROUTINE trc_alloc ***
+      !!-------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &  
+         &      gtru(jpi,jpj,jpk)     , gtrv(jpi,jpj,jpk)                             ,       &
+         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       &
+         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
+         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )  
+
+      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trc_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trc_oce.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trc_oce.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trc_oce.F90	(revision 4056)
@@ -0,0 +1,283 @@
+MODULE trc_oce
+   !!======================================================================
+   !!                      ***  MODULE  trc_oce  ***
+   !! Ocean passive tracer  :  share SMS/Ocean variables
+   !!======================================================================
+   !! History :  1.0  !  2004-03  (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration         
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE in_out_manager  ! I/O manager
+!   USE dom_oce         ! ocean space and time domain
+   USE dom_oce , ONLY : gdepw
+   USE dom_oce , ONLY : tmask
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_oce_rgb        ! routine called by traqsr.F90
+   PUBLIC   trc_oce_rgb_read   ! routine called by traqsr.F90
+   PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least
+   PUBLIC   trc_oce_alloc      ! function called by nemogcm.F90
+
+   REAL(wp), PUBLIC                                      ::   r_si2   !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3   !: light absortion coefficient
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol   !: volume for degraded regions
+
+#if defined key_top && defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_top'   &   'key_pisces'                       PISCES bio-model          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag
+#else
+   !!----------------------------------------------------------------------
+   !! Default option                          No bio-model light absorption      
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag
+#endif
+
+#if defined key_offline
+   !!----------------------------------------------------------------------
+   !!   'key_offline'                                     OFFLINE mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_offline = .TRUE.   !: offline flag
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NO  OFFLINE mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_offline = .FALSE.   !: offline flag
+#endif
+#if defined key_degrad
+   !!----------------------------------------------------------------------
+   !!   'key_degrad'                                     Degradation mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .TRUE.   !: degradation flag
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NO  Degradation mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .FALSE.   !: degradation flag
+#endif
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trc_oce.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  trc_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr(2)        ! Local variables
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+                     ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) )
+      IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) )
+      trc_oce_alloc  = MAXVAL( ierr )
+      !
+      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
+   END FUNCTION trc_oce_alloc
+
+
+   SUBROUTINE trc_oce_rgb( prgb )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_opt_init  ***
+      !!
+      !! ** Purpose :   Initialization of of the optical scheme
+      !!
+      !! ** Method  :   Set a look up table for the optical coefficients
+      !!                i.e. the attenuation coefficient for R-G-B light 
+      !!                tabulated in Chlorophyll class (from JM Andre)
+      !!
+      !! ** Action  :   prgb(3,61) tabulated R-G-B attenuation coef. 
+      !!
+      !! Reference  : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
+      !!
+      INTEGER  ::   jc     ! dummy loop indice
+      INTEGER  ::   irgb   ! temporary integer
+      REAL(wp) ::   zchl   ! temporary scalar
+      REAL(wp), DIMENSION(4,61) ::   zrgb   ! tabulated attenuation coefficient (formerly read in 'kRGB61.txt')
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_oce_rgb : Initialisation of the optical look-up table'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !
+      !  Chlorophyll        !     Blue attenuation     !     Green attenuation    !     Red attenuation      !
+      zrgb(1, 1) =  0.010   ;   zrgb(2, 1) = 0.01618   ;   zrgb(3, 1) = 0.07464   ;   zrgb(4, 1) = 0.37807
+      zrgb(1, 2) =  0.011   ;   zrgb(2, 2) = 0.01654   ;   zrgb(3, 2) = 0.07480   ;   zrgb(4, 2) = 0.37823
+      zrgb(1, 3) =  0.013   ;   zrgb(2, 3) = 0.01693   ;   zrgb(3, 3) = 0.07499   ;   zrgb(4, 3) = 0.37840
+      zrgb(1, 4) =  0.014   ;   zrgb(2, 4) = 0.01736   ;   zrgb(3, 4) = 0.07518   ;   zrgb(4, 4) = 0.37859
+      zrgb(1, 5) =  0.016   ;   zrgb(2, 5) = 0.01782   ;   zrgb(3, 5) = 0.07539   ;   zrgb(4, 5) = 0.37879
+      zrgb(1, 6) =  0.018   ;   zrgb(2, 6) = 0.01831   ;   zrgb(3, 6) = 0.07562   ;   zrgb(4, 6) = 0.37900
+      zrgb(1, 7) =  0.020   ;   zrgb(2, 7) = 0.01885   ;   zrgb(3, 7) = 0.07586   ;   zrgb(4, 7) = 0.37923
+      zrgb(1, 8) =  0.022   ;   zrgb(2, 8) = 0.01943   ;   zrgb(3, 8) = 0.07613   ;   zrgb(4, 8) = 0.37948
+      zrgb(1, 9) =  0.025   ;   zrgb(2, 9) = 0.02005   ;   zrgb(3, 9) = 0.07641   ;   zrgb(4, 9) = 0.37976
+      zrgb(1,10) =  0.028   ;   zrgb(2,10) = 0.02073   ;   zrgb(3,10) = 0.07672   ;   zrgb(4,10) = 0.38005
+      zrgb(1,11) =  0.032   ;   zrgb(2,11) = 0.02146   ;   zrgb(3,11) = 0.07705   ;   zrgb(4,11) = 0.38036
+      zrgb(1,12) =  0.035   ;   zrgb(2,12) = 0.02224   ;   zrgb(3,12) = 0.07741   ;   zrgb(4,12) = 0.38070
+      zrgb(1,13) =  0.040   ;   zrgb(2,13) = 0.02310   ;   zrgb(3,13) = 0.07780   ;   zrgb(4,13) = 0.38107
+      zrgb(1,14) =  0.045   ;   zrgb(2,14) = 0.02402   ;   zrgb(3,14) = 0.07821   ;   zrgb(4,14) = 0.38146
+      zrgb(1,15) =  0.050   ;   zrgb(2,15) = 0.02501   ;   zrgb(3,15) = 0.07866   ;   zrgb(4,15) = 0.38189
+      zrgb(1,16) =  0.056   ;   zrgb(2,16) = 0.02608   ;   zrgb(3,16) = 0.07914   ;   zrgb(4,16) = 0.38235
+      zrgb(1,17) =  0.063   ;   zrgb(2,17) = 0.02724   ;   zrgb(3,17) = 0.07967   ;   zrgb(4,17) = 0.38285
+      zrgb(1,18) =  0.071   ;   zrgb(2,18) = 0.02849   ;   zrgb(3,18) = 0.08023   ;   zrgb(4,18) = 0.38338
+      zrgb(1,19) =  0.079   ;   zrgb(2,19) = 0.02984   ;   zrgb(3,19) = 0.08083   ;   zrgb(4,19) = 0.38396
+      zrgb(1,20) =  0.089   ;   zrgb(2,20) = 0.03131   ;   zrgb(3,20) = 0.08149   ;   zrgb(4,20) = 0.38458
+      zrgb(1,21) =  0.100   ;   zrgb(2,21) = 0.03288   ;   zrgb(3,21) = 0.08219   ;   zrgb(4,21) = 0.38526
+      zrgb(1,22) =  0.112   ;   zrgb(2,22) = 0.03459   ;   zrgb(3,22) = 0.08295   ;   zrgb(4,22) = 0.38598
+      zrgb(1,23) =  0.126   ;   zrgb(2,23) = 0.03643   ;   zrgb(3,23) = 0.08377   ;   zrgb(4,23) = 0.38676
+      zrgb(1,24) =  0.141   ;   zrgb(2,24) = 0.03842   ;   zrgb(3,24) = 0.08466   ;   zrgb(4,24) = 0.38761
+      zrgb(1,25) =  0.158   ;   zrgb(2,25) = 0.04057   ;   zrgb(3,25) = 0.08561   ;   zrgb(4,25) = 0.38852
+      zrgb(1,26) =  0.178   ;   zrgb(2,26) = 0.04289   ;   zrgb(3,26) = 0.08664   ;   zrgb(4,26) = 0.38950
+      zrgb(1,27) =  0.200   ;   zrgb(2,27) = 0.04540   ;   zrgb(3,27) = 0.08775   ;   zrgb(4,27) = 0.39056
+      zrgb(1,28) =  0.224   ;   zrgb(2,28) = 0.04811   ;   zrgb(3,28) = 0.08894   ;   zrgb(4,28) = 0.39171
+      zrgb(1,29) =  0.251   ;   zrgb(2,29) = 0.05103   ;   zrgb(3,29) = 0.09023   ;   zrgb(4,29) = 0.39294
+      zrgb(1,30) =  0.282   ;   zrgb(2,30) = 0.05420   ;   zrgb(3,30) = 0.09162   ;   zrgb(4,30) = 0.39428
+      zrgb(1,31) =  0.316   ;   zrgb(2,31) = 0.05761   ;   zrgb(3,31) = 0.09312   ;   zrgb(4,31) = 0.39572
+      zrgb(1,32) =  0.355   ;   zrgb(2,32) = 0.06130   ;   zrgb(3,32) = 0.09474   ;   zrgb(4,32) = 0.39727
+      zrgb(1,33) =  0.398   ;   zrgb(2,33) = 0.06529   ;   zrgb(3,33) = 0.09649   ;   zrgb(4,33) = 0.39894
+      zrgb(1,34) =  0.447   ;   zrgb(2,34) = 0.06959   ;   zrgb(3,34) = 0.09837   ;   zrgb(4,34) = 0.40075
+      zrgb(1,35) =  0.501   ;   zrgb(2,35) = 0.07424   ;   zrgb(3,35) = 0.10040   ;   zrgb(4,35) = 0.40270
+      zrgb(1,36) =  0.562   ;   zrgb(2,36) = 0.07927   ;   zrgb(3,36) = 0.10259   ;   zrgb(4,36) = 0.40480
+      zrgb(1,37) =  0.631   ;   zrgb(2,37) = 0.08470   ;   zrgb(3,37) = 0.10495   ;   zrgb(4,37) = 0.40707
+      zrgb(1,38) =  0.708   ;   zrgb(2,38) = 0.09056   ;   zrgb(3,38) = 0.10749   ;   zrgb(4,38) = 0.40952
+      zrgb(1,39) =  0.794   ;   zrgb(2,39) = 0.09690   ;   zrgb(3,39) = 0.11024   ;   zrgb(4,39) = 0.41216
+      zrgb(1,40) =  0.891   ;   zrgb(2,40) = 0.10374   ;   zrgb(3,40) = 0.11320   ;   zrgb(4,40) = 0.41502
+      zrgb(1,41) =  1.000   ;   zrgb(2,41) = 0.11114   ;   zrgb(3,41) = 0.11639   ;   zrgb(4,41) = 0.41809
+      zrgb(1,42) =  1.122   ;   zrgb(2,42) = 0.11912   ;   zrgb(3,42) = 0.11984   ;   zrgb(4,42) = 0.42142
+      zrgb(1,43) =  1.259   ;   zrgb(2,43) = 0.12775   ;   zrgb(3,43) = 0.12356   ;   zrgb(4,43) = 0.42500
+      zrgb(1,44) =  1.413   ;   zrgb(2,44) = 0.13707   ;   zrgb(3,44) = 0.12757   ;   zrgb(4,44) = 0.42887
+      zrgb(1,45) =  1.585   ;   zrgb(2,45) = 0.14715   ;   zrgb(3,45) = 0.13189   ;   zrgb(4,45) = 0.43304
+      zrgb(1,46) =  1.778   ;   zrgb(2,46) = 0.15803   ;   zrgb(3,46) = 0.13655   ;   zrgb(4,46) = 0.43754
+      zrgb(1,47) =  1.995   ;   zrgb(2,47) = 0.16978   ;   zrgb(3,47) = 0.14158   ;   zrgb(4,47) = 0.44240
+      zrgb(1,48) =  2.239   ;   zrgb(2,48) = 0.18248   ;   zrgb(3,48) = 0.14701   ;   zrgb(4,48) = 0.44765
+      zrgb(1,49) =  2.512   ;   zrgb(2,49) = 0.19620   ;   zrgb(3,49) = 0.15286   ;   zrgb(4,49) = 0.45331
+      zrgb(1,50) =  2.818   ;   zrgb(2,50) = 0.21102   ;   zrgb(3,50) = 0.15918   ;   zrgb(4,50) = 0.45942
+      zrgb(1,51) =  3.162   ;   zrgb(2,51) = 0.22703   ;   zrgb(3,51) = 0.16599   ;   zrgb(4,51) = 0.46601
+      zrgb(1,52) =  3.548   ;   zrgb(2,52) = 0.24433   ;   zrgb(3,52) = 0.17334   ;   zrgb(4,52) = 0.47313
+      zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,53) = 0.48080
+      zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,54) = 0.48909
+      zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,55) = 0.49803
+      zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,56) = 0.50768
+      zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,57) = 0.51810
+      zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,58) = 0.52934
+      zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,59) = 0.54147
+      zrgb(1,60) =  8.912   ;   zrgb(2,60) = 0.44336   ;   zrgb(3,60) = 0.25725   ;   zrgb(4,60) = 0.55457
+      zrgb(1,61) = 10.000   ;   zrgb(2,61) = 0.47804   ;   zrgb(3,61) = 0.27178   ;   zrgb(4,61) = 0.56870
+      !
+      prgb(:,:) = zrgb(2:4,:)
+      !
+      r_si2 = 1.e0 / zrgb(2, 1)        ! blue with the smallest chlorophyll concentration)
+      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
+      !
+      DO jc = 1, 61                         ! check
+         zchl = zrgb(1,jc)
+         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
+         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
+         IF( irgb /= jc ) THEN
+            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
+            CALL ctl_stop( 'trc_oce_rgb : inconsistency in Chl tabulated attenuation coeff.' )
+         ENDIF
+      END DO
+      !
+   END SUBROUTINE trc_oce_rgb
+
+
+   SUBROUTINE trc_oce_rgb_read( prgb )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_opt_init  ***
+      !!
+      !! ** Purpose :   Initialization of of the optical scheme
+      !!
+      !! ** Method  :   read the look up table for the optical coefficients
+      !!
+      !! ** input   :   xkrgb(61) precomputed array corresponding to the  
+      !!                          attenuation coefficient (from JM Andre)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
+      !!
+      INTEGER  ::   jc, jb ! dummy loop indice
+      INTEGER  ::   irgb   ! temporary integer
+      REAL(wp) ::   zchl   ! temporary scalar
+      INTEGER  ::   numlight
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) 
+      ENDIF
+      !
+      CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      DO jc = 1, 61
+         READ(numlight,*) zchl, ( prgb(jb,jc), jb = 1, 3 )
+         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )   
+         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb  
+         IF( irgb /= jc ) THEN  
+            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
+            CALL ctl_stop( 'trc_oce_rgb_read : inconsistency in Chl tabulated attenuation coeff.' )
+         ENDIF
+      END DO
+      CLOSE( numlight )
+      !
+      r_si2 = 1.e0 / prgb(1, 1)      ! blue with the smallest chlorophyll concentration)
+      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
+      !
+   END SUBROUTINE trc_oce_rgb_read
+
+
+   FUNCTION trc_oce_ext_lev( prldex, pqsr_frc ) RESULT( pjl )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE trc_oce_ext_lev  ***
+      !!       
+      !! ** Purpose :   compute max. level for light penetration
+      !!          
+      !! ** Method  :   the function provides the level at which irradiance 
+      !!                becomes negligible (i.e. = 1.e-15 W/m2) for 3 or 2 bands light
+      !!                penetration: I(z) = pqsr_frc * EXP(hext/prldex) = 1.e-15 W/m2
+      !!                # prldex is the longest depth of extinction:
+      !!                   - prldex = 23 m (2 bands case)
+      !!                   - prldex = 62 m (3 bands case: blue waveband & 0.01 mg/m2 for the chlorophyll)
+      !!                # pqsr_frc is the fraction of solar radiation which penetrates,
+      !!                considering Qsr=240 W/m2 and rn_abs = 0.58:
+      !!                   - pqsr_frc = Qsr * (1-rn_abs)   = 1.00e2 W/m2 (2 bands case)
+      !!                   - pqsr_frc = Qsr * (1-rn_abs)/3 = 0.33e2 W/m2 (3 bands case & equi-partition)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   prldex    ! longest depth of extinction
+      REAL(wp), INTENT(in) ::   pqsr_frc  ! frac. solar radiation which penetrates 
+      !!
+      INTEGER  ::   jk, pjl            ! levels
+      REAL(wp) ::   zhext              ! deepest level till which light penetrates
+      REAL(wp) ::   zprec = 15._wp     ! precision to reach -LOG10(1.e-15)
+      REAL(wp) ::   zem                ! temporary scalar 
+      !!----------------------------------------------------------------------
+      !
+      ! It is not necessary to compute anything bellow the following depth
+      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) )
+      !
+      ! Level of light extinction
+      pjl = jpkm1
+      DO jk = jpkm1, 1, -1
+         zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) )
+         IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
+      END DO
+      !
+   END FUNCTION trc_oce_ext_lev
+
+   !!======================================================================
+END MODULE trc_oce
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcadv.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcadv.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcadv.F90	(revision 4056)
@@ -0,0 +1,209 @@
+MODULE trcadv
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv  ***
+   !! Ocean passive tracers:  advection trend 
+   !!==============================================================================
+   !! History :  2.0  !  05-11  (G. Madec)  Original code
+   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv      : compute ocean tracer advection trend
+   !!   trc_adv_ctl  : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
+   USE traadv_tvd_crs  ! TVD      scheme           (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
+   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE prtctl_trc      ! Print control
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_adv          ! routine called by step module
+   PUBLIC   trc_adv_alloc    ! routine called by nemogcm module
+
+   INTEGER ::   nadv   ! choice of the type of advection scheme
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
+   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcadv.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_adv_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )
+
+      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
+
+   END FUNCTION trc_adv_alloc
+
+
+   SUBROUTINE trc_adv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv  ***
+      !!
+      !! ** Purpose :   compute the ocean tracer advection trend.
+      !!
+      !! ** Method  : - Update the tracer with the advection term following nadv
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk, ji, jj
+      CHARACTER (len=22) ::   charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_adv')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !
+
+      IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+  !    IF(lwp) WRITE(numout,*) 'TEST', e1e2t
+      !                                                   ! effective transport
+      DO jk = 1, jpkm1
+         !    
+         !!cc                                            ! eulerian transport only
+         zun(:,:,jk) = e2e3u_msk(:,:,jk) * un(:,:,jk)
+         zvn(:,:,jk) = e1e3v_msk(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1e2w_msk(:,:,jk) * wn(:,:,jk)
+         !!cc
+         !
+      END DO
+      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom
+      WRITE(numout,*) 'test6456_trb', trb(10,10,1,1)
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary)
+         &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' )
+      !
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST 
+      !
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+         CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )          
+         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         !
+      END SELECT
+
+      !                                              ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_adv')
+      !
+   END SUBROUTINE trc_adv
+
+
+   SUBROUTINE trc_adv_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                
+      !! ** Purpose : Control the consistency between namelist options for 
+      !!              passive tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!----------------------------------------------------------------------
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck    )   ioptio = ioptio + 1
+      IF( lk_esopa         )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
+
+      !                              ! Set nadv
+      IF( ln_trcadv_cen2   )   nadv =  1
+      IF( ln_trcadv_tvd    )   nadv =  2
+      IF( ln_trcadv_muscl  )   nadv =  3
+      IF( ln_trcadv_muscl2 )   nadv =  4
+      IF( ln_trcadv_ubs    )   nadv =  5
+      IF( ln_trcadv_qck    )   nadv =  6
+      IF( lk_esopa         )   nadv = -1
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
+         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
+         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
+         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ctl
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv
+#endif
+
+  !!======================================================================
+END MODULE trcadv
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcadv_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcadv_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcadv_crs.F90	(revision 4056)
@@ -0,0 +1,211 @@
+MODULE trcadv_crs
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv  ***
+   !! Ocean passive tracers:  advection trend 
+   !!==============================================================================
+   !! History :  2.0  !  05-11  (G. Madec)  Original code
+   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv      : compute ocean tracer advection trend
+   !!   trc_adv_ctl  : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
+   USE traadv_tvd_crs  ! TVD      scheme           (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
+   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE prtctl_trc      ! Print control
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_adv_crs          ! routine called by step module
+   PUBLIC   trc_adv_alloc_crs   ! routine called by nemogcm module
+
+   INTEGER ::   nadv   ! choice of the type of advection scheme
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
+   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcadv.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_adv_alloc_crs()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc_crs )
+
+      IF( trc_adv_alloc_crs /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
+
+   END FUNCTION trc_adv_alloc_crs
+
+
+   SUBROUTINE trc_adv_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv  ***
+      !!
+      !! ** Purpose :   compute the ocean tracer advection trend.
+      !!
+      !! ** Method  : - Update the tracer with the advection term following nadv
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk 
+      CHARACTER (len=22) ::   charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity
+      !!----------------------------------------------------------------------
+      !
+      
+      IF( nn_timing == 1 )  CALL timing_start('trc_adv')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !
+
+      IF( kt == nittrc000 )   CALL trc_adv_ctl_crs          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+  !    IF(lwp) WRITE(numout,*) 'TEST', e1e2t
+      !                                                   ! effective transport
+      DO jk = 1, jpkm1
+         !                                                ! eulerian transport only
+         zun(:,:,jk) = e2e3u_msk(:,:,jk) * un(:,:,jk)
+         zvn(:,:,jk) = e1e3v_msk(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1e2w_msk(:,:,jk)                 * wn(:,:,jk)
+ !        IF(lwp) WRITE(numout,*) 'zwn', zwn
+ !        IF(lwp) WRITE(numout,*) 'wn', wn
+         
+         !
+      END DO
+      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom
+
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary)
+         &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' )
+      !
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST 
+      !
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+         CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )          
+         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         !
+      END SELECT
+
+      !                                              ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_adv')
+      !
+   END SUBROUTINE trc_adv_crs
+
+
+   SUBROUTINE trc_adv_ctl_crs
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                
+      !! ** Purpose : Control the consistency between namelist options for 
+      !!              passive tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!----------------------------------------------------------------------
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck    )   ioptio = ioptio + 1
+      IF( lk_esopa         )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
+
+      !                              ! Set nadv
+      IF( ln_trcadv_cen2   )   nadv =  1
+      IF( ln_trcadv_tvd    )   nadv =  2
+      IF( ln_trcadv_muscl  )   nadv =  3
+      IF( ln_trcadv_muscl2 )   nadv =  4
+      IF( ln_trcadv_ubs    )   nadv =  5
+      IF( ln_trcadv_qck    )   nadv =  6
+      IF( lk_esopa         )   nadv = -1
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
+         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
+         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
+         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ctl_crs
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv_crs( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv_crs
+#endif
+
+  !!======================================================================
+END MODULE trcadv_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcbbl.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcbbl.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcbbl.F90	(revision 4056)
@@ -0,0 +1,117 @@
+MODULE trcbbl
+  !!======================================================================
+   !!                       ***  MODULE  trcbbl  ***
+   !! Ocean passive tracers physics :  advective and/or diffusive bottom boundary 
+   !!                                  layer scheme
+   !!======================================================================
+   !!==============================================================================
+   !! History :  OPA  !  1996-06  (L. Mortier)  Original code
+   !!            8.0  !  1997-11  (G. Madec)    Optimization
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  free form + modules
+   !!             -   !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
+   !!            3.3  !  2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
+   !!             -   !  2010-04  (G. Madec)  Campin & Goosse advective bbl 
+   !!             -   !  2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if  defined key_top &&  defined key_trabbl 
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl                      diffusive or/and adevective bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!    trc_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and active tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trabbl_crs              ! 
+   USE prtctl_trc          ! Print control for debbuging
+   USE trdmod_oce
+   USE trdtra
+
+   PUBLIC   trc_bbl       !  routine called by step.F90
+
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcbbl.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+
+   SUBROUTINE trc_bbl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
+      !!
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+      WRITE(numout,*) '          nn_bbl_ldf_test     = ' , nn_bbl_ldf
+      
+      IF( nn_timing == 1 )  CALL timing_start('trc_bbl')
+      !
+      IF( .NOT. lk_offline .AND. nn_dttrc == 1 ) THEN
+         CALL bbl_crs( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport
+         l_bbl_crs = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files
+      ENDIF
+
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      !* Diffusive bbl :
+      IF( nn_bbl_ldf == 1 ) THEN
+  
+         CALL tra_bbl_dif_crs( trb, tra, jptra )  
+         IF( ln_ctl )   THEN
+            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout)
+            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         ENDIF
+         !
+      END IF
+
+      !* Advective bbl : bbl upstream advective trends added to the tracer trends
+      IF( nn_bbl_adv /= 0 ) THEN
+         !
+         CALL tra_bbl_adv_crs( trb, tra, jptra )  
+         IF( ln_ctl )   THEN
+            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout)
+            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         ENDIF
+         !
+      END IF
+
+      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends
+      ENDIF
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('trc_bbl')
+      !
+   END SUBROUTINE trc_bbl
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_bbl( kt )              ! Empty routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbl
+#endif
+
+   !!======================================================================
+END MODULE trcbbl
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcdia.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcdia.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcdia.F90	(revision 4056)
@@ -0,0 +1,493 @@
+MODULE trcdia
+   !!======================================================================
+   !!                       *** MODULE trcdia ***
+   !! TOP :   Output of passive tracers
+   !!======================================================================
+   !! History :   OPA  !  1995-01 (M. Levy)  Original code
+   !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface
+   !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer
+   !!              -   !  1999-09 (M.A. Foujols) split into three parts
+   !!   NEMO      1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!                  !  2008-05 (C. Ethe re-organization)
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !! trc_dia     : main routine of output passive tracer
+   !! trcdit_wr   : outputs of concentration fields
+   !! trcdii_wr   : outputs of additional 2D/3D diagnostics
+   !! trcdib_wr   : outputs of biological fields
+   !!----------------------------------------------------------------------
+ !  USE dom_oce         ! ocean space and time domain variables 
+   USE oce_trc
+   USE trc
+   USE par_trc
+   USE dianam    ! build name of file (routine)
+   USE ioipsl    ! I/O manager
+   USE iom       ! I/O manager
+   USE lib_mpp   ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_dia        ! called by XXX module 
+
+   INTEGER  ::   nit5      !: id for tracer output file
+   INTEGER  ::   ndepit5   !: id for depth mesh
+   INTEGER  ::   nhorit5   !: id for horizontal mesh
+   INTEGER  ::   ndimt50   !: number of ocean points in index array
+   INTEGER  ::   ndimt51   !: number of ocean points in index array
+   REAL(wp) ::   zjulian   !: ????   not DOCTOR !
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext50   !: integer arrays for ocean 3D index
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext51   !: integer arrays for ocean surface index
+
+   INTEGER  ::   nitd      !: id for additional array output file
+   INTEGER  ::   ndepitd   !: id for depth mesh
+   INTEGER  ::   nhoritd   !: id for horizontal mesh
+
+   INTEGER  ::   nitb        !:         id.         for additional array output file
+   INTEGER  ::   ndepitb   !:  id for depth mesh
+   INTEGER  ::   nhoritb   !:  id for horizontal mesh
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcdia.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_dia( kt )  
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_dia  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step
+      !
+      INTEGER             ::  ierr   ! local integer
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nittrc000 )  THEN
+         ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=ierr )
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'STOP', 'trc_diat: unable to allocate arrays' )  ;   RETURN
+         ENDIF
+      ENDIF
+      !
+      IF( .NOT.lk_iomput ) THEN
+                          CALL trcdit_wr( kt )      ! outputs for tracer concentration
+         IF( ln_diatrc )  CALL trcdii_wr( kt )      ! outputs for additional arrays
+         IF( ln_diabio )  CALL trcdib_wr( kt )      ! outputs for biological trends
+      ENDIF
+      !
+   END SUBROUTINE trc_dia
+
+
+   SUBROUTINE trcdit_wr( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trcdit_wr  ***
+      !!
+      !! ** Purpose :   Standard output of passive tracer : concentration fields
+      !!
+      !! ** Method  :   At the beginning of the first time step (nittrc000), define all
+      !!             the NETCDF files and fields for concentration of passive tracer
+      !!
+      !!        At each time step call histdef to compute the mean if necessary
+      !!        Each nwritetrc time step, output the instantaneous or mean fields
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! ocean time-step
+      !
+      INTEGER ::   jn
+      LOGICAL ::   ll_print = .FALSE.
+      CHARACTER (len=40) :: clhstnam, clop
+      INTEGER ::   inum = 11             ! temporary logical unit
+      CHARACTER (len=20) :: cltra, cltrau
+      CHARACTER (len=80) :: cltral
+      REAL(wp) :: zsto, zout, zdt
+      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
+      !!----------------------------------------------------------------------
+
+      ! Initialisation
+      ! --------------
+
+      ! local variable for debugging
+      ll_print = .FALSE.                  ! change it to true for more control print
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+# if defined key_diainstant
+      zsto = nn_writetrc * rdt
+      clop = "inst("//TRIM(clop)//")"
+# else
+      zsto = zdt
+      clop = "ave("//TRIM(clop)//")"
+# endif
+      zout = nn_writetrc * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      itmod = kt - nittrc000 + 1
+      it    = kt
+      iiter = ( nittrc000 - 1 ) / nn_dttrc
+
+      ! Define NETCDF files and fields at beginning of first time step
+      ! --------------------------------------------------------------
+
+      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt
+      
+      IF( kt == nittrc000 ) THEN
+
+         IF(lwp) THEN                   ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc
+            DO jn = 1, jptra
+               IF( ln_trc_wri(jn) )  WRITE(numout,*) ' ouput tracer nb : ', jn, '    short name : ', ctrcnm(jn) 
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+
+         ! Compute julian date from starting date of the run
+         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
+         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
+         IF(lwp)WRITE(numout,*)' '  
+         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         &
+            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   &
+            &                 ,'Julian day : ', zjulian  
+  
+         IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  &
+            &                    ' limit storage in depth = ', ipk
+
+         IF( lk_offline .AND. lwp ) THEN
+            CALL dia_nam( clhstnam, nn_writetrc,' ' )
+            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea )
+            WRITE(inum,*) clhstnam
+            CLOSE(inum)
+         ENDIF
+
+         ! Define the NETCDF files for passive tracer concentration
+         CALL dia_nam( clhstnam, nn_writetrc, 'ptrc_T' )
+         IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam
+
+         ! Horizontal grid : glamt and gphit
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     &
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
+            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)
+
+         ! Vertical grid for tracer : gdept
+         CALL histvert( nit5, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit5)
+
+         ! Index of ocean points in 3D and 2D (surface)
+         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndext50, ndimt50 )
+         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndext51, ndimt51 )
+
+         ! Declare all the output fields as NETCDF variables
+         DO jn = 1, jptra
+            IF( ln_trc_wri(jn) ) THEN
+               cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer
+               cltral = TRIM( ctrcln(jn) )   ! long title for tracer
+               cltrau = TRIM( ctrcun(jn) )   ! UNIT for tracer
+               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  &
+                  &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout ) 
+            ENDIF
+         END DO
+
+         ! end netcdf files header
+         CALL histend( nit5, snc4set )
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr'
+         IF( ll_print )   CALL FLUSH(numout )
+
+      ENDIF
+
+      ! Start writing the tracer concentrations
+      ! ---------------------------------------
+
+      IF( lwp .AND. MOD( itmod, nn_writetrc ) == 0 ) THEN
+         WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~~~~ '
+      ENDIF
+
+      DO jn = 1, jptra
+         cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer
+         IF( ln_trc_wri(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 )
+      END DO
+
+      ! close the file 
+      ! --------------
+      IF( kt == nitend )   CALL histclo( nit5 )
+      !
+   END SUBROUTINE trcdit_wr
+
+   SUBROUTINE trcdii_wr( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trcdii_wr  ***
+      !!
+      !! ** Purpose :   output of passive tracer : additional 2D and 3D arrays
+      !!
+      !! ** Method  :   At the beginning of the first time step (nittrc000), define all
+      !!             the NETCDF files and fields for concentration of passive tracer
+      !!
+      !!        At each time step call histdef to compute the mean if necessary
+      !!        Each nn_writedia time step, output the instantaneous or mean fields
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! ocean time-step
+      !!
+      LOGICAL ::   ll_print = .FALSE.
+      CHARACTER (len=40) ::   clhstnam, clop
+      CHARACTER (len=20) ::   cltra, cltrau
+      CHARACTER (len=80) ::   cltral
+      INTEGER  ::   jl
+      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
+      REAL(wp) ::   zsto, zout, zdt
+      !!----------------------------------------------------------------------
+
+      ! Initialisation
+      ! --------------
+      
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = ll_print .AND. lwp
+      !
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+#  if defined key_diainstant
+      zsto = nn_writedia * zdt
+      clop = "inst("//TRIM(clop)//")"
+#  else
+      zsto = zdt
+      clop = "ave("//TRIM(clop)//")"
+#  endif
+      zout = nn_writedia * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      itmod = kt - nittrc000 + 1
+      it    = kt
+      iiter = ( nittrc000 - 1 ) / nn_dttrc
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt
+
+      IF( kt == nittrc000 ) THEN
+
+         ! Define the NETCDF files for additional arrays : 2D or 3D
+
+         ! Define the T grid file for tracer auxiliary files
+
+         CALL dia_nam( clhstnam, nn_writedia, 'diad_T' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+
+         ! Define a netcdf FILE for 2d and 3d arrays
+
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             &
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
+            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )
+
+         ! Vertical grid for 2d and 3d arrays
+
+         CALL histvert( nitd, 'deptht', 'Vertical T levels','m', ipk, gdept_0, ndepitd)
+
+         ! Declare all the output fields as NETCDF variables
+
+         ! more 3D horizontal arrays
+         DO jl = 1, jpdia3d
+            cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic
+            cltral = TRIM( ctrc3l(jl) )  ! long title for 3D diagnostic
+            cltrau = TRIM( ctrc3u(jl) )  ! UNIT for 3D diagnostic
+            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   &
+               &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout )
+         END DO
+
+         ! more 2D horizontal arrays
+         DO jl = 1, jpdia2d
+            cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic
+            cltral = TRIM( ctrc2l(jl) )  ! long title for 2D diagnostic
+            cltrau = TRIM( ctrc2u(jl) )  ! UNIT for 2D diagnostic
+            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  &
+               &          1, 1, 1,  -99, 32, clop, zsto, zout )
+         END DO
+
+         ! TODO: more 2D vertical sections arrays : I or J indice fixed
+
+         ! CLOSE netcdf Files
+         CALL histend( nitd, snc4set )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdii_wr'
+         IF( ll_print )   CALL FLUSH(numout )
+         !
+      ENDIF
+
+      ! 2. Start writing data
+      ! ---------------------
+
+      IF( lwp .AND. MOD( itmod, nn_writedia ) == 0 ) THEN
+         WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+
+      ! more 3D horizontal arrays
+      DO jl = 1, jpdia3d
+         cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic
+         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50)
+      END DO
+
+      ! more 2D horizontal arrays
+      DO jl = 1, jpdia2d
+         cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic
+         CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51)
+      END DO
+
+      ! Closing all files
+      ! -----------------
+      IF( kt == nitend )   CALL histclo(nitd)
+      !
+
+   END SUBROUTINE trcdii_wr
+
+   SUBROUTINE trcdib_wr( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trcdib_wr  ***
+      !!
+      !! ** Purpose :   output of passive tracer : biological fields
+      !!
+      !! ** Method  :   At the beginning of the first time step (nittrc000), define all
+      !!             the NETCDF files and fields for concentration of passive tracer
+      !!
+      !!        At each time step call histdef to compute the mean if necessary
+      !!        Each nn_writebio time step, output the instantaneous or mean fields
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
+      !!
+      LOGICAL ::   ll_print = .FALSE.
+      CHARACTER (len=40) ::   clhstnam, clop
+      CHARACTER (len=20) ::   cltra, cltrau
+      CHARACTER (len=80) ::   cltral
+      INTEGER  ::   ji, jj, jk, jl
+      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
+      REAL(wp) ::   zsto, zout, zdt
+      !!----------------------------------------------------------------------
+
+      ! Initialisation
+      ! --------------
+      
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+#        if defined key_diainstant
+      zsto = nn_writebio * zdt
+      clop = "inst("//TRIM(clop)//")"
+#        else
+      zsto = zdt
+      clop = "ave("//TRIM(clop)//")"
+#        endif
+      zout = nn_writebio * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      itmod = kt - nittrc000 + 1
+      it    = kt
+      iiter = ( nittrc000 - 1 ) / nn_dttrc
+
+      ! Define NETCDF files and fields at beginning of first time step
+      ! --------------------------------------------------------------
+
+      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt
+
+      IF( kt == nittrc000 ) THEN
+
+         ! Define the NETCDF files for biological trends
+
+         CALL dia_nam(clhstnam,nn_writebio,'biolog')
+         IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam
+         ! Horizontal grid : glamt and gphit
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      &
+            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          &
+            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )
+         ! Vertical grid for biological trends
+         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb)
+
+         ! Declare all the output fields as NETCDF variables
+         ! biological trends
+         DO jl = 1, jpdiabio
+            cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic
+            cltral = TRIM( ctrbil(jl) )  ! long title for biological diagnostic
+            cltrau = TRIM( ctrbiu(jl) )  ! UNIT for biological diagnostic
+            CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  &
+               &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout)
+         END DO
+
+         ! CLOSE netcdf Files
+          CALL histend( nitb, snc4set )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdib_wr'
+         IF(ll_print) CALL FLUSH(numout )
+         !
+      ENDIF
+
+      ! Start writing data
+      ! ------------------
+
+      ! biological trends
+      IF( lwp .AND. MOD( itmod, nn_writebio ) == 0 ) THEN
+         WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+
+      DO jl = 1, jpdiabio
+         cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic
+         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50)
+      END DO
+
+      ! Closing all files
+      ! -----------------
+      IF( kt == nitend )   CALL histclo( nitb )
+      !
+   END SUBROUTINE trcdib_wr
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_dia( kt )                      ! Empty routine   
+      INTEGER, INTENT(in) :: kt
+   END SUBROUTINE trc_dia   
+#endif
+
+   !!======================================================================
+END MODULE trcdia
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcini.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcini.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcini.F90	(revision 4056)
@@ -0,0 +1,230 @@
+MODULE trcini
+   !!======================================================================
+   !!                         ***  MODULE trcini  ***
+   !! TOP :   Manage the passive tracer initialization
+   !!======================================================================
+   !! History :   -   ! 1991-03 (O. Marti)  original code
+   !!            1.0  ! 2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!            2.0  ! 2005-10 (C. Ethe, G. Madec) revised architecture
+   !!            4.0  ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_init  :   Initialization for passive tracer
+   !!   top_alloc :   allocate the TOP arrays
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! shared variables between ocean and passive tracers
+   USE trc             ! passive tracers common variables
+   USE trcrst          ! passive tracers restart
+   USE trcnam          ! Namelist read
+   USE trcini_cfc      ! CFC      initialisation
+   USE trcini_lobster  ! LOBSTER  initialisation
+   USE trcini_pisces   ! PISCES   initialisation
+   USE trcini_c14b     ! C14 bomb initialisation
+   USE trcini_my_trc   ! MY_TRC   initialisation
+   USE trcdta          ! initialisation form files
+   USE daymod          ! calendar manager
+   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
+   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
+   USE trcsub       ! variables to substep passive tracers
+   USE crs
+   
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   trc_init   ! called by opa
+
+    !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2011)
+   !! $Id: trcini.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE trc_init
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_init  ***
+      !!
+      !! ** Purpose :   Initialization of the passive tracer fields 
+      !!
+      !! ** Method  : - read namelist
+      !!              - control the consistancy 
+      !!              - compute specific initialisations
+      !!              - set initial tracer fields (either read restart 
+      !!                or read data or analytical formulation
+      !!---------------------------------------------------------------------
+      INTEGER ::   jk, jn, jl    ! dummy loop indices
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_init')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      CALL top_alloc()              ! allocate TOP arrays
+
+      IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    &
+         &  CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' )
+
+      IF( nn_cla == 1 )   &
+         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
+
+      CALL trc_nam                  ! read passive tracers namelists
+      !
+      IF(lwp) WRITE(numout,*)
+      IF( ln_rsttr ) THEN
+        !
+        IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog)
+        CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar
+        !
+      ELSE
+        IF( lk_offline )  THEN
+           neuler = 0                  ! Set time-step indicator at nit000 (euler)
+           CALL day_init               ! set calendar
+        ENDIF
+        !
+      ENDIF
+      IF(lwp) WRITE(numout,*)
+                                                              ! masked grid volume
+      if(lwp) write(numout,*) 'jpi = ', jpi, '  jpj = ', jpj, ' jpk = ', jpk
+      IF(lwp) WRITE(numout,*)
+      !                                                              ! masked grid volume
+      DO jk = 1, jpk
+         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
+      END DO
+      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol
+      !                                                              ! total volume of the ocean 
+      areatot = glob_sum( cvol(:,:,:) )
+      IF(lwp) WRITE(numout,*) 'lk_my_trc = ', lk_my_trc
+      IF( lk_lobster )       CALL trc_ini_lobster      ! LOBSTER bio-model
+      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
+      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
+      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
+      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
+      
+      trn(:,:,:,1) = tsn_crs(:,:,:,jp_sal)
+
+      IF( lwp ) THEN
+         !
+         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+      ENDIF
+
+      IF( ln_trcdta )      CALL trc_dta_init
+
+
+      IF( ln_rsttr ) THEN
+        !
+        CALL trc_rst_read              ! restart from a file
+        !
+      ELSE
+        !
+        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
+            !
+            CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation
+            !
+            CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000
+            !
+            DO jn = 1, jptra
+               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
+                  jl = n_trc_index(jn) 
+                  trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * tmask(:,:,:)  
+               ENDIF
+            ENDDO
+            CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )
+        ENDIF
+        !
+        trb(:,:,:,:) = trn(:,:,:,:)
+        ! 
+      ENDIF
+ 
+      tra(:,:,:,:) = 0._wp
+      
+      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive
+        &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level
+
+      !
+      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
+      !
+
+      trai(:) = 0._wp                                                   ! initial content of all tracers
+      DO jn = 1, jptra
+         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
+      END DO
+
+      IF(lwp) THEN               ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)
+         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
+         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
+         WRITE(numout,*) '          *** Total inital content of all tracers '
+         WRITE(numout,*)
+         DO jn = 1, jptra
+            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
+         ENDDO
+         WRITE(numout,*)
+      ENDIF
+      IF(lwp) WRITE(numout,*)
+      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
+         CALL prt_ctl_trc_init
+         WRITE(charout, FMT="('ini ')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
+      !
+   END SUBROUTINE trc_init
+
+
+   SUBROUTINE top_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE top_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!----------------------------------------------------------------------
+      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines...
+      USE trc           , ONLY:   trc_alloc
+      USE trcnxt        , ONLY:   trc_nxt_alloc
+      USE trczdf        , ONLY:   trc_zdf_alloc
+      USE trdmod_trc_oce, ONLY:   trd_mod_trc_oce_alloc
+#if defined key_trdmld_trc 
+      USE trdmld_trc    , ONLY:   trd_mld_trc_alloc
+#endif
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines...
+      ierr = ierr + trc_alloc    ()
+      ierr = ierr + trc_nxt_alloc()
+      ierr = ierr + trc_zdf_alloc()
+      ierr = ierr + trd_mod_trc_oce_alloc()
+#if defined key_trdmld_trc 
+      ierr = ierr + trd_mld_trc_alloc()
+#endif
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE top_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_init                      ! Dummy routine   
+   END SUBROUTINE trc_init
+#endif
+
+   !!======================================================================
+END MODULE trcini
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcini_my_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcini_my_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcini_my_trc.F90	(revision 4056)
@@ -0,0 +1,68 @@
+MODULE trcini_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcini_my_trc  ***
+   !! TOP :   initialisation of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ini_my_trc   : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE trcsms_my_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_my_trc   ! called by trcini.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcini_my_trc.F90 3897 2013-05-02 14:29:49Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_my_trc  ***  
+      !!
+      !! ** Purpose :   initialization for MY_TRC model
+      !!
+      !! ** Method  : - Read the namcfc namelist and check the parameter values
+      !!----------------------------------------------------------------------
+      INTEGER :: jn
+      !                       ! Allocate MY_TRC arrays
+      IF( trc_sms_my_trc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: initialisation of MY_TRC model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) 'ln_rsttr ', ln_rsttr
+      IF( .NOT. ln_rsttr ) THEN
+
+         DO jn=jp_myt0,jp_myt1
+            trn(:,:,:,jn) = 35.50 * tmask(:,:,:)
+             
+         ENDDO
+      ENDIF
+      !
+
+   END SUBROUTINE trc_ini_my_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_my_trc             ! Empty routine
+   END SUBROUTINE trc_ini_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcini_my_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcldf.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcldf.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcldf.F90	(revision 4056)
@@ -0,0 +1,276 @@
+MODULE trcldf
+   !!======================================================================
+   !!                       ***  MODULE  trcldf  ***
+   !! Ocean Passive tracers : lateral diffusive trends
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE ldfslp          ! ???
+   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
+   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine)
+   USE traldf_iso_crs      ! lateral mixing            (tra_ldf_iso routine)
+   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
+   USE traldf_lap_crs      ! lateral mixing            (tra_ldf_lap routine)
+   USE trdmod_oce
+   USE trdtra
+   USE prtctl_trc      ! Print control
+   USE crs
+   
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ldf    ! called by step.F90
+   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient
+   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcldf.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ldf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf  ***
+      !!
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER            :: jn
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_ldf')
+      !
+      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options
+
+      rldf = rldf_rat
+
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+      WRITE(numout,*) 'nldf', nldf
+      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )   ;   CALL tra_ldf_lap_crs   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian
+      CASE ( 1 )                                                                                            ! rotated laplacian
+                       IF( ln_traldf_grif ) THEN
+                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+                       ELSE
+                          CALL tra_ldf_iso_crs     ( kt, nittrc000, 'TRC', gtsu_crs, gtsv_crs, trb, tra, jptra, rn_ahtb_0 )
+                       ENDIF
+      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian
+         !
+      CASE ( -1 )                                     ! esopa: test all possibility with control print
+         CALL tra_ldf_lap_crs   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         IF( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+         ELSE
+            CALL tra_ldf_iso_crs     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+         ENDIF
+         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END SELECT
+      !
+      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf')
+      !
+   END SUBROUTINE trc_ldf
+
+
+   SUBROUTINE ldf_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_ctl  ***
+      !!
+      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !!
+      !! ** Method  :   set nldf from the namtra_ldf logicals
+      !!      nldf == -2   No lateral diffusion
+      !!      nldf == -1   ESOPA test: ALL operators are used
+      !!      nldf ==  0   laplacian operator
+      !!      nldf ==  1   Rotated laplacian operator
+      !!      nldf ==  2   bilaplacian operator
+      !!      nldf ==  3   Rotated bilaplacian
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
+       !  IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN  !! cc
+       !     rldf_rat = 1.0_wp
+       !  ELSE
+       !     CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
+       !  END IF
+          rldf_rat = 1.0_wp !!cc
+      ELSE
+         rldf_rat = rn_ahtrc_0 / rn_aht_0
+      END IF
+      !  Define the lateral mixing oparator for tracers
+      ! ===============================================
+
+      !                               ! control the input
+      ioptio = 0
+      IF( ln_trcldf_lap   )   ioptio = ioptio + 1
+      IF( ln_trcldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
+      ioptio = 0
+      IF( ln_trcldf_level )   ioptio = ioptio + 1
+      IF( ln_trcldf_hor   )   ioptio = ioptio + 1
+      IF( ln_trcldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+
+      ! defined the type of lateral diffusion from ln_trcldf_... logicals
+      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
+      ierr = 0
+      IF( ln_trcldf_lap ) THEN       ! laplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
+      IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   &
+           CALL ctl_stop( '          eddy induced velocity on tracers',   &
+           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
+         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
+#if defined key_offline
+         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
+#endif
+      ENDIF
+
+      IF( lk_esopa ) THEN
+         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
+         nldf = -1
+      ENDIF
+
+      IF( .NOT. ln_trcldf_diff ) THEN
+         IF(lwp) WRITE(numout,*) '          No lateral diffusion on passive tracers'
+         nldf = -2
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
+         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
+         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
+         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
+      ENDIF
+
+      IF( ln_trcldf_bilap ) THEN
+         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
+         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' )
+      ELSE
+         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
+         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' )
+      ENDIF
+
+      ! ratio between active and passive tracers diffusive coef.
+      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
+       !  IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN   !!cc
+       !     rldf_rat = 1.0_wp
+       !  ELSE
+       !     CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
+       !  END IF
+          rldf_rat = 1.0_wp   !!cc
+      ELSE
+         rldf_rat = rn_ahtrc_0 / rn_aht_0
+      END IF
+      IF( rldf_rat < 0 ) THEN
+         IF( .NOT.lk_offline ) THEN 
+            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' )
+         ELSE
+            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' )
+         ENDIF 
+      ENDIF
+      !
+   END SUBROUTINE ldf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf
+#endif
+   !!======================================================================
+END MODULE trcldf
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnam.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnam.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnam.F90	(revision 4056)
@@ -0,0 +1,272 @@
+MODULE trcnam
+   !!======================================================================
+   !!                       ***  MODULE trcnam  ***
+   !! TOP :   Read and print options for the passive tracer run (namelist)
+   !!======================================================================
+   !! History :    -   !  1996-11  (M.A. Foujols, M. Levy)  original code
+   !!              -   !  1998-04  (M.A Foujols, L. Bopp) ahtrb0 for isopycnal mixing
+   !!              -   !  1999-10  (M.A. Foujols, M. Levy) separation of sms
+   !!              -   !  2000-07  (A. Estublier) add TVD and MUSCL : Tests on ndttrc
+   !!              -   !  2000-11  (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0
+   !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes
+   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_nam    :  Read and print options for the passive tracer run (namelist)
+   !!----------------------------------------------------------------------
+   USE oce_trc           ! shared variables between ocean and passive tracers
+   USE trc               ! passive tracers common variables
+   USE trcnam_trp        ! Transport namelist
+   USE trcnam_lobster    ! LOBSTER namelist
+   USE trcnam_pisces     ! PISCES namelist
+   USE trcnam_cfc        ! CFC SMS namelist
+   USE trcnam_c14b       ! C14 SMS namelist
+   USE trcnam_my_trc     ! MY_TRC SMS namelist
+   USE trdmod_oce       
+   USE trdmod_trc_oce
+   USE iom               ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE 
+
+   PUBLIC trc_nam      ! called in trcini
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcnam.F90 3319 2012-03-05 16:03:27Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam  ***
+      !!
+      !! ** Purpose :   READ and PRINT options for the passive tracer run (namelist) 
+      !!
+      !! ** Method  : - read passive tracer namelist 
+      !!              - read namelist of each defined SMS model
+      !!                ( (LOBSTER, PISCES, CFC, MY_TRC )
+      !!---------------------------------------------------------------------
+      INTEGER ::  jn, ierr
+      ! Definition of a tracer as a structure
+      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput
+      !!
+      NAMELIST/namtrc/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, &
+         &             cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta, ln_trcdmp
+#if defined key_trdmld_trc  || defined key_trdtrc
+      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
+         &                ln_trdmld_trc_restart, ln_trdmld_trc_instant, &
+         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
+#endif
+      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio
+
+      !!---------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      CALL ctl_opn( numnat, 'namelist_top', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
+
+      ! Namelist nattrc (files)
+      ! ----------------------------------------------
+      nn_dttrc      = 1                 ! default values
+      nn_writetrc   = 10 
+      ln_rsttr      = .FALSE.
+      nn_rsttr      =  0
+      cn_trcrst_in  = 'restart_trc'
+      cn_trcrst_out = 'restart_trc'
+      !
+      DO jn = 1, jptra
+         WRITE( sn_tracer(jn)%clsname,'("TR_",I1)'           ) jn
+         WRITE( sn_tracer(jn)%cllname,'("TRACER NUMBER ",I1)') jn
+         sn_tracer(jn)%clunit  = 'mmole/m3'
+         sn_tracer(jn)%llinit  = .FALSE.
+         sn_tracer(jn)%llsave  = .TRUE.
+      END DO
+      ln_trcdta = .FALSE.
+      ln_trcdmp = .FALSE.
+
+
+      REWIND( numnat )               ! read nattrc
+      READ  ( numnat, namtrc )
+
+      DO jn = 1, jptra
+         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname )
+         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname )
+         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  )
+         ln_trc_ini(jn) =       sn_tracer(jn)%llinit
+         ln_trc_wri(jn) =       sn_tracer(jn)%llsave
+      END DO
+
+      !!KPE  computes the first time step of tracer model
+      nittrc000 = nit000 + nn_dttrc - 1
+ 
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namtrc'
+         WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc
+         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr
+         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr
+         WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000
+         WRITE(numout,*) '   frequency of outputs for passive tracers     nn_writetrc   = ', nn_writetrc  
+         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta
+         WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp
+         WRITE(numout,*) ' '
+         DO jn = 1, jptra
+            WRITE(numout,*) '  tracer nb : ', jn, '    short name : ', ctrcnm(jn)
+         END DO
+         WRITE(numout,*) ' '
+      ENDIF
+
+      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step
+  
+      IF(lwp) THEN                   ! control print
+        WRITE(numout,*) 
+        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1)
+        WRITE(numout,*) 
+      ENDIF
+
+      ln_diatrc = .FALSE.
+      ln_diabio = .FALSE.
+      nn_writedia = 10
+      nn_writebio = 10
+
+      REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic
+      READ  ( numnat, namtrc_dia )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namtrc_dia'
+         WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc
+         WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio
+         WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia
+         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio
+         WRITE(numout,*) ' '
+      ENDIF
+
+      IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
+         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  &
+           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  & 
+           &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr ) 
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' )
+      ENDIF
+
+      IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN
+         ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , &
+           &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr ) 
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' )
+      ENDIF
+
+      ! namelist of transport
+      ! ---------------------
+      CALL trc_nam_trp
+
+
+      IF( ln_trcdmp .AND. .NOT.ln_trcdta ) THEN
+         CALL ctl_warn( 'trc_nam: passive tracer damping requires data from files we set ln_trcdta to TRUE' )
+         ln_trcdta = .TRUE.
+      ENDIF
+      !
+      IF( ln_rsttr .AND. .NOT.ln_trcdmp .AND. ln_trcdta ) THEN
+          CALL ctl_warn( 'trc_nam: passive tracer restart and  data intialisation, ',   &
+             &           'we keep the restart values and set ln_trcdta to FALSE' )
+         ln_trcdta = .FALSE.
+      ENDIF
+      !
+      IF( .NOT.ln_trcdta ) THEN
+         ln_trc_ini(:) = .FALSE.
+      ENDIF
+
+      IF(lwp) THEN                   ! control print
+         IF( ln_rsttr ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '    read a restart file for passive tracer : ', TRIM( cn_trcrst_in )
+            WRITE(numout,*)
+         ELSE
+            IF( .NOT.ln_trcdta ) THEN
+                WRITE(numout,*)
+                WRITE(numout,*) '  All the passive tracers are initialised with constant values '
+                WRITE(numout,*)
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+#if defined key_trdmld_trc || defined key_trdtrc
+         nn_trd_trc  = 20
+         nn_ctls_trc =  9
+         rn_ucf_trc   =  1.
+         ln_trdmld_trc_instant = .TRUE.
+         ln_trdmld_trc_restart =.FALSE.
+         cn_trdrst_trc_in  = "restart_mld_trc"
+         cn_trdrst_trc_out = "restart_mld_trc"
+         ln_trdtrc(:) = .FALSE.
+
+         REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic
+         READ  ( numnat, namtrc_trd )
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    '
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               '
+            WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc
+            WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc
+            WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart
+            WRITE(numout,*) '   * flag to diagnose trends of                                 '
+            WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant
+            WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc
+            DO jn = 1, jptra
+               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn
+            END DO
+         ENDIF
+#endif
+
+
+      ! namelist of SMS
+      ! ---------------      
+      IF( lk_lobster ) THEN   ;   CALL trc_nam_lobster      ! LOBSTER bio-model
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          LOBSTER not used'
+      ENDIF
+
+      IF( lk_pisces  ) THEN   ;   CALL trc_nam_pisces      ! PISCES  bio-model
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
+      ENDIF
+
+      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
+      ENDIF
+
+      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
+      ENDIF
+
+      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
+      ENDIF
+      !
+   END SUBROUTINE trc_nam
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam                      ! Empty routine   
+   END SUBROUTINE trc_nam
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcnam.F90 3319 2012-03-05 16:03:27Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE  trcnam
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnam_my_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnam_my_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnam_my_trc.F90	(revision 4056)
@@ -0,0 +1,55 @@
+MODULE trcnam_my_trc
+   !!======================================================================
+   !!                      ***  MODULE trcnam_my_trc  ***
+   !! TOP :   initialisation of some run parameters for LOBSTER bio-model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'   :                                       MY_TRC model
+   !!----------------------------------------------------------------------
+   !! trc_nam_my_trc      : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_my_trc   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcnam_my_trc.F90 3897 2013-05-02 14:29:49Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_my_trc  ***  
+      !!
+      !! ** Purpose :   read MY_TRC namelist
+      !!
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_my_trc : read MY_TRC namelists'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+      !
+   END SUBROUTINE trc_nam_my_trc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                             No MY_TRC
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_my_trc                      ! Empty routine
+   END  SUBROUTINE  trc_nam_my_trc
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_my_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnxt.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnxt.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcnxt.F90	(revision 4056)
@@ -0,0 +1,194 @@
+MODULE trcnxt
+   !!======================================================================
+   !!                       ***  MODULE  trcnxt  ***
+   !! Ocean passive tracers:  time stepping on passives tracers
+   !!======================================================================
+   !! History :  7.0  !  1991-11  (G. Madec)  Original code
+   !!                 !  1993-03  (M. Guyon)  symetrical conditions
+   !!                 !  1995-02  (M. Levy)   passive tracers
+   !!                 !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
+   !!            8.0  !  1996-04  (A. Weaver)  Euler forward step
+   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!                 !  2002-08  (G. Madec)  F90: Free form and module
+   !!                 !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
+   !!                 !  2004-03  (C. Ethe) passive tracers
+   !!                 !  2007-02  (C. Deltel) Diagnose ML trends for passive tracers
+   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
+   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
+   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_nxt     : time stepping on passive tracers
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl_trc      ! Print control for debbuging
+   USE trdmod_oce
+   USE trdtra
+   USE tranxt_crs
+   USE tranxt
+# if defined key_agrif
+   USE agrif_top_update
+   USE agrif_top_interp
+# endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nxt          ! routine called by step.F90
+   PUBLIC   trc_nxt_alloc    ! routine called by nemogcm.F90
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcnxt.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_nxt_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_nxt_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc )
+      !
+      IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array')
+      !
+   END FUNCTION trc_nxt_alloc
+
+
+   SUBROUTINE trc_nxt( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trcnxt  ***
+      !!
+      !! ** Purpose :   Compute the passive tracers fields at the 
+      !!      next time-step from their temporal trends and swap the fields.
+      !! 
+      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through 
+      !!      call to lbc_lnk routine
+      !!   default:
+      !!      arrays swap
+      !!         (trn) = (tra) ; (tra) = (0,0)
+      !!         (trb) = (trn) 
+      !!
+      !!   For Arakawa or TVD Scheme : 
+      !!      A Asselin time filter applied on now tracers (trn) to avoid
+      !!      the divergence of two consecutive time-steps and tr arrays
+      !!      to prepare the next time_step:
+      !!         (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]
+      !!         (trn) = (tra) ; (tra) = (0,0)
+      !!
+      !!
+      !! ** Action  : - update trb, trn
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+      !
+      INTEGER  ::   jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! temporary scalar
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrdt 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_nxt')
+      !
+      IF( kt == nittrc000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
+      ENDIF
+     WRITE(numout,*) 'test64_tra', tra(10,10,1,1)
+      ! Update after tracer on domain lateral boundaries
+      DO jn = 1, jptra
+         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
+      END DO
+     WRITE(numout,*) 'test65_tra', tra(10,10,1,1)
+
+#if defined key_obc
+!!      CALL obc_trc( kt )               ! OBC open boundaries
+#endif
+#if defined key_bdy
+!!      CALL bdy_trc( kt )               ! BDY open boundaries
+#endif
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
+
+
+      ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler)
+      ELSEIF( kt <= nittrc000 + 1 )            THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
+      ENDIF
+
+      ! trends computation initialisation
+            WRITE(numout,*) 'test1', trn(10,10,1,1)
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )  !* store now fields before applying the Asselin filter
+         ztrdt(:,:,:,:)  = trn(:,:,:,:)
+      ENDIF
+      ! Leap-Frog + Asselin filter time stepping
+      WRITE(numout,*) 'test63', trn(10,10,1,1)
+
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step
+         !                                                ! (only swap)
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               trn(:,:,jk,jn) = tra(:,:,jk,jn)
+            END DO
+         END DO
+         !         
+         WRITE(numout,*) 'test64', trn(10,10,1,1)
+                                   
+      ELSE
+                  WRITE(numout,*) 'test66', trn(10,10,1,1)
+         ! Leap-Frog + Asselin filter time stepping
+         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl) 
+         ELSE                ;   CALL tra_nxt_fix_crs( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
+         ENDIF
+      ENDIF
+      WRITE(numout,*) 'test2', trn(10,10,1,1)
+#if defined key_agrif
+      ! Update tracer at AGRIF zoom boundaries
+      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Trc( kt )      ! children only
+#endif      
+
+      ! trends computation
+      IF( l_trdtrc ) THEN                                      ! trends
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               zfact = 1.e0 / r2dt(jk)  
+               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_atf, ztrdt )
+            END DO
+         END DO
+         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt ) 
+      ENDIF
+      !
+      WRITE(numout,*) 'test3', trn(10,10,1,1)
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('nxt')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_nxt')
+      !
+   END SUBROUTINE trc_nxt
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nxt( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_nxt: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_nxt
+#endif
+   !!======================================================================
+END MODULE trcnxt
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcrst.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcrst.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcrst.F90	(revision 4056)
@@ -0,0 +1,332 @@
+MODULE trcrst
+   !!======================================================================
+   !!                         ***  MODULE trcrst  ***
+   !! TOP :   Manage the passive tracer restart
+   !!======================================================================
+   !! History :    -   !  1991-03  ()  original code
+   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!              -   !  2005-10 (C. Ethe) print control
+   !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_rst :   Restart for passive tracer
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_rst_opn    : open  restart file
+   !!   trc_rst_read   : read  restart file
+   !!   trc_rst_wri    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc
+   USE trc
+   USE trcnam_trp
+   USE iom
+   USE trcrst_cfc      ! CFC      
+   USE trcrst_lobster  ! LOBSTER  restart
+   USE trcrst_pisces   ! PISCES   restart
+   USE trcrst_c14b     ! C14 bomb restart
+   USE trcrst_my_trc   ! MY_TRC   restart
+   USE daymod
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_rst_opn       ! called by ???
+   PUBLIC   trc_rst_read      ! called by ???
+   PUBLIC   trc_rst_wri       ! called by ???
+   PUBLIC   trc_rst_cal
+
+   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write)
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   
+CONTAINS
+   
+   SUBROUTINE trc_rst_opn( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_opn  ***
+      !!
+      !! ** purpose  :   output of sea-trc 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   ! trc output restart file name
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_offline ) THEN
+         IF( kt == nittrc000 ) THEN
+            lrst_trc = .FALSE.
+            nitrst = nitend
+         ENDIF
+
+         IF( MOD( kt - 1, nstock ) == 0 ) THEN
+            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
+            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
+            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
+         ENDIF
+      ELSE
+         IF( kt == nittrc000 ) lrst_trc = .FALSE.
+      ENDIF
+
+      ! to get better performances with NetCDF format:
+      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
+      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1
+      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
+         ! beware of the format used to write kt (default is i8.8, that should be large enough)
+         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
+         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
+         ENDIF
+         ! create the file
+         IF(lwp) WRITE(numout,*)
+         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
+         IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname
+         CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib )
+         lrst_trc = .TRUE.
+      ENDIF
+      !
+   END SUBROUTINE trc_rst_opn
+
+   SUBROUTINE trc_rst_read
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_opn  ***
+      !!
+      !! ** purpose  :   read passive tracer fields in restart files
+      !!----------------------------------------------------------------------
+      INTEGER  ::  jn     
+
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+      ! READ prognostic variables and computes diagnostic variable
+      DO jn = 1, jptra
+         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
+      END DO
+
+      DO jn = 1, jptra
+         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
+      END DO
+
+      IF( lk_lobster )   CALL trc_rst_read_lobster( numrtr )      ! LOBSTER bio-model
+      IF( lk_pisces  )   CALL trc_rst_read_pisces ( numrtr )      ! PISCES  bio-model
+      IF( lk_cfc     )   CALL trc_rst_read_cfc    ( numrtr )      ! CFC     tracers
+      IF( lk_c14b    )   CALL trc_rst_read_c14b   ( numrtr )      ! C14 bomb  tracer
+      IF( lk_my_trc  )   CALL trc_rst_read_my_trc ( numrtr )      ! MY_TRC  tracers
+
+      CALL iom_close( numrtr )
+      !
+   END SUBROUTINE trc_rst_read
+
+   SUBROUTINE trc_rst_wri( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_wri  ***
+      !!
+      !! ** purpose  :   write passive tracer fields in restart files
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  :: jn
+      REAL(wp) :: zarak0
+      !!----------------------------------------------------------------------
+      !
+      CALL trc_rst_cal( kt, 'WRITE' )   ! calendar
+      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
+      ! prognostic variables 
+      ! -------------------- 
+      DO jn = 1, jptra
+         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
+      END DO
+
+      DO jn = 1, jptra
+         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
+      END DO
+
+      IF( lk_lobster )   CALL trc_rst_wri_lobster( kt, nitrst, numrtw )      ! LOBSTER bio-model
+      IF( lk_pisces  )   CALL trc_rst_wri_pisces ( kt, nitrst, numrtw )      ! PISCES  bio-model
+      IF( lk_cfc     )   CALL trc_rst_wri_cfc    ( kt, nitrst, numrtw )      ! CFC     tracers
+      IF( lk_c14b    )   CALL trc_rst_wri_c14b   ( kt, nitrst, numrtw )      ! C14 bomb  tracer
+      IF( lk_my_trc  )   CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw )      ! MY_TRC  tracers
+
+      IF( kt == nitrst ) THEN
+          CALL trc_rst_stat            ! statistics
+          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
+#if ! defined key_trdmld_trc
+          lrst_trc = .FALSE.
+#endif
+      ENDIF
+      !
+   END SUBROUTINE trc_rst_wri 
+
+
+   SUBROUTINE trc_rst_cal( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_rst_cal  ***
+      !!
+      !!  ** Purpose : Read or write calendar in restart file:
+      !!
+      !!  WRITE(READ) mode:
+      !!       kt        : number of time step since the begining of the experiment at the
+      !!                   end of the current(previous) run
+      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
+      !!                   end of the current(previous) run (REAL -> keep fractions of day)
+      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
+      !!
+      !!   According to namelist parameter nrstdt,
+      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
+      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
+      !!                   time step of previous run + 1.
+      !!       In both those options, the  exact duration of the experiment
+      !!       since the beginning (cumulated duration of all previous restart runs)
+      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
+      !!       This is valid is the time step has remained constant.
+      !!
+      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
+      !!                    has been stored in the restart file.
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      INTEGER  ::  jlibalt = jprstlib
+      LOGICAL  ::  llok
+      REAL(wp) ::  zkt, zrdttrc1
+      REAL(wp) ::  zndastp
+
+      ! Time domain : restart
+      ! ---------------------
+
+      IF( TRIM(cdrw) == 'READ' ) THEN
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+         IF ( jprstlib == jprstdimg ) THEN
+           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
+           INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
+           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+         ENDIF
+
+         CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )
+
+         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
+         IF(lwp) THEN
+            WRITE(numout,*) ' *** Info read in restart : '
+            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+            WRITE(numout,*) ' *** restart option'
+            SELECT CASE ( nn_rsttr )
+            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
+            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
+            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
+            END SELECT
+            WRITE(numout,*)
+         ENDIF
+         ! Control of date 
+         IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
+            &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
+            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
+         IF( lk_offline ) THEN      ! set the date in offline mode
+            ! Check dynamics and tracer time-step consistency and force Euler restart if changed
+            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN
+               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 )
+               IF( zrdttrc1 /= rdttrc(1) )   neuler = 0
+            ENDIF
+            !                          ! define ndastp and adatrj
+            IF ( nn_rsttr == 2 ) THEN
+               CALL iom_get( numrtr, 'ndastp', zndastp ) 
+               ndastp = NINT( zndastp )
+               CALL iom_get( numrtr, 'adatrj', adatrj  )
+            ELSE
+               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
+               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
+               ! note this is wrong if time step has changed during run
+            ENDIF
+            !
+            IF(lwp) THEN
+              WRITE(numout,*) ' *** Info used values : '
+              WRITE(numout,*) '   date ndastp                                      : ', ndastp
+              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
+              WRITE(numout,*)
+            ENDIF
+            !
+            CALL day_init          ! compute calendar
+            !
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         !
+         IF(  kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
+         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
+         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
+         !                                                                     ! the begining of the run [s]
+      ENDIF
+
+   END SUBROUTINE trc_rst_cal
+
+
+   SUBROUTINE trc_rst_stat
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_stat  ***
+      !!
+      !! ** purpose  :   Compute tracers statistics
+      !!----------------------------------------------------------------------
+      INTEGER  :: jk, jn
+      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
+      !!----------------------------------------------------------------------
+
+      IF( lwp ) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) '           ----TRACER STAT----             '
+         WRITE(numout,*) 
+      ENDIF
+      !
+      DO jn = 1, jptra
+         ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
+         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
+         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
+         IF( lk_mpp ) THEN
+            CALL mpp_min( zmin )      ! min over the global domain
+            CALL mpp_max( zmax )      ! max over the global domain
+         END IF
+         zmean  = ztraf / areatot
+         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
+         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
+      END DO
+      WRITE(numout,*) 
+9000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
+      &      '    max :',e18.10,'    drift :',e18.10, ' %')
+      !
+   END SUBROUTINE trc_rst_stat
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read                      ! Empty routines
+   END SUBROUTINE trc_rst_read
+   SUBROUTINE trc_rst_wri( kt )
+      INTEGER, INTENT ( in ) :: kt
+      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_rst_wri   
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcrst.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcrst
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcrst_my_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcrst_my_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcrst_my_trc.F90	(revision 4056)
@@ -0,0 +1,51 @@
+MODULE trcrst_my_trc
+   !!======================================================================
+   !!                       ***  MODULE trcrst_my_trc  ***
+   !! TOP :   create, write, read the restart files of MY_TRC tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe)  Original
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_my_trc   : read  restart file
+   !!   trc_rst_wri_my_trc    : write restart file
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_my_trc   ! called by trcini.F90 module
+   PUBLIC  trc_rst_wri_my_trc   ! called by trcini.F90 module
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_my_trc( knum ) 
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_read_my_trc: No specific variables to read on unit', knum
+   END SUBROUTINE trc_rst_read_my_trc
+
+   SUBROUTINE trc_rst_wri_my_trc( kt, kirst, knum )
+     INTEGER, INTENT(in)  :: kt, kirst, knum
+     WRITE(*,*) 'trc_rst_wri_my_trc: No specific variables to write on unit' ,knum, ' at time ', kt, kirst
+   END SUBROUTINE trc_rst_wri_my_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_my_trc( knum )
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_read_my_trc: You should not have seen this print! error?', knum
+   END SUBROUTINE trc_rst_read_my_trc
+
+   SUBROUTINE trc_rst_wri_my_trc( kt, kirst, knum )
+     INTEGER, INTENT(in)  :: kt, kirst, knum
+     WRITE(*,*) 'trc_rst_wri_my_trc: You should not have seen this print! error?', kt, kirst, knum
+   END SUBROUTINE trc_rst_wri_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcrst_my_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsbc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsbc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsbc.F90	(revision 4056)
@@ -0,0 +1,138 @@
+MODULE trcsbc
+   !!==============================================================================
+   !!                       ***  MODULE  trcsbc  ***
+   !! Ocean passive tracers:  surface boundary condition
+   !!======================================================================
+   !! History :  8.2  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
+   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            9.0  !  2004-03  (C. Ethe)  adapted for passive tracers
+   !!                 !  2006-08  (C. Deltel) Diagnose ML trends for passive tracers
+   !!==============================================================================
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_sbc      : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean  passive tracers variables
+   USE prtctl_trc      ! Print control for debbuging
+   USE trdmod_oce
+   USE trdtra
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sbc   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcsbc.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sbc ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sbc  ***
+      !!                   
+      !! ** Purpose :   Compute the tracer surface boundary condition trend of
+      !!      (concentration/dilution effect) and add it to the general 
+      !!       trend of tracer equations.
+      !!
+      !! ** Method :
+      !!      * concentration/dilution effect:
+      !!            The surface freshwater flux modify the ocean volume
+      !!         and thus the concentration of a tracer as :
+      !!            tra = tra + emp * trn / e3t   for k=1
+      !!         where emp, the surface freshwater budget (evaporation minus
+      !!         precipitation minus runoff) given in kg/m2/s is divided
+      !!         by 1035 kg/m3 (density of ocean water) to obtain m/s.
+      !!
+      !! ** Action  : - Update the 1st level of tra with the trend associated
+      !!                with the tracer surface boundary condition 
+      !!
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jn           ! dummy loop indices
+      REAL(wp) ::   zsrau, zse3t   ! temporary scalars
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zemps
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sbc')
+      !
+      ! Allocate temporary workspace
+                      CALL wrk_alloc( jpi, jpj,      zemps  )
+      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf
+         zemps(:,:) = emps(:,:)  
+      ELSE                           ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff
+         IF( lk_vvl ) THEN                      ! volume variable
+            zemps(:,:) = emps(:,:) - emp(:,:)   
+!!ch         zemps(:,:) = 0.
+         ELSE                                   ! linear free surface
+            IF( ln_rnf ) THEN  ;  zemps(:,:) = emps(:,:) - rnf(:,:)   !  E-P-R
+            ELSE               ;  zemps(:,:) = emps(:,:)
+            ENDIF 
+         ENDIF 
+      ENDIF 
+
+      ! 0. initialization
+      zsrau = 1. / rau0
+      DO jn = 1, jptra
+         !
+         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
+         !                                             ! add the trend to the general tracer trend
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zse3t = 1. / e3t_crs(ji,jj,1)
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zemps(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t
+            END DO
+         END DO
+         
+         IF( l_trdtrc ) THEN
+            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd )
+         END IF
+         !                                                       ! ===========
+      END DO                                                     ! tracer loop
+      !                                                          ! ===========
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+                      CALL wrk_dealloc( jpi, jpj,      zemps  )
+      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc')
+      !
+   END SUBROUTINE trc_sbc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      NO passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sbc (kt)              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sbc
+#endif
+   
+   !!======================================================================
+END MODULE trcsbc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsms.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsms.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsms.F90	(revision 4056)
@@ -0,0 +1,79 @@
+MODULE trcsms
+   !!======================================================================
+   !!                         ***  MODULE trcsms  ***
+   !! TOP :   Time loop of passive tracers sms
+   !!======================================================================
+   !! History :   1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_sms        :  Time loop of passive tracers sms
+   !!----------------------------------------------------------------------
+   USE oce_trc            !
+   USE trc                !
+   USE trcsms_lobster     ! LOBSTER bio-model
+   USE trcsms_pisces      ! PISCES biogeo-model
+   USE trcsms_cfc         ! CFC 11 & 12
+   USE trcsms_c14b        ! C14b tracer 
+   USE trcsms_my_trc      ! MY_TRC  tracers
+   USE prtctl_trc         ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms    ! called in trcstp.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcsms.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms  ***
+      !!
+      !! ** Purpose :   Managment of the time loop of passive tracers sms 
+      !!
+      !! ** Method  : -  call the main routine of of each defined tracer model
+      !! -------------------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_sms')
+      !
+      IF( lk_lobster )   CALL trc_sms_lobster( kt )    ! main program of LOBSTER
+      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES 
+      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC
+      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14
+      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers
+
+      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('sms ')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_sms')
+      !
+   END SUBROUTINE trc_sms
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                     No passive tracer
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_sms( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms
+#endif 
+
+   !!======================================================================
+END MODULE  trcsms
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsms_my_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsms_my_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsms_my_trc.F90	(revision 4056)
@@ -0,0 +1,88 @@
+MODULE trcsms_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcsms_my_trc  ***
+   !! TOP :   Main module of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_sms_my_trc       : MY_TRC model main routine
+   !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+   USE trdmod_oce
+   USE trdmod_trc
+
+   IMPLICIT NONE
+
+   PUBLIC   trc_sms_my_trc       ! called by trcsms.F90 module
+   PUBLIC   trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module
+
+   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcsms_my_trc.F90 3897 2013-05-02 14:29:49Z cetlod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_my_trc( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_sms_my_trc  ***
+      !!
+      !! ** Purpose :   main routine of MY_TRC model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER :: jk, jn   ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_my_trc')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_sms_my_trc:  MY_TRC model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_my_trc')
+      !
+   END SUBROUTINE trc_sms_my_trc
+
+
+   INTEGER FUNCTION trc_sms_my_trc_alloc()
+      !!----------------------------------------------------------------------
+      !!              ***  ROUTINE trc_sms_my_trc_alloc  ***
+      !!----------------------------------------------------------------------
+      !
+      ! ALLOCATE here the arrays specific to MY_TRC
+      ! ALLOCATE( tab(...) , STAT=trc_sms_my_trc_alloc )
+      trc_sms_my_trc_alloc = 0      ! set to zero if no array to be allocated
+      !
+      IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_warn('trc_sms_my_trc_alloc : failed to allocate arrays')
+      !
+   END FUNCTION trc_sms_my_trc_alloc
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_my_trc( kt )             ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms_my_trc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcsms_my_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcstp.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcstp.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcstp.F90	(revision 4056)
@@ -0,0 +1,126 @@
+MODULE trcstp
+   !!======================================================================
+   !!                       ***  MODULE trcstp  ***
+   !! Time-stepping    : time loop of opa for passive tracer
+   !!======================================================================
+   !! History :  1.0  !  2004-03  (C. Ethe)  Original
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   trc_stp      : passive tracer system time-stepping
+   !!----------------------------------------------------------------------
+   USE oce_trc          ! ocean dynamics and active tracers variables
+   USE trc
+   USE trctrp           ! passive tracers transport
+   USE trcsms           ! passive tracers sources and sinks
+   USE prtctl_trc       ! Print control for debbuging
+   USE trcdia
+   USE trcwri
+   USE trcrst
+   USE trdmod_trc_oce
+   USE trdmld_trc
+   USE iom
+   USE in_out_manager
+   USE trcsub
+   USE crs
+   
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_stp    ! called by step
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcstp.F90 3319 2012-03-05 16:03:27Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_stp( kt )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_stp  ***
+      !!                      
+      !! ** Purpose : Time loop of opa for passive tracer
+      !! 
+      !! ** Method  : 
+      !!              Compute the passive tracers trends 
+      !!              Update the passive tracers
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
+      INTEGER               ::  jk,ji,jj, jn  ! dummy loop indices
+      REAL(wp)              ::  ztrai
+      CHARACTER (len=25)    ::  charout
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_stp')
+      !
+      IF( kt == nittrc000 .AND. lk_trdmld_trc )  CALL trd_mld_trc_init    ! trends: Mixed-layer
+      !
+      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
+         DO jk = 1, jpk
+            cvol(:,:,jk) = e1e2t(:,:) * e3t_crs(:,:,jk) * tmask(:,:,jk)
+         END DO
+         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
+         areatot         = glob_sum( cvol(:,:,:) )
+      ENDIF
+      !    
+     IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
+
+     IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step
+         !
+         IF(ln_ctl) THEN
+            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+            CALL prt_ctl_trc_info(charout)
+         ENDIF
+         !
+
+         tra(:,:,:,:) = 0.e0
+         !
+                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file 
+         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
+         ELSE                  ;   CALL trc_dia      ( kt )       ! output of passive tracers with old I/O manager
+         ENDIF
+         DO jk = 1, 31
+            DO jj = 1, 52
+               DO ji = 1, 62
+                                WRITE(numout,*) 'test641_tra', trn(ji,jj,jk,1)
+               ENDDO
+           ENDDO
+         ENDDO
+
+                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
+                                   CALL trc_trp      ( kt )       ! transport of passive tracers
+         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
+         IF( lk_trdmld_trc  )      CALL trd_mld_trc  ( kt )       ! trends: Mixed-layer
+         !
+  !       IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
+         !
+      ENDIF
+      !
+      ztrai = 0._wp                                                   !  content of all tracers
+      DO jn = 1, jptra
+         ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
+      END DO
+      IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot
+9300  FORMAT(i10,e18.10)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
+      !
+
+   END SUBROUTINE trc_stp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO passive tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_stp( kt )        ! Empty routine
+      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_stp
+#endif
+
+   !!======================================================================
+END MODULE trcstp
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsub.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsub.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcsub.F90	(revision 4056)
@@ -0,0 +1,463 @@
+MODULE trcsub
+   !!======================================================================
+   !!                       ***  MODULE trcsubstp  ***
+   !!TOP :   Averages physics variables for TOP substepping. 
+   !!======================================================================
+   !! History :  1.0  !  2011-10  (K. Edwards)  Original
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   trc_sub    : passive tracer system sub-stepping 
+   !!----------------------------------------------------------------------
+   USE oce_trc          ! ocean dynamics and active tracers variables
+   USE trc
+   USE prtctl_trc       ! Print control for debbuging
+   USE iom
+   USE in_out_manager
+   USE lbclnk
+   USE trc
+#if defined key_zdftke
+   USE zdftke          ! twice TKE (en)
+#endif
+#if defined key_zdfgls
+   USE zdfgls, ONLY: en
+#endif
+   USE trabbl
+   USE zdf_oce
+   USE domvvl
+   USE divcur          ! hor. divergence and curl      (div & cur routines)
+!   USE sbc_oce         ! surface boundary condition: ocean
+   USE bdy_oce
+#if defined key_agrif
+   USE agrif_opa_update
+   USE agrif_opa_interp
+#endif
+
+   IMPLICIT NONE
+
+   PUBLIC   trc_sub_stp      ! called by trc_stp
+   PUBLIC   trc_sub_ini      ! called by trc_ini to initialize substepping arrays.
+   PUBLIC   trc_sub_reset    ! called by trc_stp to reset physics variables
+   PUBLIC   trc_sub_ssh      ! called by trc_stp to reset physics variables
+
+   !!* Module variables
+   REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc 
+   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1) 
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sub_stp( kt )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_stp  ***
+      !!                      
+      !! ** Purpose : Average variables needed for sub-stepping passive tracers
+      !! 
+      !! ** Method  : Called every timestep to increment _tm (time mean) variables
+      !!              on TOP steps, calculate averages.
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt        ! ocean time-step index
+      INTEGER               ::  ji,jj,jk  ! dummy loop indices
+      REAL(wp)              ::  z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_stp')
+      !
+      IF( kt == nit000 ) THEN
+           IF(lwp) WRITE(numout,*)
+           IF(lwp) WRITE(numout,*) 'trc_sub_stp : substepping of the passive tracers'
+           IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+           !
+           sshb_hold  (:,:) = sshn  (:,:)
+     !      sshu_b_hold(:,:) = sshu_n(:,:)
+     !      sshv_b_hold(:,:) = sshv_n(:,:)
+           emp_b_hold (:,:) = emp_b (:,:)
+           !
+           r1_ndttrc        = 1._wp / REAL( nn_dttrc    , wp ) 
+           r1_ndttrcp1      = 1._wp / REAL( nn_dttrc + 1, wp )
+           !
+      ENDIF  
+
+       IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
+          !
+          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u(:,:,:) 
+          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v(:,:,:) 
+          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t(:,:,:)  
+          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t(:,:,:)  
+          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w(:,:,:)  
+          !
+          sshn_tm  (:,:)         = sshn_tm  (:,:)         + sshn  (:,:) 
+          rnf_tm   (:,:)         = rnf_tm   (:,:)         + rnf   (:,:) 
+          emp_tm   (:,:)         = emp_tm   (:,:)         + emp   (:,:) 
+          emps_tm  (:,:)         = emps_tm  (:,:)         + emps  (:,:)
+          qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:)
+          wndm_tm  (:,:)         = wndm_tm  (:,:)         + wndm  (:,:)
+          !
+#if defined key_traldf_c3d
+          ahtt_tm  (:,:,:)       = ahtt_tm  (:,:,:)       + ahtt(:,:,:)         * e3t(:,:,:)
+          ahtu_tm  (:,:,:)       = ahtu_tm  (:,:,:)       + ahtu(:,:,:)         * e3u(:,:,:)
+          ahtv_tm  (:,:,:)       = ahtv_tm  (:,:,:)       + ahtv(:,:,:)         * e3v(:,:,:)
+          ahtw_tm  (:,:,:)       = ahtw_tm  (:,:,:)       + ahtw(:,:,:)         * e3w(:,:,:)
+#elif defined key_traldf_c2d
+          ahtt_tm  (:,:)         = ahtt_tm  (:,:)         + ahtt(:,:)
+          ahtu_tm  (:,:)         = ahtu_tm  (:,:)         + ahtu(:,:)
+          ahtv_tm  (:,:)         = ahtv_tm  (:,:)         + ahtv(:,:)
+          ahtw_tm  (:,:)         = ahtw_tm  (:,:)         + ahtw(:,:)
+#elif defined key_traldf_c1d
+          ahtt_tm  (:)           = ahtt_tm  (:,:)         + ahtt(:)
+          ahtu_tm  (:)           = ahtu_tm  (:,:)         + ahtu(:)
+          ahtv_tm  (:)           = ahtv_tm  (:,:)         + ahtv(:)
+          ahtw_tm  (:)           = ahtw_tm  (:,:)         + ahtw(:)
+#else
+          ahtt_tm                = ahtt_tm                + ahtt
+          ahtu_tm                = ahtu_tm                + ahtu
+          ahtv_tm                = ahtv_tm                + ahtv
+          ahtw_tm                = ahtw_tm                + ahtw
+#endif
+
+      ELSE                           !  It is time to substep 
+
+         ! 2. Create averages and reassign variables
+         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u(:,:,:) 
+         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v(:,:,:) 
+         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t(:,:,:)  
+         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t(:,:,:)  
+         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w(:,:,:)  
+         sshn_tm  (:,:)          = sshn_tm    (:,:)       + sshn  (:,:) 
+         rnf_tm   (:,:)          = rnf_tm     (:,:)       + rnf   (:,:) 
+         emp_tm   (:,:)          = emp_tm     (:,:)       + emp   (:,:) 
+         emps_tm  (:,:)          = emps_tm    (:,:)       + emps  (:,:)
+         qsr_tm   (:,:)          = qsr_tm     (:,:)       + qsr   (:,:)
+         wndm_tm  (:,:)          = wndm_tm    (:,:)       + wndm  (:,:)
+         !
+         sshn     (:,:)          = sshn_tm    (:,:) * r1_ndttrcp1 
+         rnf      (:,:)          = rnf_tm     (:,:) * r1_ndttrcp1 
+         !  variables that are initialized after averages initialized
+         emp_b    (:,:) = emp_b_hold (:,:)
+         IF( kt == nittrc000 ) THEN
+            wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrc 
+            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrc 
+            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrc 
+            emps  (:,:)          = emps_tm    (:,:) * r1_ndttrc 
+         ELSE
+            wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrcp1 
+            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrcp1 
+            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrcp1 
+            emps  (:,:)          = emps_tm    (:,:) * r1_ndttrcp1 
+            !fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrcp1 
+         ENDIF
+         !
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  z1_ne3t = r1_ndttrcp1  / e3t(ji,jj,jk)
+                  z1_ne3u = r1_ndttrcp1  / e3u(ji,jj,jk)
+                  z1_ne3v = r1_ndttrcp1  / e3v(ji,jj,jk)
+                  z1_ne3w = r1_ndttrcp1  / e3w(ji,jj,jk)
+                  !
+                  un   (ji,jj,jk)        = un_tm   (ji,jj,jk)        * z1_ne3u
+                  vn   (ji,jj,jk)        = vn_tm   (ji,jj,jk)        * z1_ne3v
+                  tsn  (ji,jj,jk,jp_tem) = tsn_tm  (ji,jj,jk,jp_tem) * z1_ne3t
+                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t
+!                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t
+                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w
+               ENDDO
+            ENDDO
+         ENDDO
+
+          ahtt_tm                = ahtt_tm                + ahtt
+          ahtu_tm                = ahtu_tm                + ahtu
+          ahtv_tm                = ahtv_tm                + ahtv
+          ahtw_tm                = ahtw_tm                + ahtw
+          !
+          ahtt                   = ahtt_tm          * r1_ndttrcp1
+          ahtu                   = ahtu_tm          * r1_ndttrcp1
+          ahtv                   = ahtv_tm          * r1_ndttrcp1
+          ahtw                   = ahtw_tm          * r1_ndttrcp1
+
+         CALL lbc_lnk( un    (:,:,:)       , 'U',-1. ) 
+         CALL lbc_lnk( vn    (:,:,:)       , 'V',-1. ) 
+         CALL lbc_lnk( tsn   (:,:,:,jp_tem), 'T', 1. ) 
+         CALL lbc_lnk( tsn   (:,:,:,jp_sal), 'T', 1. ) 
+ !        CALL lbc_lnk( rhop  (:,:,:)       , 'T', 1. ) 
+         CALL lbc_lnk( avs  (:,:,:)       , 'W', 1. ) 
+         CALL lbc_lnk( sshn  (:,:)         , 'T', 1. ) 
+ !        CALL lbc_lnk( sshb  (:,:)         , 'T', 1. ) 
+ !        CALL lbc_lnk( ssha  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( rnf   (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( h_rnf (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( hmld  (:,:)         , 'T', 1. ) 
+ !        CALL lbc_lnk( fr_i  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( emp   (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( emp_b (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( emps  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( qsr   (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( wndm  (:,:)         , 'T', 1. ) 
+         !
+         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity
+         !
+         CALL lbc_lnk( wn    (:,:,:)       , 'W',-1. ) 
+ !        CALL lbc_lnk( rotn  (:,:,:)       , 'F', 1. ) 
+         CALL lbc_lnk( hdivn (:,:,:)       , 'T', 1. ) 
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_stp')
+      !
+   END SUBROUTINE trc_sub_stp
+
+   SUBROUTINE trc_sub_ini
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sub_ini  ***
+      !!                      
+      !! ** Purpose : Initialize variables needed for sub-stepping passive tracers
+      !! 
+      !! ** Method  : 
+      !!              Compute the averages for sub-stepping
+      !!-------------------------------------------------------------------
+      INTEGER ::   ierr
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_ini')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_sub_ini : initial set up of the passive tracers substepping'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      ierr =  trc_sub_alloc    ()
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
+      un_tm   (:,:,:)        = un   (:,:,:)        * e3u(:,:,:) 
+      vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v(:,:,:) 
+      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t(:,:,:)  
+      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t(:,:,:)  
+      avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w(:,:,:)  
+      sshn_tm  (:,:) = sshn  (:,:) 
+      rnf_tm   (:,:) = rnf   (:,:) 
+
+      ! Physics variables that are set after initialization:
+      fr_i_tm(:,:) = 0._wp
+      emp_tm (:,:) = 0._wp
+      emps_tm(:,:) = 0._wp
+      qsr_tm (:,:) = 0._wp
+      wndm_tm(:,:) = 0._wp
+      !
+      ahtt_tm        = ahtt
+      ahtu_tm        = ahtu
+      ahtv_tm        = ahtv
+      ahtw_tm        = ahtw
+      !
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ini')
+      !
+   END SUBROUTINE trc_sub_ini
+
+   SUBROUTINE trc_sub_reset( kt )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sub_reset  ***
+      !!                      
+      !! ** Purpose : Reset physics variables averaged for substepping
+      !! 
+      !! ** Method  : 
+      !!              Compute the averages for sub-stepping
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
+      INTEGER :: jk                 ! dummy loop indices
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_reset')
+      !
+
+      ! Start new averages
+         un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:) 
+         vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:) 
+         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
+         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
+         avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)  
+      !
+      sshb_hold  (:,:) = sshn  (:,:)
+      emp_b_hold (:,:) = emp   (:,:)
+      sshn_tm    (:,:) = sshn  (:,:) 
+      rnf_tm     (:,:) = rnf   (:,:) 
+      emp_tm     (:,:) = emp   (:,:)
+      emps_tm    (:,:) = emps  (:,:)
+      qsr_tm     (:,:) = qsr   (:,:)
+      wndm_tm    (:,:) = wndm  (:,:)
+      ahtt_tm        = ahtt
+      ahtu_tm        = ahtu
+      ahtv_tm        = ahtv
+      ahtw_tm        = ahtw
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_reset')
+      !
+   END SUBROUTINE trc_sub_reset
+
+
+   SUBROUTINE trc_sub_ssh( kt ) 
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE trc_sub_ssh  ***
+      !!                   
+      !! ** Purpose :   compute the after ssh (ssha), the now vertical velocity
+      !!              and update the now vertical coordinate (lk_vvl=T).
+      !!
+      !! ** Method  : - Using the incompressibility hypothesis, the vertical 
+      !!      velocity is computed by integrating the horizontal divergence  
+      !!      from the bottom to the surface minus the scale factor evolution.
+      !!        The boundary conditions are w=0 at the bottom (no flux) and.
+      !!
+      !! ** action  :   ssha    : after sea surface height
+      !!                wn      : now vertical velocity
+      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (lk_vvl=T)
+      !!                hu, hv, hur, hvr        : ocean depth and its inverse at u-,v-points
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_ssh')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj, zhdiv )
+
+      IF( kt == nittrc000 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sub_ssh : after sea surface height and now vertical velocity '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
+         !
+      ENDIF
+
+      !
+      IF(.NOT. ln_crs ) CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
+      !
+      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nittrc000 )   z2dt = rdt
+
+      !                                           !------------------------------!
+      !                                           !   After Sea Surface Height   !
+      !                                           !------------------------------!
+      zhdiv(:,:) = 0._wp
+      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
+        zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
+      END DO
+      !                                                ! Sea surface elevation time stepping
+      ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
+      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
+!      z1_rau0 = 0.5 / rau0
+!      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1)
+ 
+      !                                           !------------------------------!
+      !                                           !     Now Vertical Velocity    !
+      !                                           !------------------------------!
+      z1_2dt = 1.e0 / z2dt
+      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
+         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
+         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
+            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
+            &                         * tmask(:,:,jk) * z1_2dt
+      END DO
+
+      !
+      CALL wrk_dealloc( jpi, jpj, zhdiv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ssh')
+      !
+   END SUBROUTINE trc_sub_ssh
+
+   INTEGER FUNCTION trc_sub_alloc()
+      !!-------------------------------------------------------------------
+      !!                    *** ROUTINE trc_sub_alloc ***
+      !!-------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn
+      INTEGER ::  ierr
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE(   &
+         &        fr_i_tm(jpi,jpj) ,        &
+         &        wndm_tm(jpi,jpj) ,        &
+# if defined key_zdfddm
+         &      avs_tm(jpi,jpj,jpk),     &
+# endif
+#if defined key_traldf_c3d
+         &      ahtt_tm(jpi,jpj,jpk)        ,  
+         &      ahtu_tm(jpi,jpj,jpk)        ,  
+         &      ahtv_tm(jpi,jpj,jpk)        ,  
+         &      ahtw_tm(jpi,jpj,jpk)        ,  
+#elif defined key_traldf_c2d
+         &      ahtt_tm(jpi,jpj)            ,  
+         &      ahtu_tm(jpi,jpj)            ,  
+         &      ahtv_tm(jpi,jpj)            ,  
+         &      ahtw_tm(jpi,jpj)            ,  
+#elif defined key_traldf_c1d
+         &      ahtt_tm(jpk)                ,  
+         &      ahtu_tm(jpk)                ,  
+         &      ahtv_tm(jpk)                ,  
+         &      ahtw_tm(jpk)                ,  
+#endif
+#if defined key_traldf_eiv
+# if defined key_traldf_c3d
+         &      aeiu_tm(jpi,jpj,jpk)        ,  
+         &      aeiv_tm(jpi,jpj,jpk)        ,  
+         &      aeiw_tm(jpi,jpj,jpk)        ,  
+# elif defined key_traldf_c2d
+         &      aeiu_tm(jpi,jpj)            ,  
+         &      aeiv_tm(jpi,jpj)            ,  
+         &      aeiw_tm(jpi,jpj)            ,  
+# elif defined key_traldf_c1d
+         &      aeiu_tm(jpk)                ,  
+         &      aeiv_tm(jpk)                , 
+         &      aeiw_tm(jpk)                ,  
+# endif
+# endif
+         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     &
+         &      sshn_tm(jpi,jpj)            ,  sshb_hold(jpi,jpj) ,      &
+         &      sshu_n_tm(jpi,jpj)          ,  sshu_b_hold(jpi,jpj),     &
+         &      sshv_n_tm(jpi,jpj)          ,  sshv_b_hold(jpi,jpj),     &
+         &      tsn_tm(jpi,jpj,jpk,2)       ,                            &
+         &      emp_tm(jpi,jpj)             ,  emps_tm(jpi,jpj) ,        &
+         &      emp_b_hold(jpi,jpj)         ,                            &
+         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         &
+#if defined key_ldfslp
+         &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    &
+         &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     &
+#endif
+#if defined key_trabbl
+         &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      &
+         &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      &
+#endif
+         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) ,       &
+         &                                    STAT=trc_sub_alloc )  
+      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
+
+      !
+   END FUNCTION trc_sub_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO passive tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sub_stp( kt )        ! Empty routine
+      WRITE(*,*) 'trc_sub_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sub_stp
+   SUBROUTINE trc_sub_ini        ! Empty routine
+      WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sub_ini
+
+#endif
+
+   !!======================================================================
+END MODULE trcsub
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trctrp.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trctrp.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trctrp.F90	(revision 4056)
@@ -0,0 +1,139 @@
+MODULE trctrp
+   !!======================================================================
+   !!                       ***  MODULE trctrp  ***
+   !! Ocean Physics    : manage the passive tracer transport
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (C. Ethe) Original code
+   !!             3.3  !  2010-07 (C. Ethe) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_trp        : passive tracer transport
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean passive tracers variables 
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trabbl          ! bottom boundary layer               (trc_bbl routine)
+   USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
+   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine)
+   USE trcdmp          ! internal damping                    (trc_dmp routine)
+   USE trcldf          ! lateral mixing                      (trc_ldf routine)
+   USE trcadv         ! advection                           (trc_adv routine)
+   USE trczdf          ! vertical diffusion                  (trc_zdf routine)
+   USE trcnxt          ! time-stepping                       (trc_nxt routine)
+   USE trcrad          ! positivity                          (trc_rad routine)
+   USE trcsbc          ! surface boundary condition          (trc_sbc routine)
+   USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
+
+#if defined key_agrif
+   USE agrif_top_sponge ! Momemtum and tracers sponges
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_trp    ! called by trc_stp
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trctrp.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_trp( kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_trp  ***
+      !!                      
+      !! ** Purpose :   Management of passive tracers transport
+      !! 
+      !! ** Method  : - Compute the passive tracers trends 
+      !!              - Update the passive tracers
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index
+      INTEGER ::   jk, ji, jj
+      !! ---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_trp')
+      !
+      IF( .NOT. lk_c1d ) THEN
+         !
+ !                 DO jk = 1, jpkm1
+ !           DO jj = 1, jpjm1
+ !              DO ji = 1, fs_jpim1
+ !                               WRITE(numout,*) 'test641_tra', trn(ji,jj,jk,1)
+ !              ENDDO
+ !           ENDDO
+ !        ENDDO
+    !     WRITE(numout,*) 'test641_tra', trn(10,10,1,1)
+                                CALL trc_sbc( kstp )            ! surface boundary condition
+                  !                       DO jk = 1, jpkm1
+ !           DO jj = 1, jpjm1
+ !              DO ji = 1, fs_jpim1
+ !                               WRITE(numout,*) 'test641_tra', trn(ji,jj,jk,1)
+ !              ENDDO
+ !           ENDDO
+ !        ENDDO
+    !                            WRITE(numout,*) 'test641_tra', trn(10,10,1,1)
+         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme
+    !     WRITE(numout,*) 'test643_tra', tra(10,10,1,1)
+    !     WRITE(numout,*) 'test641_tra', trn(10,10,1,1)
+         IF( lk_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends
+    !     WRITE(numout,*) 'test644_tra', tra(10,10,1,1)
+    !     WRITE(numout,*) 'test641_tra', trn(10,10,1,1)
+                                    WRITE(numout,*) 'TEST'
+
+                                CALL trc_adv( kstp )            ! horizontal & vertical advection
+
+                                CALL trc_ldf( kstp )            ! lateral mixing
+
+         WRITE(numout,*) 'TEST'
+
+         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
+            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
+#if defined key_agrif
+         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge
+#endif
+                  !              avs = 0
+                  WRITE(numout,*) 'test63', trn(10,10,1,1)
+                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+                                
+                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
+                                
+         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive
+
+                                                                ! tracers at the bottom ocean level
+         !
+      ELSE                                               ! 1D vertical configuration
+                                CALL trc_sbc( kstp )            ! surface boundary condition
+         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
+            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
+                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
+          IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+         !
+      END IF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_trp')
+      !
+   END SUBROUTINE trc_trp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        No TOP models
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_trp( kt )              ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_trp
+#endif
+   
+   !!======================================================================
+END MODULE trctrp
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcwri.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcwri.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trcwri.F90	(revision 4056)
@@ -0,0 +1,102 @@
+MODULE trcwri
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    TOP :   Output of passive tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                           TOP models
+   !!----------------------------------------------------------------------
+   !! trc_wri_trc   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE dom_oce, ONLY : narea    ! ocean space and time domain variables
+   USE oce_trc      ! shared variables between ocean and passive tracers
+   USE trc         ! passive tracers common variables 
+   USE iom         ! I/O manager
+   USE dianam      ! Output file name
+   USE trcwri_pisces
+   USE crsiom
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri      
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+
+CONTAINS
+
+   SUBROUTINE trc_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri  ***
+      !! 
+      !! ** Purpose :   output passive tracers fields and dynamical trends
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_wri')
+      !
+      CALL iom_setkt  ( kt + nn_dttrc - 1 )       ! set the passive tracer time step
+      CALL trc_wri_trc( kt              )       ! outputs for tracer concentration
+      CALL iom_setkt  ( kt              )       ! set the model time step
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_wri')
+      !
+   END SUBROUTINE trc_wri
+
+   SUBROUTINE trc_wri_trc( kt )  
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in )     :: kt       ! ocean time-step
+      INTEGER                   :: jn
+      REAL(wp)                  :: toto
+      CHARACTER (len=20)        :: cltra
+      CHARACTER (len=40)        :: clhstnam
+      INTEGER ::   inum = 11            ! temporary logical unit
+      !!---------------------------------------------------------------------
+ 
+      IF( lk_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro
+         CALL dia_nam( clhstnam, nn_writetrc,' ' )
+         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         WRITE(inum,*) clhstnam
+         CLOSE(inum)
+      ENDIF
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      IF( lk_pisces )  THEN
+         CALL trc_wri_pisces
+      ELSE
+         DO jn = 1, jptra
+            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+            CALL crs_iom_put( cltra, pv_r3d=trn(:,:,:,jn) )
+            CALL dom_grid_crs            !! cc return at the CRS grid             
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE trc_wri_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri
+CONTAINS
+   SUBROUTINE trc_wri( kt )                     ! Empty routine   
+   INTEGER, INTENT(in) :: kt
+   END SUBROUTINE trc_wri
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcwri.F90 3295 2012-01-30 15:49:07Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trczdf.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trczdf.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trczdf.F90	(revision 4056)
@@ -0,0 +1,182 @@
+MODULE trczdf
+   !!==============================================================================
+   !!                 ***  MODULE  trczdf  ***
+   !! Ocean Passive tracers : vertical diffusive trends 
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp_crs      ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE trdmod_oce
+   USE trdtra
+   USE prtctl_trc      ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_zdf          ! called by step.F90 
+   PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90 
+
+   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
+      !                                ! defined from ln_zdf...  namlist logicals)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra
+      !                                                 ! except at nittrc000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trczdf.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   INTEGER FUNCTION trc_zdf_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc )
+      !
+      IF( trc_zdf_alloc /= 0 )   CALL ctl_warn('trc_zdf_alloc : failed to allocate array.')
+      !
+   END FUNCTION trc_zdf_alloc
+
+
+   SUBROUTINE trc_zdf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf  ***
+      !!
+      !! ** Purpose :   compute the vertical ocean tracer physics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
+      !
+      INTEGER               ::  jk, jn
+      CHARACTER (len=22)    :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd   ! 4D workspace
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_zdf')
+      !
+      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( -1 )                                       ! esopa: test all possibility with control print
+         CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_zdf_imp_crs( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme 
+      CASE ( 1 ) ;  CALL tra_zdf_imp_crs( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme          
+
+      END SELECT
+
+      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn)
+            END DO
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) )
+         END DO
+         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('zdf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_zdf')
+      !
+   END SUBROUTINE trc_zdf
+
+
+   SUBROUTINE zdf_ctl
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdf_ctl  ***
+      !!
+      !! ** Purpose :   Choose the vertical mixing scheme
+      !!
+      !! ** Method  :   Set nzdf from ln_zdfexp
+      !!      nzdf = 0   explicit (time-splitting) scheme (ln_trczdf_exp=T)
+      !!           = 1   implicit (euler backward) scheme (ln_trczdf_exp=F)
+      !!      NB: The implicit scheme is required when using : 
+      !!             - rotated lateral mixing operator
+      !!             - TKE, GLS or KPP vertical mixing scheme
+      !!----------------------------------------------------------------------
+
+      !  Define the vertical tracer physics scheme
+      ! ==========================================
+
+      ! Choice from ln_zdfexp already read in namelist in zdfini module
+      IF( ln_trczdf_exp ) THEN           ! use explicit scheme
+         nzdf = 0
+      ELSE                               ! use implicit scheme
+         nzdf = 1
+      ENDIF
+
+      ! Force implicit schemes
+      IF( ln_trcldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_trcldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+#if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp
+                                                          nzdf = 1      ! TKE, GLS or KPP physics       
+#endif
+      IF( ln_trczdf_exp .AND. nzdf == 1 )   THEN
+         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', &
+            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
+      ENDIF
+
+      ! Test: esopa
+      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+
+   END SUBROUTINE zdf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf( kt )
+      INTEGER, INTENT(in) :: kt  
+      WRITE(*,*) 'trc_zdf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf
+#endif
+   !!==============================================================================
+END MODULE trczdf
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trdmod_trc.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trdmod_trc.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trdmod_trc.F90	(revision 4056)
@@ -0,0 +1,23 @@
+MODULE trdmod_trc
+   !!======================================================================
+   !!                       ***  MODULE trdmod_trc  ***
+   !!  Dummy module
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                             NO TOP use
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_mod_trc( ptrtrd, kjn, ktrd, kt )
+      INTEGER ::   kt, kjn, ktrd   
+      REAL    ::   ptrtrd(:,:,:)  
+      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn, ktrd, kt
+   END SUBROUTINE trd_mod_trc
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trdmod_trc.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trdmod_trc
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trdtra.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trdtra.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/trdtra.F90	(revision 4056)
@@ -0,0 +1,210 @@
+MODULE trdtra
+   !!======================================================================
+   !!                       ***  MODULE  trdtra  ***
+   !! Ocean diagnostics:  ocean tracers trends
+   !!=====================================================================
+   !! History :  1.0  !  2004-08  (C. Talandier) Original code
+   !!            2.0  !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget
+   !!            3.3  !  2010-06  (C. Ethe) merge TRA-TRC 
+   !!----------------------------------------------------------------------
+#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 
+   !!----------------------------------------------------------------------
+   !!   trd_tra      : Call the trend to be computed
+   !!----------------------------------------------------------------------
+!   USE dom_oce          ! ocean domain 
+   USE trdmod_oce       ! ocean active mixed layer tracers trends 
+   USE trdmod           ! ocean active mixed layer tracers trends 
+   USE trdmod_trc       ! ocean passive mixed layer tracers trends 
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo        ! Memory allocation
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_tra          ! called by all  traXX modules
+ 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !:
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: trdtra.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_tra_alloc()
+      !!----------------------------------------------------------------------------
+      !!                  ***  FUNCTION trd_tra_alloc  ***
+      !!----------------------------------------------------------------------------
+      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc )
+      IF( trd_tra_alloc /= 0 )   CALL ctl_warn('trd_tra_alloc: failed to allocate arrays')
+   END FUNCTION trd_tra_alloc
+
+
+   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra  ***
+      !! 
+      !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or 
+      !!              integral constraints
+      !!
+      !! ** Method/usage : For the mixed-layer trend, the control surface can be either
+      !!       a mixed layer depth (time varying) or a fixed surface (jk level or bowl). 
+      !!      Choose control surface with nn_ctls in namelist NAMTRD :
+      !!        nn_ctls = 0  : use mixed layer with density criterion 
+      !!        nn_ctls = 1  : read index from file 'ctlsurf_idx'
+      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls
+      !!----------------------------------------------------------------------
+      !
+      INTEGER                         , INTENT(in)           ::  kt      ! time step
+      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
+      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
+      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variablea
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:)  ::  ztrds
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpk, ztrds )
+
+      IF( .NOT. ALLOCATED( trdtx ) ) THEN       ! allocate trdtra arrays
+         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' )
+      ENDIF
+      
+      ! Control of optional arguments
+      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN 
+         IF( PRESENT( ptra ) ) THEN    
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
+            CASE( jptra_trd_yad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
+            CASE( jptra_trd_zad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
+            END SELECT
+         ELSE
+            trdt(:,:,:) = ptrd(:,:,:)
+            IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN
+               ztrds(:,:,:) = 0.
+               CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )
+            END IF
+         END IF
+      END IF
+
+      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN 
+         IF( PRESENT( ptra ) ) THEN    
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
+                                CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   )
+            CASE( jptra_trd_yad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
+                                CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   )
+            CASE( jptra_trd_zad )    
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
+                                CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   )
+            END SELECT
+         ELSE
+            ztrds(:,:,:) = ptrd(:,:,:)
+            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )  
+         END IF
+      END IF
+
+      IF( ctype == 'TRC' ) THEN
+         !
+         IF( PRESENT( ptra ) ) THEN  
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            CASE( jptra_trd_yad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            CASE( jptra_trd_zad )    
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            END SELECT
+         ELSE
+            ztrds(:,:,:) = ptrd(:,:,:)
+            CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )  
+         END IF
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, ztrds )
+      !
+   END SUBROUTINE trd_tra
+
+
+   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_adv  ***
+      !! 
+      !! ** Purpose :   transformed the i-, j- or k-advective flux into thes
+      !!              i-, j- or k-advective trends, resp.
+      !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
+      !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
+      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
+      !!----------------------------------------------------------------------
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer 
+      CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction
+      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ii, ij, ik   ! index shift function of the direction
+      REAL(wp) ::   zbtr         ! local scalar
+      !!----------------------------------------------------------------------
+
+      SELECT CASE( cdir )            ! shift depending on the direction
+      CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend
+      CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend
+      CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend
+      END SELECT
+
+      !                              ! set to zero uncomputed values
+      ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0
+      ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0
+      ptrd(:,:,jpk) = 0.e0
+      !
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
+                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE trd_tra_adv
+
+#   else
+   !!----------------------------------------------------------------------
+   !!   Default case :          Dummy module           No trend diagnostics
+   !!----------------------------------------------------------------------
+   USE par_oce      ! ocean variables trends
+CONTAINS
+   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in)           ::  kt      ! time step
+      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
+      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
+      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   &
+         &                                                               ktrd, ktra, ctype, kt
+   END SUBROUTINE trd_tra
+#   endif
+   !!======================================================================
+END MODULE trdtra
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfini.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfini.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfini.F90	(revision 4056)
@@ -0,0 +1,180 @@
+MODULE zdfini
+   !!======================================================================
+   !!                      ***  MODULE  zdfini  ***
+   !! Ocean physics :   read vertical mixing namelist and check consistancy
+   !!======================================================================
+   !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix
+   !!            1.0  ! 2002-08  (G. Madec)  F90 : free form
+   !!             -   ! 2005-06  (C. Ethe) KPP parameterization
+   !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE par_oce         ! mesh and scale factors
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics lateral physics
+   USE zdf_oce         ! TKE vertical mixing          
+   USE lib_mpp         ! distribued memory computing
+   USE zdftke          ! TKE vertical mixing
+   USE zdfgls          ! GLS vertical mixing
+   USE zdfkpp          ! KPP vertical mixing          
+   USE zdfddm          ! double diffusion mixing      
+   USE zdfevd          ! enhanced vertical diffusion  
+   USE zdfric          ! Richardson vertical mixing   
+   USE tranpc          ! convection: non penetrative adjustment
+   USE ldfslp          ! iso-neutral slopes
+   USE restart         ! ocean restart
+   USE dom_oce, ONLY : ln_sco, gphit
+
+
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_init   ! routine called by opa.F90
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: zdfini.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zdf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_init  ***
+      !! 
+      !! ** Purpose :   initializations of the vertical ocean physics
+      !!
+      !! ** Method  :   Read namelist namzdf, control logicals 
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio       ! temporary scalar
+      !!
+      NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   &
+         &              ln_zdfevd, nn_evdm, rn_avevd, ln_zdfnpc, nn_npc, nn_npcp
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )           !* Read namzdf namelist : vertical mixing parameters
+      READ  ( numnam, namzdf )
+
+      IF(lwp) THEN               !* Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_init: vertical physics'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters'
+         WRITE(numout,*) '      vertical eddy viscosity             rn_avm0   = ', rn_avm0
+         WRITE(numout,*) '      vertical eddy diffusivity           rn_avt0   = ', rn_avt0
+         WRITE(numout,*) '      constant background or profile      nn_avb    = ', nn_avb
+         WRITE(numout,*) '      horizontal variation for avtb       nn_havtb  = ', nn_havtb
+         WRITE(numout,*) '      time splitting / backward scheme    ln_zdfexp = ', ln_zdfexp
+         WRITE(numout,*) '      number of time step                 nn_zdfexp = ', nn_zdfexp
+         WRITE(numout,*) '      enhanced vertical diffusion         ln_zdfevd = ', ln_zdfevd
+         WRITE(numout,*) '         applied on momentum (=1/0)       nn_evdm   = ', nn_evdm
+         WRITE(numout,*) '      vertical coefficient for evd        rn_avevd  = ', rn_avevd
+         WRITE(numout,*) '      non-penetrative convection (npc)    ln_zdfnpc = ', ln_zdfnpc
+         WRITE(numout,*) '      npc call  frequency                 nn_npc    = ', nn_npc
+         WRITE(numout,*) '      npc print frequency                 nn_npcp   = ', nn_npcp
+      ENDIF
+
+      !                          !* Parameter & logical controls
+      !                          !  ----------------------------
+      !
+      !                               ! ... check of vertical mixing scheme on tracers
+      !                                              ==> will be done in trazdf module
+      !
+      !                               ! ... check of mixing coefficient
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   vertical mixing option :'
+      ioptio = 0
+      IF( lk_zdfcst ) THEN
+         IF(lwp) WRITE(numout,*) '      constant eddy diffusion coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfric ) THEN
+         IF(lwp) WRITE(numout,*) '      Richardson dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '      TKE dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      GLS dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfkpp ) THEN
+         IF(lwp) WRITE(numout,*) '      KPP dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa )   &
+         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
+      !
+      !                               ! ... Convection
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   convection :'
+      ioptio = 0
+      IF( ln_zdfnpc ) THEN
+         IF(lwp) WRITE(numout,*) '      use non penetrative convective scheme'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ln_zdfevd ) THEN
+         IF(lwp) WRITE(numout,*) '      use enhanced vertical dif. scheme'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '      use the 1.5 turbulent closure'
+      ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      use the GLS closure scheme'
+      ENDIF
+      IF( lk_zdfkpp ) THEN
+         IF(lwp) WRITE(numout,*) '      use the KPP closure scheme'
+         IF(lk_mpp) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) 'The KPP scheme is not ready to run in MPI'
+         ENDIF
+      ENDIF
+ !cc     IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
+  !    IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) )           &
+  !       CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is',   &
+  !       &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
+!cc
+      !                               !* Background eddy viscosity and diffusivity profil
+      IF( nn_avb == 0 ) THEN                ! Define avmb, avtb from namelist parameter
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0                     
+      ELSE                                  ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990)
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0 + ( 3.e-4_wp - 2._wp * rn_avt0 ) * 1.e-4_wp * gdepw_0(:)   ! m2/s
+         IF(ln_sco .AND. lwp)   CALL ctl_warn( 'avtb profile not valid in sco' )
+      ENDIF
+      !
+      IF( ln_rstart ) THEN                  !  Read avmb, avtb in restart (if exist)
+         ! if ln_traadv_cen, avmb, avtb have been modified in traadv_cen2 module. 
+         ! To ensure the restartability, avmb & avtb are written in the restart 
+         ! file in traadv_cen2 end read here. 
+         IF( iom_varid( numror, 'avmb', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numror, jpdom_unknown, 'avmb', avmb )
+            CALL iom_get( numror, jpdom_unknown, 'avtb', avtb )
+         ENDIF
+      ENDIF
+      !                                     ! 2D shape of the avtb
+      avtb_2d(:,:) = 1.e0                        ! uniform 
+      !
+      IF( nn_havtb == 1 ) THEN                   ! decrease avtb in the equatorial band
+           !  -15S -5S : linear decrease from avt0 to avt0/10.
+           !  -5S  +5N : cst value avt0/10.
+           !   5N  15N : linear increase from avt0/10, to avt0
+           WHERE(-15. <= gphit .AND. gphit < -5 )   avtb_2d = (1.  - 0.09 * (gphit + 15.))
+           WHERE( -5. <= gphit .AND. gphit <  5 )   avtb_2d =  0.1
+           WHERE(  5. <= gphit .AND. gphit < 15 )   avtb_2d = (0.1 + 0.09 * (gphit -  5.))
+      ENDIF
+      !
+   END SUBROUTINE zdf_init
+
+   !!======================================================================
+END MODULE zdfini
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfmxl.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfmxl.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfmxl.F90	(revision 4056)
@@ -0,0 +1,129 @@
+MODULE zdfmxl
+   !!======================================================================
+   !!                       ***  MODULE  zdfmxl  ***
+   !! Ocean physics: mixed layer depth 
+   !!======================================================================
+   !! History :  1.0  ! 2003-08  (G. Madec)  original code
+   !!            3.2  ! 2009-07  (S. Masson, G. Madec)  IOM + merge of DO-loop
+   !!----------------------------------------------------------------------
+   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE trc_oce, ONLY : lk_offline ! offline flag
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_mxl       ! called by step.F90
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: zdfmxl.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_mxl_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION zdf_mxl_alloc  ***
+      !!----------------------------------------------------------------------
+      zdf_mxl_alloc = 0      ! set to zero if no array to be allocated
+      IF( .NOT. ALLOCATED( nmln ) ) THEN
+         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc )
+         !
+         IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc )
+         IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
+         !
+      ENDIF
+   END FUNCTION zdf_mxl_alloc
+
+
+   SUBROUTINE zdf_mxl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!              with density criteria.
+      !!
+      !! ** Method  :   The mixed layer depth is the shallowest W depth with 
+      !!      the density of the corresponding T point (just bellow) bellow a
+      !!      given value defined locally as rho(10m) + zrho_c
+      !!               The turbocline depth is the depth at which the vertical
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
+      !!
+      !! ** Action  :   nmln, hmld, hmlp, hmlpt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop
+      INTEGER, POINTER, DIMENSION(:,:) ::   imld                ! temporary workspace
+      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth
+      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_mxl')
+      !
+      CALL wrk_alloc( jpi,jpj, imld )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         !                             ! allocate zdfmxl arrays
+         IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' )
+      ENDIF
+
+      ! w-level of the mixing and mixed layers
+      nmln(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
+      imld(:,:) = mbkt(:,:) + 1
+      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + zrho_c )   nmln(ji,jj) = jk      ! Mixed layer
+               IF( avt (ji,jj,jk) < zavt_c                     )   imld(ji,jj) = jk      ! Turbocline 
+            END DO
+         END DO
+      END DO
+      ! depth of the mixing and mixed layers
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            iiki = imld(ji,jj)
+            iikn = nmln(ji,jj)
+            hmld (ji,jj) = fsdepw(ji,jj,iiki  ) * tmask(ji,jj,1)    ! Turbocline depth 
+            hmlp (ji,jj) = fsdepw(ji,jj,iikn  ) * tmask(ji,jj,1)    ! Mixed layer depth
+            hmlpt(ji,jj) = fsdept(ji,jj,iikn-1)                     ! depth of the last T-point inside the mixed layer
+         END DO
+      END DO
+      IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode
+         CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth
+         CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth
+      ENDIF
+      
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
+      !
+      CALL wrk_dealloc( jpi,jpj, imld )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl')
+      !
+   END SUBROUTINE zdf_mxl
+
+   !!======================================================================
+END MODULE zdfmxl
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfmxl_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfmxl_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zdfmxl_crs.F90	(revision 4056)
@@ -0,0 +1,131 @@
+MODULE zdfmxl_crs
+   !!======================================================================
+   !!                       ***  MODULE  zdfmxl  ***
+   !! Ocean physics: mixed layer depth 
+   !!======================================================================
+   !! History :  1.0  ! 2003-08  (G. Madec)  original code
+   !!            3.2  ! 2009-07  (S. Masson, G. Madec)  IOM + merge of DO-loop
+   !!----------------------------------------------------------------------
+   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE trc_oce, ONLY : lk_offline ! offline flag
+   USE crs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_mxl_crs       ! called by step.F90
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: zdfmxl.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_mxl_alloc_crs()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION zdf_mxl_alloc  ***
+      !!----------------------------------------------------------------------
+      zdf_mxl_alloc_crs = 0      ! set to zero if no array to be allocated
+      IF( .NOT. ALLOCATED( nmln_crs ) ) THEN
+         ALLOCATE( nmln_crs(jpi_crs,jpj_crs), hmld_crs(jpi_crs,jpj_crs), hmlp_crs(jpi_crs,jpj_crs) & !! declaration in crs.F90
+         &       , hmlpt_crs(jpi_crs,jpj_crs), STAT= zdf_mxl_alloc_crs )
+         !
+         IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc_crs )
+         IF( zdf_mxl_alloc_crs /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
+         !
+      ENDIF
+   END FUNCTION zdf_mxl_alloc_crs
+
+
+   SUBROUTINE zdf_mxl_crs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!              with density criteria.
+      !!
+      !! ** Method  :   The mixed layer depth is the shallowest W depth with 
+      !!      the density of the corresponding T point (just bellow) bellow a
+      !!      given value defined locally as rho(10m) + zrho_c
+      !!               The turbocline depth is the depth at which the vertical
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
+      !!
+      !! ** Action  :   nmln, hmld, hmlp, hmlpt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop
+      INTEGER, POINTER, DIMENSION(:,:) ::   imld                ! temporary workspace
+      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth
+      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_mxl')
+      !
+      CALL wrk_alloc( jpi_crs,jpj_crs, imld )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         !                             ! allocate zdfmxl arrays
+         IF( zdf_mxl_alloc_crs() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' )
+      ENDIF
+
+      ! w-level of the mixing and mixed layers
+      nmln_crs(:,:) = mbkt_crs(:,:) + 1        ! Initialization to the number of w ocean point
+      imld(:,:)     = mbkt_crs(:,:) + 1
+      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10
+         DO jj = 1, jpj_crs
+            DO ji = 1, jpi_crs
+               IF( rhop_crs(ji,jj,jk) > rhop_crs(ji,jj,nla10) + zrho_c )   nmln_crs(ji,jj) = jk      ! Mixed layer
+        !       IF( avt (ji,jj,jk) < zavt_c                     )   imld(ji,jj) = jk      ! Turbocline 
+            END DO
+         END DO
+      END DO
+      ! depth of the mixing and mixed layers
+      DO jj = 1, jpj_crs
+         DO ji = 1, jpi_crs
+           ! iiki = imld(ji,jj)
+            iikn = nmln_crs(ji,jj)
+       !     hmld (ji,jj) = gdepw_crs(ji,jj,iiki  ) * tmask_crs(ji,jj,1)    ! Turbocline depth 
+            hmlp_crs (ji,jj) = gdepw_crs(ji,jj,iikn  ) * tmask_crs(ji,jj,1)    ! Mixed layer depth
+            hmlpt_crs(ji,jj) = gdept_crs(ji,jj,iikn-1)                     ! depth of the last T-point inside the mixed layer
+         END DO
+      END DO
+      IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode
+  !       CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth
+   !      CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth
+      ENDIF
+      
+    !  IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
+      !
+      CALL wrk_dealloc( jpi_crs,jpj_crs, imld )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl')
+      !
+   END SUBROUTINE zdf_mxl_crs
+
+   !!======================================================================
+END MODULE zdfmxl_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zpshde_crs.F90
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zpshde_crs.F90	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/MY_SRC/zpshde_crs.F90	(revision 4056)
@@ -0,0 +1,221 @@
+MODULE zpshde_crs
+   !!======================================================================
+   !!                       ***  MODULE zpshde   ***
+   !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level
+   !!======================================================================
+   !! History :  OPA  !  2002-04  (A. Bozec)  Original code
+   !!   NEMO     1.0  !  2002-08  (G. Madec E. Durand)  Optimization and Free form
+   !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
+   !!                   ocean level (Z-coord. with Partial Steps)
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean: dynamics and tracers variables
+   USE dom_oce         ! domain: ocean variables
+   USE phycst          ! physical constants
+   USE eosbn2_crs          ! ocean equation of state
+   USE in_out_manager  ! I/O manager
+   USE crslbclnk          ! lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+   USE crs
+   
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zps_hde_crs    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: zpshde.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zps_hde_crs( kt, kjpt, pta, pgtu, pgtv,   &
+                                 prd, pgru, pgrv    )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
+      !!      at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps.
+      !!
+      !! ** Method  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that T, S and rd 
+      !!      points are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      Linear interpolation of T, S   
+      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
+      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                    Ti  T~                  T~  Ti+1
+      !!                  _____                        _____
+      !!         k        |   |Ti+1     k           Ti |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+      !!          Idem for di(s) and dj(s)          
+      !!
+      !!      For rho, we call eos_insitu_2d which will compute rd~(t~,s~) at 
+      !!      the good depth zh from interpolated T and S for the different
+      !!      formulation of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~
+      !!
+      !! ** Action  : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
+      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 
+      !!----------------------------------------------------------------------
+      !
+      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts 
+      !
+      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
+      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points
+      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zti, ztj    ! interpolated value of tracer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde')
+      !
+      CALL wrk_alloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
+      CALL wrk_alloc( jpi, jpj, kjpt, zti, ztj           ) 
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku_crs(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv_crs(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+               ze3wu = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)
+               ze3wv = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu =  ze3wu / e3w_max_crs(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = umask_crs(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = -ze3wu / e3w_max_crs(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = umask_crs(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  zmaxv =  ze3wv / e3w_max_crs(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask_crs(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  -ze3wv / e3w_max_crs(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask_crs(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+         CALL crs_lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL crs_lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      END DO
+
+      ! horizontal derivative of density anomalies (rd)
+      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku_crs(ji,jj)
+               ikv = mbkv_crs(ji,jj)
+               ze3wu  = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)
+               ze3wv  = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_crs(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_crs(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_crs(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_crs(ji,jj+1,ikv)     ! -     -      case 2
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+
+         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
+         ! step and store it in  zri, zrj for each  case
+         CALL eos_crs( zti, zhi, zri )  
+         CALL eos_crs( ztj, zhj, zrj )
+
+         ! Gradient of density at the last level 
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku_crs(ji,jj)
+               ikv = mbkv_crs(ji,jj)
+               ze3wu  = e3w_max_crs(ji+1,jj  ,iku) - e3w_max_crs(ji,jj,iku)
+               ze3wv  = e3w_max_crs(ji  ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask_crs(ji,jj,1) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = umask_crs(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask_crs(ji,jj,1) * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = vmask_crs(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+         CALL crs_lbc_lnk( pgru , 'U', -1. )   ;   CALL crs_lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      CALL wrk_dealloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
+      CALL wrk_dealloc( jpi, jpj, kjpt, zti, ztj           ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde')
+      !
+   END SUBROUTINE zps_hde_crs
+
+   !!======================================================================
+END MODULE zpshde_crs
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/cpp_ORCA2_LIM_CRS_SAL.fcm
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/cpp_ORCA2_LIM_CRS_SAL.fcm	(revision 4056)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS_SAL/cpp_ORCA2_LIM_CRS_SAL.fcm	(revision 4056)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_orca_r2 key_lim2 key_dynspg_flt key_dynldf_c3d key_zdfcst key_zdfddm key_iomput key_top key_my_trc key_mpp_mpi key_ldfslp 
Index: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/cfg.txt	(revision 3897)
+++ branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/cfg.txt	(revision 4056)
@@ -9,2 +9,3 @@
 ORCA2_LIM_CRS OPA_SRC LIM_SRC_2 NST_SRC
 ORCA2_LIM_CRS_AGE OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
+ORCA2_LIM_CRS_SAL OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
