Changeset 14958

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

-                      r14229
+                      r14958
       ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)
       !                         !       from the bathymetry at runtime.
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg

-                      r14229
+                      r14958
    ln_read_cfg = .true.    !  (=T) read the domain configuration file
       cn_domcfg = "ORCA_R05_zps_domcfg_agrif"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg

-                      r14229
+                      r14958
    ln_read_cfg = .true.    !  (=T) read the domain configuration file
       cn_domcfg = "ORCA_R017_zps_domcfg_agrif"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)
       !                         !       from the bathymetry at runtime.
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/AMM12/EXPREF/namelist_cfg

-                      r14229
+                      r14958
    ln_read_cfg = .true.   !  (=T) read the domain configuration file
       cn_domcfg = "AMM_R12_sco_domcfg" ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/C1D_PAPA/EXPREF/namelist_cfg

-                      r14229
+                      r14958
+/
 !-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namtsd        !    Temperature & Salinity Data  (init/dmp)             (default: OFF)
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/GYRE_BFM/EXPREF/namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
    ln_read_cfg = .false.   !  (=F) user defined configuration           (F => create/check namusr_def)
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/GYRE_PISCES/EXPREF/namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
    ln_read_cfg = .false.   !  (=F) user defined configuration           (F => create/check namusr_def)
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)
       !                         !       from the bathymetry at runtime.
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)
       !                         !       from the bathymetry at runtime.
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_cfg

r14255	r14958
43	43	cn_domcfg = "ORCA_R2_zps_domcfg" ! domain configuration filename
44	44	!
	45	/
	46	!-----------------------------------------------------------------------
	47	&namtile ! parameters of the tiling
	48	!-----------------------------------------------------------------------
45	49	/
46	50	!-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/ORCA2_OFF_TRC/EXPREF/namelist_cfg

r14256	r14958
42	42	cn_domcfg = "ORCA_R2_zps_domcfg" ! domain configuration filename
43	43	!
	44	/
	45	!-----------------------------------------------------------------------
	46	&namtile ! parameters of the tiling
	47	!-----------------------------------------------------------------------
44	48	/
45	49	!-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg

-                      r14229
+                      r14958
    ln_read_cfg = .true.    !  (=T) read the domain configuration file
       cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/SHARED/field_def_nemo-ice.xml

-                      r14581
+                      r14958
       <field id="hfxcndtop"    long_name="Net conductive heat flux at the ice surface (neg = ice cooling)"  standard_name="conductive_heat_flux_at_sea_ice_surface"    unit="W/m2" />
       <field id="hfxcndbot"    long_name="Net conductive heat flux at the ice bottom (neg = ice cooling)"   standard_name="conductive_heat_flux_at_sea_ice_bottom"     unit="W/m2" />
-      <!-- clem: uncomment when uncommented in iceupdate.F90 -->
-      <!--
       <field id="hfxmelt"      long_name="Melt heat flux at the ice surface"       unit="W/m2" />
       <field id="hfxldmelt"    long_name="Heat flux in the lead for ice melting"   unit="W/m2" />
       <field id="hfxldgrow"    long_name="Heat flux in the lead for ice growth"    unit="W/m2" />
-      -->
       <!-- diags -->
 …
       <field id="SH_icearea"      long_name="Sea ice area South"                     standard_name="sea_ice_area_s"                     unit="1e6_km2"  />
+      <!-- available with ln_icediaout -->
+      <!-- available with ln_icediahsb -->
+      <!-- global forcings  -->
       <field id="ibgfrcvoltop"    long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)"   unit="km3"      />
       <field id="ibgfrcvolbot"    long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3"      />
 …
       <field id="ibgfrchfxbot"    long_name="global mean heat flux below ice (on top of ocean) "                                        unit="W/m2"     />
+      <!-- global drifts (conservation checks) -->
       <field id="ibgvolume"       long_name="drift in ice/snow volume (equivalent ocean volume)"                                        unit="km3"      />
       <field id="ibgsaltco"       long_name="drift in ice salt content (equivalent ocean volume)"                                       unit="pss*km3"  />
 …
       <field id="ibgheatfx"       long_name="drift in ice/snow heat flux"                                                               unit="W/m2"     />
+      <!-- global contents -->
       <field id="ibgvol_tot"      long_name="global mean ice volume"                                                                    unit="km3"      />
       <field id="sbgvol_tot"      long_name="global mean snow volume"                                                                   unit="km3"      />
       <field id="ibgarea_tot"     long_name="global mean ice area"                                                                      unit="km2"      />
       <field id="ibgsalt_tot"     long_name="global mean ice salt content"                                                              unit="1e-3*km3" />
+      <field id="ibgsalt_tot"     long_name="global mean ice salt content"                                                              unit="pss*km3"  />
       <field id="ibgheat_tot"     long_name="global mean ice heat content"                                                              unit="1e20J"    />
       <field id="sbgheat_tot"     long_name="global mean snow heat content"                                                             unit="1e20J"    />
+      <field id="ipbgvol_tot"     long_name="global mean ice pond volume"                                                               unit="km3"      />
+      <field id="ilbgvol_tot"     long_name="global mean ice pond lid volume"                                                           unit="km3"      />
     </field_group>
 …
     </field_group>
+    <!--============================-->
+    <!--  CONSERVATION diagnostics  -->
+    <!--============================-->
     <field_group id="ICE_globalbudget"  grid_ref="grid_scalar" >
-      <!-- global contents -->
       <field field_ref="ibgvol_tot"       name="ibgvol_tot"   />
       <field field_ref="sbgvol_tot"       name="sbgvol_tot"   />
 …
       <field field_ref="ibgheat_tot"      name="ibgheat_tot"  />
       <field field_ref="sbgheat_tot"      name="sbgheat_tot"  />
+      <!-- global drifts (conservation checks) -->
+      <field field_ref="ibgvolume"        name="ibgvolume"    />
+      <field field_ref="ibgsaltco"        name="ibgsaltco"    />
+      <field field_ref="ibgheatco"        name="ibgheatco"    />
+      <field field_ref="ibgheatfx"        name="ibgheatfx"    />
+      <!-- global forcings  -->
+      <field field_ref="ibgfrcvoltop"     name="ibgfrcvoltop" />
+      <field field_ref="ibgfrcvolbot"     name="ibgfrcvolbot" />
+      <field field_ref="ibgfrctemtop"     name="ibgfrctemtop" />
+      <field field_ref="ibgfrctembot"     name="ibgfrctembot" />
+      <field field_ref="ibgfrcsal"        name="ibgfrcsal"    />
+      <field field_ref="ibgfrchfxtop"     name="ibgfrchfxtop" />
+      <field field_ref="ibgfrchfxbot"     name="ibgfrchfxbot" />
+    </field_group>
+      <field field_ref="ipbgvol_tot"      name="ipbgvol_tot"  />
+      <field field_ref="ilbgvol_tot"      name="ilbgvol_tot"  />
+    </field_group>
+    <field_group id="ICE_budget"        grid_ref="grid_T_2D" >
+      <!-- general -->
+      <field field_ref="icemask"          name="simsk"      />
+      <field field_ref="iceconc"          name="siconc"     />
+      <field field_ref="icetemp"          name="sitemp"     />
+      <field field_ref="snwtemp"          name="sntemp"     />
+      <field field_ref="icettop"          name="sittop"     />
+      <field field_ref="icetbot"          name="sitbot"     />
+      <!-- heat fluxes -->
+      <field field_ref="qt_oce_ai"        name="qt_oce_ai"  />
+      <field field_ref="qt_atm_oi"        name="qt_atm_oi"  />
+      <field field_ref="qtr_ice_top"      name="qtr_ice_top"/>
+      <field field_ref="qtr_ice_bot"      name="qtr_ice_bot"/>
+      <field field_ref="qt_ice"           name="qt_ice"     />
+      <field field_ref="qsr_ice"          name="qsr_ice"    />
+      <field field_ref="qns_ice"          name="qns_ice"    />
+      <field field_ref="qemp_ice"         name="qemp_ice"   />
+      <field field_ref="hfxsub"           name="hfxsub"     />
+      <field field_ref="hfxspr"           name="hfxspr"     />
+      <field field_ref="hfxcndtop"        name="hfxcndtop"  />
+      <field field_ref="hfxcndbot"        name="hfxcndbot"  />
+      <field field_ref="hfxsensib"        name="hfxsensib"  />
+      <field field_ref="hfxmelt"          name="hfxmelt"    />
+      <field field_ref="hfxldmelt"        name="hfxldmelt"  />
+      <field field_ref="hfxldgrow"        name="hfxldgrow"  />
+      <!-- salt fluxes -->
+      <field field_ref="sfxice"           name="sfxice"     />
+      <!-- mass fluxes -->
+      <field field_ref="vfxice"           name="vfxice"     />
+      <field field_ref="vfxsnw"           name="vfxsnw"     />
+      <field field_ref="vfxpnd"           name="vfxpnd"     />
+      <field field_ref="vfxsub"           name="vfxsub"     />
+      <field field_ref="vfxsub_err"       name="vfxsub_err" />
+      <field field_ref="vfxsnw_sub"       name="vfxsnw_sub" />
+      <field field_ref="vfxsnw_pre"       name="vfxsnw_pre" />
+    </field_group>
     <!--============================-->
     <!-- SIMIP sea ice field groups -->

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/SHARED/field_def_nemo-oce.xml

-                      r14224
+                      r14958
     <field id="mf_mf"       long_name="mass flux"              standard_name="mf_mass_flux"          unit="m"      grid_ref="grid_T_3D" />
+    <!-- fluxes from damping -->
+    <field id="sflx_dmp_cea"  long_name="salt flux due to damping"  standard_name="salt_flux_due_to_damping"          unit="g/m2/s"   />
+    <field id="hflx_dmp_cea"  long_name="heat flux due to damping"  standard_name="heat_flux_due_to_damping"          unit="W/m2"     />
   </field_group> <!-- grid_T -->
 …
     <field id="dh"                  long_name="Pycnocline thickness"                     unit=" m"      />
     <field id="ibld"                long_name="index of boundary layer depth"            unit="#"       />
+    <field id="imld"                long_name="index of mixed layer depth"            unit="#"       />
+    <field id="zhbl"                long_name="boundary layer depth -grid"                     unit="m"       />
+    <field id="zhml"                long_name="mixed layer depth - grid"                        unit="m"       />
+    <field id="imld"                long_name="index of mixed layer depth"               unit="#"       />
+    <field id="jp_ext"              long_name="flag =1 if pycnocline well resolved"      unit="#"       />
+    <field id="j_ddh"               long_name="index of mixed layer depth"               unit="#"       />
+    <field id="zshear"              long_name="shear production of TKE "                 unit="m^3/s^3" />
+    <field id="zhbl"                long_name="boundary layer depth -grid"               unit="m"       />
+    <field id="zhml"                long_name="mixed layer depth - grid"                 unit="m"       />
     <field id="zdh"                 long_name="Pycnocline  depth - grid"                 unit=" m"      />
     <field id="zustke"              long_name="magnitude of stokes drift  at T-points"   unit="m/s"     />
     <field id="us_x"        long_name="i component of active Stokes drift"                      unit="m/s"     />
     <field id="us_y"        long_name="j component of active Stokes drift"                      unit="m/s"     />
+    <field id="us_x"                long_name="i component of active Stokes drift"       unit="m/s"     />
+    <field id="us_y"                long_name="j component of active Stokes drift"       unit="m/s"     />
     <field id="dstokes"             long_name="stokes drift  depth scale"                unit="m"       />
     <field id="zwth0"               long_name="surface non-local temperature flux"       unit="deg m/s" />
     <field id="zws0"                long_name="surface non-local salinity flux"          unit="psu m/s" />
+    <field id="zwb0"                long_name="surface non-local buoyancy flux"          unit="m^2/s^3" />
     <field id="zwstrc"              long_name="convective velocity scale"                unit="m/s"     />
     <field id="zustar"              long_name="friction velocity"                        unit="m/s"     />
 …
     <!-- interior BL OSMOSIS diagnostics -->
     <field id="zwthav"              long_name="av turb flux of T in ml"                  unit="deg m/s" />
+    <field id="zwbav"               long_name="av turb flux of buoyancy in ml"           unit="m^2/s^3" />
     <field id="zt_ml"               long_name="av T in ml"                               unit="deg"     />
     <field id="zhol"                long_name="Hoenekker number"                         unit="#"       />
 …
     <field id="zwb_ent"            long_name="entrainment turb flux of buoyancy"         unit="m^2/s^-3" />
+    <field id="zdt_bl"             long_name="temperature jump at base of BL"                 unit="deg"      />
+    <field id="zds_bl"             long_name="salinity jump at base of BL"                 unit="10^-3"      />
+    <field id="zdb_bl"             long_name="buoyancy jump at base of BL"                 unit="m/s^2"      />
+    <field id="zdu_bl"             long_name="u jump at base of BL"                       unit="m/s"      />
+    <field id="zdv_bl"             long_name="v jump at base of BL"                       unit="m/s"      />
+    <field id="zdt_bl"             long_name="temperature jump at base of BL"            unit="deg"      />
+    <field id="zds_bl"             long_name="salinity jump at base of BL"               unit="10^-3"    />
+    <field id="zdb_bl"             long_name="buoyancy jump at base of BL"               unit="m/s^2"    />
+    <field id="zdu_bl"             long_name="u jump at base of BL"                      unit="m/s"      />
+    <field id="zdv_bl"             long_name="v jump at base of BL"                      unit="m/s"      />
+    <field id="zdt_ml"             long_name="temperature jump at base of ML"            unit="deg"      />
+    <field id="zds_ml"             long_name="salinity jump at base of ML"               unit="10^-3"    />
+    <field id="zdb_ml"             long_name="buoyancy jump at base of ML"               unit="m/s^2"    />
+    <field id="pb_coup"            long_name="bottom coupling velocity"                  unit="m/s"      />
     <!-- extra OSMOSIS diagnostics for debugging -->
     <field id="zsc_uw_1_0"       long_name="zsc u-momentum flux on T after Stokes"                       unit="m^2/s^2" />
 …
     <field id="zsc_uw_2_f"       long_name="2nd zsc u-momentum flux on T after Coriolis"                       unit="m^2/s^2" />
     <field id="zsc_vw_2_f"       long_name="2nd zsc v-momentum flux on T after Coriolis"                       unit="m^2/s^2" />
-    <field id="zuw_bse"       long_name="base u-flux T-points"                          unit="m^2/s^2" />
-    <field id="zvw_bse"       long_name="base v-flux T-points"                          unit="m^2/s^2" />
     <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.-->
 …
       <field id="emp_oce"      long_name="Evap minus Precip over ocean"         standard_name="evap_minus_precip_over_sea_water"                                     unit="kg/m2/s"   />
       <field id="emp_ice"      long_name="Evap minus Precip over ice"           standard_name="evap_minus_precip_over_sea_ice"                                       unit="kg/m2/s"   />
       <field id="saltflx"      long_name="Downward salt flux"                                                                                                        unit="1e-3/m2/s" />
+      <field id="saltflx"      long_name="Downward salt flux"                                                                                                        unit="g/m2/s"    />
       <field id="fmmflx"       long_name="Water flux due to freezing/melting"                                                                                        unit="kg/m2/s"   />
       <field id="snowpre"      long_name="Snow precipitation"                   standard_name="snowfall_flux"                                                        unit="kg/m2/s"   />
 …
       <field id="hflx_rain_cea" long_name="heat flux due to rainfall"                                standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"        unit="W/m2"     />
       <field id="hflx_evap_cea" long_name="heat flux due to evaporation"                             standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"   unit="W/m2"     />
+      <field id="hflx_subl_cea" long_name="heat flux due to sublimation (from atm. forcings)"        standard_name="temperature_flux_due_to_sublimation_expressed_as_heat_flux_out_of_sea_ice"     unit="W/m2"     />
       <field id="hflx_prec_cea" long_name="heat flux due to all precip"                              standard_name="temperature_flux_due_to_all_precip_expressed_as_heat_flux_into_sea_water"      unit="W/m2"     />
       <field id="hflx_snow_cea" long_name="heat flux due to snow falling"                            standard_name="heat_flux_onto_ocean_and_ice_due_to_snow_thermodynamics"                       unit="W/m2"     />
 …
       <field id="hflx_ice_cea"  long_name="heat flux due to ice thermodynamics"                      standard_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics"                        unit="W/m2"     />
       <field id="hflx_rnf_cea"  long_name="heat flux due to runoffs"                                 standard_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water"          unit="W/m2"     />
+      <field id="sflx_rnf_cea"  long_name="salt flux due to runoffs"                                 standard_name="salt_flux_due_to_runoffs"                                                      unit="g/m2/s"   />
       <field id="hflx_cal_cea"  long_name="heat flux due to calving"                                 standard_name="heat_flux_into_sea_water_due_to_calving"                                       unit="W/m2"     />
       <field id="hflx_icb_cea"  long_name="heat flux due to iceberg"                                 standard_name="heat_flux_into_sea_water_due_to_icebergs"                                      unit="W/m2"     />
 …
       <field id="ticemel_cea"   long_name="Rate of Melt at Upper Surface of Sea Ice (cell average)"  standard_name="tendency_of_sea_ice_amount_due_to_surface_melting"                             unit="kg/m2/s"  />
+      <!-- fluxes from relaxation and freshwater budget -->
+      <field id="sflx_ssr_cea"  long_name="salt flux due to restoring"    standard_name="salt_flux_due_to_restoring"    unit="g/m2/s"   />
+      <field id="hflx_ssr_cea"  long_name="heat flux due to restoring"    standard_name="heat_flux_due_to_restoring"    unit="W/m2"     />
+      <field id="vflx_ssr_cea"  long_name="volume flux due to restoring"  standard_name="volume_flux_due_to_restoring"  unit="kg/m2/s"  />
+      <field id="hflx_fwb_cea"  long_name="heat flux due to fwb"          standard_name="heat_flux_due_to_fwb"          unit="W/m2"     />
+      <field id="vflx_fwb_cea"  long_name="volume flux due to fwb"        standard_name="volume_flux_due_to_fwb"        unit="kg/m2/s"  />
       <!-- ice field (nn_ice=1)  -->
       <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            />
 …
   </field_group>
+  <!--============================-->
+  <!--  CONSERVATION diagnostics  -->
+  <!--============================-->
+  <!-- BE CAREFUL: this group (OCE_budget) cannot be called in file_def.xml as such (unless nn_fsbc=1)
+                   If doing so, the last output (in time) of the netcdf file
+         would be corrupted (NaN values). However calling each of these
+         variables directly in the file_def.xml works. It is probably
+         because there is a mix up of sbc variables with other variables
+    -->
+  <field_group id="OCE_budget"        grid_ref="grid_T_2D" >
+    <field field_ref="sst"                 name="tos"          />
+    <field field_ref="sss"                 name="sos"          />
+    <field field_ref="ssh"                 name="zos"          />
+    <!-- mass flux -->
+    <field field_ref="empmr"               name="empmr"        />
+    <field field_ref="runoffs"             name="runoffs"      />
+    <field field_ref="emp_ice"             name="emp_ice"      />
+    <field field_ref="emp_oce"             name="emp_oce"      />
+    <field field_ref="iceshelf_cea"        name="iceshelf"     />
+    <field field_ref="iceberg_cea"         name="iceberg"      />
+    <field field_ref="calving_cea"         name="calving"      />
+    <!-- <field field_ref="berg_floating_melt"  name="calving" /> -->
+    <field field_ref="precip"              name="precip"       />
+    <field field_ref="snowpre"             name="snowpre"      />
+    <field field_ref="rain"                name="rain"         />
+    <field field_ref="evap_ao_cea"         name="evap_ao"      />
+    <field field_ref="subl_ai_cea"         name="subl_ai"      />
+    <field field_ref="snow_ai_cea"         name="snow_ai"      />
+    <field field_ref="snow_ao_cea"         name="snow_ao"      />
+    <!-- heat flux -->
+    <field field_ref="qsr"                 name="qsr"          />
+    <field field_ref="qns"                 name="qns"          />
+    <field field_ref="qt_oce"              name="qt_oce"       />
+    <field field_ref="qemp_oce"            name="qemp_oce"     />
+    <field field_ref="hflx_rain_cea"       name="hflx_rain"    />
+    <field field_ref="hflx_evap_cea"       name="hflx_evap"    />
+    <field field_ref="hflx_snow_cea"       name="hflx_snow"    />
+    <field field_ref="hflx_snow_ao_cea"    name="hflx_snow_ao" />
+    <field field_ref="hflx_snow_ai_cea"    name="hflx_snow_ai" />
+    <field field_ref="hflx_rnf_cea"        name="hflx_rnf"     />
+    <field field_ref="hflx_icb_cea"        name="hflx_icb"     />
+    <field field_ref="hflx_isf_cea"        name="hflx_isf"     />
+    <!-- salt flux (includes ssr) -->
+    <field field_ref="saltflx"             name="saltflx"      />
+    <field field_ref="sflx_rnf_cea"        name="sflx_rnf"     />
+    <!-- relaxation and damping -->
+    <field field_ref="hflx_ssr_cea"        name="hflx_ssr"     />
+    <field field_ref="vflx_ssr_cea"        name="vflx_ssr"     />
+    <field field_ref="sflx_ssr_cea"        name="sflx_ssr"     />
+    <field field_ref="hflx_dmp_cea"        name="hflx_dmp"     />
+    <field field_ref="sflx_dmp_cea"        name="sflx_dmp"     />
+    <field field_ref="hflx_fwb_cea"        name="hflx_fwb"     />
+    <field field_ref="vflx_fwb_cea"        name="vflx_fwb"     />
+  </field_group>
+  <field_group id="OCE_globalbudget"  grid_ref="grid_scalar" >
+    <field field_ref="voltot"              name="scvoltot"     />
+    <field field_ref="saltot"              name="scsaltot"     />
+    <field field_ref="temptot"             name="sctemtot"     />
+  </field_group>
 </field_definition>

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/SHARED/namelist_ref

-                      r14433
+                      r14958
 !-----------------------------------------------------------------------
    ln_tile = .false.     !  Use tiling (T) or not (F)
    nn_ltile_i = 10       !  Length of tiles in i
+   nn_ltile_i = 99999    !  Length of tiles in i
    nn_ltile_j = 10       !  Length of tiles in j
+/
 …
                                !  = 2:use surface value of SD fit to slope at rn_osm_hblfrac*hbl below surface
    ln_zdfosm_ice_shelter = .true.  ! reduce surface SD and depth scale under ice
    ln_osm_mle = .false.        !  Use integrated FK-OSM model
+   ln_osm_mle = .true.         !  Use integrated FK-OSM model
+/
 !-----------------------------------------------------------------------
 …
    nn_osm_mle          = 0         ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
    rn_osm_mle_lf       = 5.e+3     ! typical scale of mixed layer front (meters)                      (case rn_osm_mle=0)
    rn_osm_mle_time     = 172800.   ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_osm_mle=0)
+   rn_osm_mle_time     = 43200.    ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_osm_mle=0)
    rn_osm_mle_lat      = 20.       ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1)
    rn_osm_mle_rho_c =    0.01      ! delta rho criterion used to calculate MLD for FK
    rn_osm_mle_thresh  = 0.0005     ! delta b criterion used for FK MLE criterion
    rn_osm_mle_tau     = 172800.    ! time scale for FK-OSM (seconds)  (case rn_osm_mle=0)
    ln_osm_hmle_limit   = .false.   ! limit hmle to rn_osm_hmle_limit*hbl
    rn_osm_hmle_limit   = 1.2
+   rn_osm_mle_rho_c    = 0.03      ! delta rho criterion used to calculate MLD for FK
+   rn_osm_mle_thresh   = 0.0001    ! delta b criterion used for FK MLE criterion
+   rn_osm_mle_tau      = 172800.   ! time scale for FK-OSM (seconds)  (case rn_osm_mle=0)
+   ln_osm_hmle_limit   = .true.    ! If true, limit hmle to rn_osm_hmle_limit*hbl
+   rn_osm_hmle_limit   = 1.5
+   /
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/SPITZ12/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       !                    !  (=F) user defined configuration           (F => create/check namusr_def)
       cn_domcfg = "domain_cfg"  ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/cfgs/WED025/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       !                    !  (=F) user defined configuration           (F => create/check namusr_def)
       cn_domcfg = "domain_cfg"  ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/doc/latex/TOP/main/abstract.tex

r11591	r14958
24	24	it includes different sub-modules: ocean water age, inorganic carbon (CFCs) \& radiocarbon (C14b),
25	25	built-in biogeochemical model (PISCES), and prototype for user-defined cases or
26		coupling with alternative biogeochemical models (\eg \href{http://www.bfm-community.eu}{BFM}).
	26	coupling with alternative biogeochemical models (\eg, \href{http://www.bfm-community.eu}{BFM}).

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/doc/latex/TOP/main/authors.tex

r11591	r14958
5	5	Georges Nurser \\
6	6	Julien Palmi\'{e}ri \\
	7	Renaud Person \\
7	8	Andrew Yool

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/doc/latex/TOP/main/bibliography.bib

-                      r14374
+                      r14958
+}
+@article{         getzlaff_2013,
+  author        = {Getzlaff, Julia and Dietze, Heiner},
+  title         = {Effects of increased isopycnal diffusivity
+                  mimicking the unresolved equatorial intermediate
+                  current system in an earth system climate model},
+  year          = {2013},
+  volume        = {40},
+  number        = {10},
+  pages         = {2166--2170},
+  doi           = {10.1002/grl.50419},
+  url           = {https://dx.doi.org/10.1002/grl.50419},
+  journal       = {Geophysical Research Letters},
+  publisher     = {Wiley Online Library}
+}
 @techreport{      gibson_trpt86,
   title         = "Standards for software development and maintenance",
 …
   journal   = {Limnology and Oceanography},
   publisher = {Wiley}
+}
+@Article{         mathiot_explicit_2017,
+  author        = {Mathiot, Pierre and Jenkins, Adrian and Harris, Christopher
+                  and Madec, Gurvan},
+  title         = {Explicit representation and parametrised impacts of under
+                  ice shelf seas in the z∗ coordinate ocean model {NEMO} 3.6},
+  year          = {2017},
+  volume        = {10},
+  number        = {7},
+  month         = jul,
+  pages         = {2849--2874},
+  issn          = {1991-9603},
+  doi           = {10.5194/gmd-10-2849-2017},
+  url           = {https://www.geosci-model-dev.net/10/2849/2017/},
+  journal       = {Geoscientific Model Development},
+  publisher = {Copernicus GmbH}
+}
 …
+}
+@Article{         person_sensitivity_2019,
+  author        = {Person, Renaud and Aumont, Olivier and Madec, Gurvan and
+                   Vancoppenolle, Martin and Bopp, Laurent and Merino, Nacho},
+  title         = {Sensitivity of ocean biogeochemistry to the iron supply from the
+                  {Antarctic} {Ice} {Sheet} explored with a biogeochemical model},
+  year          = {2019},
+  volume        = {16},
+  number        = {18},
+  month         = sep,
+  pages         = {3583--3603},
+  issn          = {1726-4189},
+  doi           = {10.5194/bg-16-3583-2019},
+  url           = {https://www.biogeosciences.net/16/3583/2019/},
+  journal       = {Biogeosciences},
+  publisher = {Copernicus GmbH}
+}
 @Article{     reimer_2013,
   author = {Reimer, Paula J and Bard, Edouard and Bayliss, Alex and
 …
   publisher = {Elsevier BV}
+}

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/doc/latex/TOP/main/introduction.tex

-                      r11591
+                      r14958
 \begin{itemize}
         \item a transport code TRP sharing the same advection/diffusion routines with the dynamics, with specific treatment of some features like the surface boundary
 conditions, or the positivity of passive tracers concentrations
+conditions or the positivity of passive tracers concentrations
         \item sources and sinks - SMS - models that can be typically biogeochemical, biological or radioactive
         \item an offline option which is a simplified OPA 9 model using fields of physics variables that are previously stored to disk
+        \item an offline option which is a simplified OPA 9 model using fields of physical variables that were previously stored on disk
 \end{itemize}
 There is two ways of coupling TOP to the dynamics :
+There are two ways of coupling TOP to the dynamics :
 \begin{itemize}
         \item \textit{online coupling} : the evolution of passive tracers is computed along with the dynamics
         \item \textit{offline coupling} : the fields of physics variables are read from files and interpolated at each model time step, with no constraints on the time sampling in the input files
+        \item \textit{offline coupling} : the physical variable fields are read from files and interpolated at each model time step, with no constraints on the temporal sampling in the input files
 \end{itemize}
 TOP is designed to handle multiple oceanic tracers through a modular approach and it includes different sub-modules :
+TOP is designed to handle multiple oceanic tracers through a modular approach and includes different sub-modules :
 \begin{itemize}
         \item the ocean water age module (AGE) tracks down the time-dependent spread of surface waters into the ocean interior
         \item inorganic carbon (e.g. CFCs, SF6) and radiocarbon (C14) passive tracers can be modeled to assess ocean absorption timescales of anthropogenic emissions and further address water masses ventilation
+        \item inorganic (\eg, CFCs, SF6) and radiocarbon (C14) passive tracers can be modeled to assess ocean absorption timescales of anthropogenic emissions and further address water masses ventilation
         \item a built-in biogeochemical model (PISCES) to simulate lower trophic levels ecosystem dynamics in the global ocean
         \item a prototype tracer module (MY\_TRC) to enable user-defined cases or the coupling with alternative biogeochemical models ( e.g. BFM, MEDUSA, ERSEM, BFM, ECO3M)
+        \item a prototype tracer module (MY\_TRC) to enable user-defined cases or the coupling with alternative biogeochemical models (\eg, BFM, MEDUSA, ERSEM, BFM, ECO3M)
 \end{itemize}
 …
 \vspace{0cm}
 \includegraphics[width=0.80\textwidth]{Fig_TOP_design}
+%\includegraphics[height=6cm,angle=-00]{Fig_TOP_design}
+\caption{A schematic view of NEMO-TOP component}
+\caption{Schematic view of the NEMO-TOP component}
 \label{topdesign}
 \end{center}

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/doc/latex/TOP/subfiles/miscellaneous.tex

-                      r14239
+                      r14958
 \section{TOP synthetic Workflow}
+\subsection{Model initialization}
+A synthetic description of the TOP interface workflow is given below to summarize the steps involved in the computation of biogeochemical and physical trends and their time integration and outputs, by reporting also the principal Fortran subroutine herein involved.
+\subsection{Time marching procedure}
+%\begin{figure}[!h]
+%  \centering
+%  \includegraphics[width=0.80\textwidth]{Top_FlowChart}
+%  \caption{Schematic view of NEMO-TOP flowchart}
+%  \label{img_cfcatm}
+%\end{figure}
+\begin{minted}{bash}
+nemogcm
+    !
+    nemo_init           !   NEMO General Initialisations
+         !
+         trc_init                              ! TOP  Initialisations
+    !
+    stp()                   !   NEMO Time-stepping
+        !
+        trc_stp()                            ! TOP time-stepping
+            !
+            trc_wri()           ! I/O manager : Output of passive tracers
+            trc_sms()           ! Sinks and sources program manager
+            trc_trp()            ! Transport of passive tracers
+            trc_rst_wri()      ! Write tracer restart file
+            trd_mxl_trc()     ! trends: Mixed-layer
+\end{minted}
+\subsection{Model initialization (./src/TOP/trcini.F90)}
+This module consists on inital set up of passive tracers variables and parameters  : read the namelist, set initial tracer fields (either read restart or read data or analytical formulation and  specific initailisation in each SMS module  ( analytical initialisation of tracers or constant values )
+\begin{minted}{bash}
+trc_init                              ! TOP  Initialisations
+    !
+    IF( PISCES )    trc_ini_pisces()     !  PISCES bio model
+    IF( MY_TRC)    trc_ini_my_trc()    !  MY_TRC model
+    IF( CFCs     )    trc_ini_cfc   ()       !  CFCs
+    IF( C14       )    trc_ini_c14   ()       !  C14 model
+    IF( AGE      )    trc_ini_age   ()       !  AGE tracer
+    !
+    IF( REST   )    trc_rst_read()         ! Restart from a file
+    ELSE            trc_dta()                   ! Initialisation from data
+\end{minted}
+\subsection{BGC trends computation (./src/TOP/trcsms.F90)}
+This is the main module where the passive tracers source minus sinks of each TOP sub-module is managed.
+\begin{minted}{bash}
+trc_sms()                               ! Sinks and sources prooram manager
+    !
+    IF( PISCES  )    trc_sms_pisces()         ! main program of PISCES
+    IF( CFCs     )    trc_sms_cfc()               ! surface fluxes of CFC
+    IF( C14       )    trc_sms_c14()               ! surface fluxes of C14
+    IF( AGE       )    trc_sms_age()              ! Age tracer
+    IF( MY_TRC)    trc_sms_my_trc()         ! MY_TRC  tracers
+\end{minted}
+\subsection{Physical trends computation (./src/TOP/TRP/trctrp.F90)}
+This is the main module where the passive tracers transport is managed. All the physical trends is calculated ( advective \& diffusive trends, surface BC from freshwater or external inputs )
+\begin{minted}{bash}
+trc_trp()       ! Transport of passive tracers
+    !
+    trc_sbc()         ! Surface boundary condition of freshwater flux
+    trc_bc()           ! Surface and lateral Boundary Conditions
+    trc_ais()          ! Tracers from Antarctic Ice Sheet (icb, isf)
+    trc_bbl()          ! Advective (and/or diffusive) bottom boundary layer scheme
+    trc_dmp()        ! Internal damping trends
+    trc_bdy()         ! BDY damping trends
+    trc_adv()         ! Horizontal & Vertical advection
+    trc_ldf()           ! Lateral mixing
+    trc_zdf()          ! Vert. mixing & after tracer
+    trc_atf()           ! Time filtering of "now" tracer fields
+    trc_rad()         ! Correct artificial negative concentrations
+\end{minted}
+\subsection{Outputs  (./src/TOP/TRP/trcwri.F90)}
+This is the main module where the passive tracer outputs of each TOP sub-module is managed using the I/O library XIOS.
+\begin{minted}{bash}
+trc_wri()                               ! I/O manager : Output of passive tracers
+!
+IF( PISCES   )    trc_wri_pisces()      ! Output of PISCES diagnostics
+IF( CFCs      )    trc_wri_cfc()            ! Output of Cfcs diagnostics
+IF( C14         )    trc_wri_c14()           ! surface fluxes of C14
+IF( AGE        )    trc_wri_age()           ! Age tracer
+IF( MY_TRC )    trc_wri_my_trc()      ! MY_TRC  tracers
+\end{minted}
 \section{Coupling an external BGC model using NEMO framework}
 …
 \end{minted}
 the compilation with \textit{makenemo} will be executed through the following syntax
+The compilation with \textit{makenemo} will be executed through the following syntax
 \begin{minted}{bash}
    makenemo -n NEMO_MYBGC -m <arch_my_machine> -j 8 -e <MYBGCPATH>
 \end{minted}
+%The makenemo feature ?-e? was introduced to readdress at compilation time the standard MY_SRC folder (usually found in NEMO configurations) with a user defined external one.
+%
+%
+%The compilation of more articulated BGC model code & infrastructure, like in the case of BFM (?BFM-NEMO coupling manual), requires some additional features.
+%
+%As before, let?s assume a coupled configuration name NEMO_MYBGC, but in this case MYBGC model root becomes <MYBGCPATH> that contains 4 different subfolders for biogeochemistry, named initialization, pelagic, and benthic, and a separate one named nemo_coupling including the modified MY_SRC routines. The latter folder containing the modified NEMO coupling interface will be still linked using the makenemo ?-e? option.
+%
 %In order to include the BGC model subfolders in the compilation of NEMO code, it will be necessary to extend the configuration cpp_NEMO_MYBGC.fcm file to include the specific paths of MYBGC folders, as in the following example
+%
+The makenemo feature \textit{-e} was introduced to readdress at compilation time the standard MY\_SRC folder (usually found in NEMO configurations) with a user defined external one. \\ \\
+The compilation of more articulated BGC model code \& infrastructure, like in the case of BFM (BFM-NEMO coupling manual), requires some additional features. \\ \\
+As before, let's assume a coupled configuration name NEMO\_MYBGC, but in this case MYBGC model root becomes <MYBGCPATH> that contains 4 different subfolders for biogeochemistry, named initialization, pelagic, and benthic, and a separate one named nemo\_coupling including the modified MY\_SRC routines. The latter folder containing the modified NEMO coupling interface will be still linked using the makenemo \textit{-e} option. \\ \\
+In order to include the BGC model subfolders in the compilation of NEMO code, it will be necessary to extend the configuration \textit{cpp\_NEMO\_MYBGC.fcm} file to include the specific paths of MYBGC folders, as in the following example
 \begin{minted}{bash}
    bld::tool::fppkeys   key_xios key_top
 …
    bld::pp::MYBGC      1
    bld::tool::fppflags::MYBGC   %FPPFLAGS
    bld::tool::fppkeys   %bld::tool::fppkeys MYBGC_MACROS
+   bld::tool::fppflags::MYBGC   \%FPPFLAGS
+   bld::tool::fppkeys                  \%bld::tool::fppkeys MYBGC_MACROS
 \end{minted}
+%where MYBGC_MACROS is the space delimited list of macros used in MYBGC model for selecting/excluding specific parts of the code. The BGC model code will be preprocessed in the configuration BLD folder as for NEMO, but with an independent path, like NEMO_MYBGC/BLD/MYBGC/<subforlders>.
+%
+%The compilation will be performed similarly to in the previous case with the following
+%
+%makenemo -n NEMO_MYBGC -m <arch_my_machine> -j 8 -e <MYBGCPATH>/nemo_coupling
+%Note that, the additional lines specific for the BGC model source and build paths, can be written into a separate file, e.g. named MYBGC.fcm, and then simply included in the cpp_NEMO_MYBGC.fcm as follow
+%
+%bld::tool::fppkeys  key_zdftke key_dynspg_ts key_xios key_top
+%inc <MYBGCPATH>/MYBGC.fcm
+%This will enable a more portable compilation structure for all MYBGC related configurations.
+%
+%Important: the coupling interface contained in nemo_coupling cannot be added using the FCM syntax, as the same files already exists in NEMO and they are overridden only with the readdressing of MY_SRC contents to avoid compilation conflicts due to duplicate routines.
+%
+%All modifications illustrated above, can be easily implemented using shell or python scripting to edit the NEMO configuration cpp.fcm file and to create the BGC model specific FCM compilation file with code paths.
+where MYBGC\_MACROS is the space delimited list of macros used in MYBGC model for selecting/excluding specific parts of the code. The BGC model code will be preprocessed in the configuration BLD folder as for NEMO, but with an independent path, like NEMO\_MYBGC/BLD/MYBGC/<subfolders>.\\
+The compilation will be performed similarly to in the previous case with the following
+\begin{minted}{bash}
+makenemo -n NEMO_MYBGC -m <arch_my_machine> -j 8 -e <MYBGCPATH>/nemo_coupling
+\end{minted}
+Note that, the additional lines specific for the BGC model source and build paths, can be written into a separate file, e.g. named MYBGC.fcm, and then simply included in the cpp\_NEMO\_MYBGC.fcm as follow:
+\begin{minted}{bash}
+bld::tool::fppkeys  key_zdftke key_dynspg_ts key_xios key_top
+inc <MYBGCPATH>/MYBGC.fcm
+\end{minted}
+This will enable a more portable compilation structure for all MYBGC related configurations.  \\ \\
+Important: the coupling interface contained in nemo\_coupling cannot be added using the FCM syntax, as the same files already exists in NEMO and they are overridden only with the readdressing of MY\_SRC contents to avoid compilation conflicts due to duplicate routines.  \\ \\
+All modifications illustrated above, can be easily implemented using shell or python scripting to edit the NEMO configuration cpp.fcm file and to create the BGC model specific FCM compilation file with code paths.
 \end{document}

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/doc/latex/TOP/subfiles/model_description.tex

-                      r14375
+                      r14958
 \label{sec:Bas}
 The time evolution of any passive tracer $C$ follows the transport equation, which is similar to that of active tracer - temperature or salinity :
+The time evolution of any passive tracer $C$ is given by the transport equation, which is similar to that of active tracer - temperature or salinity :
 \begin{equation}
 …
 \end{equation}
 where expressions of $D^{lC}$ and $D^{vC}$ depend on the choice for the lateral and vertical subgrid scale parameterizations, see equations 5.10 and 5.11 in \citep{nemo_manual}
 {S(C)} , the first term on the right hand side of \autoref{Eq_tracer}; is the SMS - Source Minus Sink - inherent to the tracer.
 In the case of biological tracer such as phytoplankton, {S(C)} is the balance between phytoplankton growth and its decay through mortality and grazing.
 In the case of a tracer comprising carbon,  {S(C)} accounts for gas exchange, river discharge, flux to the sediments, gravitational sinking and other biological processes.
 In the case of a radioactive tracer, {S(C)} is simply loss due to radioactive decay.
+where expressions of $D^{lC}$ and $D^{vC}$ depend on the choice for the lateral and vertical subgrid scale parameterizations (see Equations 5.10 and 5.11 in \cite{nemo_manual}).
+{S(C)}, the first term on the right hand side of \autoref{Eq_tracer}, is the SMS - Sources Minus Sinks - inherent to the tracer.
+In the case of a biological tracer such as phytoplankton, {S(C)} is the balance between phytoplankton growth and its loss through mortality and grazing.
+In the case of a tracer comprising carbon,  {S(C)} accounts for gas exchange, river discharge, flux to the sediments, gravitational sinking and other biogeochemical processes.
+In the case of a radioactive tracer, {S(C)} is simply the loss due to radioactive decay.
 The second term (within brackets) represents the advection of the tracer in the three directions.
 …
 The third term  represents the change due to lateral diffusion.
 The fourth term is change due to vertical diffusion, parameterized as eddy diffusion to represent vertical turbulent fluxes :
+The fourth term denotes the change due to vertical diffusion, parameterized as eddy diffusion to represent vertical turbulent fluxes :
 \begin{equation}
 …
 \end{equation}
 where $A^{vT}$ is the vertical eddy diffusivity coefficient of active tracers
+where $A^{vT}$ is the vertical eddy diffusivity coefficient of active tracers.
 \section{The NEMO-TOP interface}
 \label{sec:TopInt}
 TOP is the NEMO hardwired interface toward biogeochemical models and provide the physical constraints/boundaries for oceanic tracers.
+TOP is the NEMO hardwired interface toward biogeochemical models, which provides the physical constraints/boundaries for oceanic tracers.
 It consists of a modular framework to handle multiple ocean tracers, including also a variety of built-in modules.
 This component of the NEMO framework allows one to exploit available modules  and further develop a range of applications, spanning from the implementation of a dye passive tracer to evaluate dispersion processes (by means of MY\_TRC), track water masses age (AGE module), assess the ocean interior penetration of persistent chemical compounds (e.g., gases like CFC or even PCBs), up to the full set of equations involving marine biogeochemical cycles.
+This component of the NEMO framework allows one to exploit available modules  and further develop a range of applications, spanning from the implementation of a dye passive tracer to evaluate dispersion processes (by means of MY\_TRC), track water masses age (AGE module), assess the ocean interior penetration of persistent chemical compounds (e.g., gases like CFC or even PCBs), up to the full set of equations to simulate marine biogeochemical cycles.
 TOP interface has the following location in the code repository : \path{<repository>/src/TOP/}
 …
 \begin{itemize}
         \item \textbf{TRP}           :    Interface to NEMO physical core for computing tracers transport
         \item \textbf{CFC}     :    Inert carbon tracers (CFC11,CFC12, SF6)
+        \item \textbf{CFC}     :    Inert tracers (CFC11,CFC12, SF6)
         \item \textbf{C14}     :    Radiocarbon passive tracer
         \item \textbf{AGE}     :    Water age tracking
         \item \textbf{MY\_TRC}  :   Template for creation of new modules and external BGC models coupling
+        \item \textbf{PISCES}    :   Built in BGC model.
+See \citep{aumont_2015} for a throughout description.
+        \item \textbf{PISCES}    :   Built in BGC model. See \cite{aumont_2015} for a complete description
 \end{itemize}
 %  ----------------------------------------------------------
 …
 \section{The transport component : TRP}
 The passive tracer transport component  shares the same advection/diffusion routines with the dynamics, with specific treatment of some features like the surface boundary conditions, or the positivity of passive tracers concentrations.
+The passive tracer transport component shares the same advection/diffusion routines with the dynamics, with specific treatment of some features like the surface boundary conditions, or the positivity of passive tracers concentrations.
 \subsection{Advection}
+The advection schemes used for the passive tracers are the same as those used for $T$ and $S$. They are described in section 5.1 of \cite{nemo_manual}.
+The choice of an advection scheme can be selected independently and can differ from the ones used for active tracers.
+This choice is made in \textit{namelist\_to}p (ref or cfg) in the namelist block \textit{namtrc\_adv}, by setting to \textit{true} one and only one of the logicals \textit{ln\_trcadv\_xxx}, the same way of what is done for dynamics.
+cen2, MUSCL2, and UBS are not \textit{positive} schemes meaning that negative values can appear in an initially strictly positive tracer field which is advected, implying that artificial extrema are permitted. Their use is not recommended for passive tracers.
 %------------------------------------------namtrc_adv----------------------------------------------------
 \nlst{namtrc_adv}
+%-------------------------------------------------------------------------------------------------------------
+The advection schemes used for the passive tracers are the same than the ones for $T$ and $S$ and described in section 5.1 of \citep{nemo_manual}.
+The choice of an advection scheme  can be selected independently and  can differ from the ones used for active tracers.
+This choice is made in the \textit{namtrc\_adv} namelist, by  setting to \textit{true} one and only one of the logicals \textit{ln\_trcadv\_xxx}, the same way of what is done for dynamics.
+cen2, MUSCL2, and UBS are not \textit{positive} schemes meaning that negative values can appear in an initially strictly positive tracer field which is advected, implying that false extrema are permitted.
+Their use is not recommended on passive tracers
+%----------------------------------------------------------------------------------------------------------
 \subsection{Lateral diffusion}
+In NEMO v4.0, diffusion of passive tracers has necessarily the same form as the active tracer diffusion, meaning that the numerical scheme must be the same.
+However the passive tracer mixing coefficient can be chosen as a multiple of the active ones by changing the value of \textit{rn\_ldf\_multi} in namelist \textit{namtrc\_ldf}.
+The choice of the numerical scheme is then set in the \forcode{&namtra_ldf} namelist section for the dynamic described in section 5.2 of \cite{nemo_manual}.
+rn\_fact\_lap is a factor used to increase zonal equatorial diffusion for depths beyond 200 m. It can be useful to achieve a better representation of Oxygen Minimum Zone (OMZ) in some biogeochemical models, especially at coarse resolution \citep{getzlaff_2013}.
 %------------------------------------------namtrc_ldf----------------------------------------------------
 \nlst{namtrc_ldf}
+%-------------------------------------------------------------------------------------------------------------
+In NEMO v4.0, the passive tracer diffusion has necessarily the same form as the active tracer diffusion, meaning that the numerical scheme must be the same.
+However the passive tracer mixing coefficient can be chosen as a multiple of the active ones by changing the value of \textit{rn\_ldf\_multi} in namelist \textit{namtrc\_ldf}.
+The choice of numerical scheme is then set in the \forcode{&namtra_ldf} namelist for the dynamic described in section 5.2 of \citep{nemo_manual}.
+%---------------------------------------------------------------------------------------------------------
 %-----------------We also offers the possibility to increase zonal equatorial diffusion for passive tracers by introducing an enhanced zonal diffusivity coefficent in the equatorial domain which can be defined by the equation below :
 …
 \subsection{Tracer damping}
+The use of newtonian damping  to climatological fields or observations is also coded, sharing the same routine as that of active tracers.
+Boolean variables are defined in the namelist\_top\_ref to select the tracers on which restoring is applied.
+Options are defined through the \textit{\&namtrc\_dmp} namelist variables.
+The restoring term is added when the namelist parameter \textit{ln\_trcdmp} is set to \textit{true}.
+The restoring coefficient is a three-dimensional array read in a file, whose name is specified by the namelist variable \textit{cn\_resto\_tr}.
+This netcdf file can be generated using the DMP\_TOOLS tool.
 %------------------------------------------namtrc_dmp----------------------------------------------------
 \nlst{namtrc_dmp}
+%-------------------------------------------------------------------------------------------------------------
+The use of newtonian damping  to climatological fields or observations is also coded, sharing the same routine dans active tracers.
+Boolean variables are defined in the namelist\_top\_ref to select the tracers on which restoring is applied
+Options are defined through the \nam{trc_dmp}{trc\_dmp} namelist variables.
+The restoring term is added when the namelist parameter \np{ln\_trcdmp} is set to true.
+The restoring coefficient is a three-dimensional array read in a file, which name is specified by the namelist variable \np{cn\_resto\_tr}.
+This netcdf file can be generated using the DMP\_TOOLS tool.
+%-----------------------------------------------------------------------------------------------------------
 \subsection{Tracer positivity}
+Some numerical schemes can generate negative values of passive tracers concentration, which is obviously unrealistic.
+For example,  isopycnal diffusion can created local extrema, meaning that negative concentrations can be generated.
+The trcrad routine artificially corrects negative concentrations with a very crude solution that either sets negative concentrations to zero without adjusting the tracer budget (CFCs or C14 chemical coumpounds), or by removing negative concentrations while computing the corresponding tracer content that is added and then, adjusting the tracer concentration using a multiplicative factor so that the total tracer concentration is preserved (PISCES model).
+The treatment of negative concentrations is an option and can be selected in the namelist \textit{\&namtrc\_rad} by setting the parameter \textit{ln\_trcrad}  to true.
 %------------------------------------------namtrc_rad----------------------------------------------------
 \nlst{namtrc_rad}
+%-------------------------------------------------------------------------------------------------------------
+Sometimes, numerical scheme can generates negative values of passive tracers concentration that must be positive.
+For exemple,  isopycnal diffusion can created extrema.
+The trcrad routine artificially corrects negative concentrations with a very crude solution that either sets negative concentration to zero without adjusting the tracer budget, or by removing negative concentration and keeping mass conservation.
+The treatment of negative concentrations is an option and can be selected in the namelist \nam{trc_rad}{trc\_rad} by setting the parameter \np{ln\_trcrad}  to true.
+%----------------------------------------------------------------------------------------------------------
+\subsection{Tracer boundary conditions}
+In NEMO, different types of boundary conditions can be specified for biogeochemical tracers. For every single variable, it is possible to define a field of surface boundary conditions, such as deposition of dust or nitrogen, which is then interpolated to the grid and timestep using the fld\_read function. The same facility is available to include river inputs or coastal erosion (coastal boundary conditions) and the treatment of open boundary conditions. For lateral boundary conditions, spatial interpolation should not be activated.
+%------------------------------------------namtrc_bc----------------------------------------------------
+\nlst{namtrc_cfg}
+%---------------------------------------------------------------------------------------------------------
+\subsubsection{Surface and lateral boundaries}
+The namelist \textit{\&namtrc\_bc}  is in file \textit{namelist\_top\_cfg}  and allows to specify the name of the files, the frequency of the input and the time and space interpolation as done for any other field using the fld\_read interface.
+%------------------------------------------namtrc_bc----------------------------------------------------
+\nlst{namtrc_bc}
+%---------------------------------------------------------------------------------------------------------
+\subsubsection{Open boundaries}
+The BDY for passive tracer are set together with the physical oceanic variables (lnbdy  =.true.). Boundary conditions are set in the structure used to define the passive tracer properties in the « cbc » column. These boundary conditions are applied on the segments defined for the physical core of NEMO (see BDY description in the User Manual).
+\begin{itemize}
+   \item cn\_trc\_dflt : the type of OBC applied to all the tracers
+   \item cn\_trc :  the boundary condition used for tracers with data file
+\end{itemize}
+%------------------------------------------namtrc_bdy----------------------------------------------------
+\nlst{namtrc_bdy}
+%----------------------------------------------------------------------------------------------------------
+\subsubsection{Sedimentation of particles}
+This module computes the vertical flux of particulate matter due to gravitational sinking. It also offers a temporary solution for the problem that may arise in specific situation where the CFL criterion is broken for vertical sedimentation of particles. To avoid this, a time splitting algorithm has been coded. The number of iterations niter necessary to respect the CFL criterion is dynamically computed. A specific maximum number of iterations nitermax may be specified in the namelist. This is to avoid a very large number of iterations when explicit free surface is used, for instance. If niter is larger than the prescribed nitermax, sinking speeds are clipped so that the CFL criterion is respected. The numerical scheme used to compute sedimentation is based on the MUSCL advection scheme.
+%------------------------------------------namtrc_bdy----------------------------------------------------
+\nlst{namtrc_snk}
+%----------------------------------------------------------------------------------------------------------
+\subsubsection{Sea-ice growth and melt effect}
+NEMO provides three options for the specification of tracer concentrations in sea ice: (-1) identical tracer concentrations in sea ice and ocean, which corresponds to no concentration/dilution effect upon ice growth and melt; (0) zero concentrations in sea ice, which gives the largest concentration-dilution effect upon ice growth and melt; (1) specified concentrations in sea ice, which gives a possibly more realistic effect of sea ice on tracers. Option (-1) and (0) work for all tracers, but (1) is currently only available for PISCES.
+%------------------------------------------namtrc_ice----------------------------------------------------
+\nlst{namtrc_ice}
+%---------------------------------------------------------------------------------------------------------
+\subsubsection{Antartic Ice Sheet tracer supply}
+The external input of biogeochemical tracers from the Antarctic Ice Sheet (AIS) is represented by associating a tracer content with the freshwater flux from icebergs and ice shelves \citep{person_sensitivity_2019}. This supply is currently implemented only for dissolved Fe (\autoref{img_icbisf}) and is effective in model configurations with south-extended grids (eORCA1 and eORCA025). As the ORCA2 grid does not extend south into Antarctica, the external source of tracers from the AIS cannot be enabled in this configuration.
+For icebergs, a homogeneous distribution of biogeochemical tracers is applied from the surface to a depth that can be defined in \textit{\&namtrc\_ais}, currently set at 120 m. It should be noted that the freshwater flux from icebergs affects only the ocean properties at the surface. For ice shelves, biogeochemical tracers follow the explicit or parameterized representation of freshwater flux distribution modeled in NEMO. The AIS tracer supply is activated by setting \textit{ln\_trcais} to \textit{true} in the \textit{\&namtrc} section.
+\begin{figure}[!h]
+   \centering
+   \includegraphics[width=0.80\textwidth]{ICB-ISF-Feflx}
+   \caption{Annual Fe fluxes from icebergs and ice shelves in the Southern Ocean.}
+   \label{img_icbisf}
+\end{figure}
+%------------------------------------------namtrc_ais----------------------------------------------------
+\nlst{namtrc_ais}
+%---------------------------------------------------------------------------------------------------------
 \section{The SMS modules}
 …
 \subsection{Ideal Age}
 %------------------------------------------namage----------------------------------------------------
+%
 \nlst{namage}
 %----------------------------------------------------------------------------------------------------------
 An `ideal age' tracer is integrated online in TOP when \textit{ln\_age} = \texttt{.true.} in namelist \textit{namtrc}.
+This tracer marks the length of time in units of years that fluid has spent in the interior of the ocean, insulated from exposure to the atmosphere.
+This tracer marks the duration in units of years that fluid has spent in the interior of the ocean, insulated from exposure to the atmosphere  (\autoref{img_ageatl} and \autoref{img_age200}).
+\begin{figure}[!h]
+   \centering
+   \includegraphics[width=0.80\textwidth]{Age_Atl}
+   \caption{Vertical distribution of the Age tracer in the Atlantic Ocean at 35°W from a 62-year simulation.}
+   \label{img_ageatl}
+\end{figure}
+\begin{figure}[!h]
+   \centering
+   \includegraphics[width=0.80\textwidth]{Age_200m}
+   \caption{Age tracer at 200 m depth from a 62-year simulation.}
+   \label{img_age200}
+\end{figure}
 Thus, away from the surface for $z<-H_{\mathrm{Age}}$ where $H_{\mathrm{Age}}$ is specified by the \textit{namage} namelist variable \textit{rn\_age\_depth}, whose default value is 10~m, there is a source $\mathrm{SMS_{\mathrm{Age}}}$ of the age tracer $A$:
 …
 where the relaxation rate $\lambda_{\mathrm{Age}}$  (units $\mathrm{s}\;^{-1}$) is specified by the \textit{namage} namelist variable \textit{rn\_age\_kill\_rate} and has a default value of 1/7200~s.
 Since this relaxation is applied explicitly, this relaxation rate in principle should not exceed $1/\Delta t$, where $\Delta t$ is the time step used to step forward passive tracers (2 * \textit{nn\_dttrc * rn\_rdt} when the default  leapfrog time-stepping scheme is employed).
+Since this relaxation is applied explicitly, the relaxation rate should in principle not exceed $1/\Delta t$, where $\Delta t$ is the time step used to step forward passive tracers (2 * \textit{nn\_dttrc * rn\_rdt} when the default  leapfrog time-stepping scheme is employed).
 Currently the 1-dimensional reference depth of the grid boxes is used rather than the dynamically evolving depth to determine whether the age tracer is incremented or relaxed to zero.
 This means that the tracer only works correctly in z-coordinates.
 To ensure that the forcing is independent of the level thicknesses, where the tracer cell at level $k$ has its upper face $z=-depw(k)$ above the depth $-H_{\mathrm{Age}}$, but its lower face $z=-depw(k+1)$ below that depth, then the age source
+This means that the age tracer module only works correctly in z-coordinates.
+To ensure that the forcing is independent of the level thicknesses, where the tracer cell at level $k$ has its upper face $z=-depw(k)$ above the depth $-H_{\mathrm{Age}}$, but its lower face $z=-depw(k+1)$ below that depth, then the age source is computed as:
 \begin{equation}
 …
 \end{align}
+This implementation was first used in the CORE-II intercomparison runs described e.g.\ in \citet{danabasoglu_2014}.
+This implementation was first used in the CORE-II intercomparison runs described in \citet{danabasoglu_2014}.
 \subsection{Inert carbons tracer}
 …
 and additionally as an aerosol propellant.
 SF6 (SF$_{6}$) is also a gas at room temperature, with a range of applications based around its property as an excellent electrical insulator (often replacing more toxic alternatives).
 All three are relatively inert chemicals that are both non-toxic and non-flammable, and their wide use has led to their accumulation within the Earth's atmosphere.
 Large-scale production of CFC-11 and CFC-12 began in the 1930s, while production of SF6 began in the 1950s, and their atmospheric concentration time-histories are shown in Figure \autoref{img_cfcatm}.
 As can be seen in the figure, while the concentration of SF6 continues to rise to the present  day, the concentrations of both CFC-11 and CFC-12 have levelled off and declined since around the 1990s.
+All three gases are relatively inert chemicals that are both non-toxic and non-flammable, and their wide use has led to their accumulation in the atmosphere.
+Large-scale production of CFC-11 and CFC-12 began in the 1930s, while production of SF6 began in the 1950s, and the time-histories of their atmospheric concentrations are shown in Figure \autoref{img_cfcatm}.
+As can be seen in the figure, while the concentration of SF6 continues to rise to the present day, concentrations of both CFC-11 and CFC-12 have levelled off and declined since around the 1990s.
 These declines have been driven by the Montreal Protocol (effective since August 1989), which has banned the production of CFC-11 and CFC-12 (as well as other CFCs) because of their role in the depletion of
+stratospheric ozone (O$_{3}$), critical in decreasing the flux of ultraviolet radiation to the Earth's surface.
+Separate to this role in ozone-depletion, all three chemicals are significantly more potent greenhouse gases
+stratospheric ozone (O$_{3}$), critical in decreasing the flux of ultraviolet radiation to the Earth's surface. All three chemicals are also  significantly more potent greenhouse gases
 than CO$_{2}$ (especially SF6), although their relatively low atmospheric concentrations limit their role in climate change. \\
 …
 The ocean is a notable sink for all three gases, and their relatively recent occurrence in the atmosphere, coupled to the ease of making high precision measurements of their dissolved concentrations, has made them
 valuable in oceanography. % for tracking interior ventilation and mixing.
 Because they only enter the ocean via surface air-sea exchange, and are almost completely chemically and biologically inert, their distribution within the ocean interior reveals its ventilation via transport and mixing.
 Measuring the dissolved concentrations of the gases -- as well as the mixing ratios between them -- shows circulation pathways within the ocean as well as water mass ages (i.e. the time since last contact with the
+Because they only enter the ocean via surface air-sea exchange, and are almost completely chemically and biologically inert, their distribution within the ocean interior reveals ventilation of the latter via transport and mixing.
+Measuring the dissolved concentrations of these gases -- as well as the mixing ratios between them -- shows circulation pathways within the ocean as well as water mass ages (i.e. the time since has been last in contact with the
 atmosphere).
 This feature of the gases has made them valuable across a wide range of oceanographic problems.
 One use lies in ocean modelling, where they can be used to evaluate the realism of the circulation and
 ventilation of models, key for understanding the behaviour of wider modelled marine biogeochemistry (e.g. \citep{dutay_2002,palmieri_2015}). \\
+This feature has made them valuable across a wide range of oceanographic problems.
+In ocean modelling, they can be used to evaluate the realism of the simulated circulation and
+ventilation patterns, which is key for understanding the behaviour of modelled marine biogeochemistry (e.g. \citep{dutay_2002,palmieri_2015}). \\
 Modelling these gases (henceforth CFCs) in NEMO is done within the passive tracer transport module, TOP, using the conservation state equation \autoref{Eq_tracer}
 Advection and diffusion of the CFCs in NEMO are calculated by the physical module, OPA,
+Advection and diffusion of the CFCs in NEMO are calculated by the physical module, TRP,
 whereas sources and sinks are done by the CFC module within TOP.
 The only source for CFCs in the ocean is via air-sea gas exchange at its surface, and since CFCs are generally
+The only source of CFCs to the ocean is via air-sea gas exchange at its surface, and since CFCs are generally
 stable within the ocean, we assume that there are no sinks (i.e. no loss processes) within the ocean interior.
 Consequently, the sinks-minus-sources term for CFCs consists only of their air-sea fluxes, $F_{cfc}$, as
 …
 $C_{surf}$ is the local surface concentration of the CFC tracer within the model (in mol~m$^{-3}$);
 and $f_{i}$ is the fractional sea-ice cover of the local ocean (ranging between 0.0 for ice-free ocean,
 through to 1.0 for completely ice-covered ocean with no air-sea exchange).
+ to 1.0 for completely ice-covered ocean with no air-sea exchange).
 The saturation concentration of the CFC, $C_{sat}$, is calculated as follows:
 …
 % AXY: consider an itemized list here if you've got a list of differences
 For instance, C$_{sat}$ is calculated for a fixed surface pressure of 1atm, what could be corrected in a further version of the module.
+For instance, C$_{sat}$ is calculated for a fixed surface pressure of 1atm. This may be corrected in a future version of the module.
 …
 \begin{table}[!t]
 \caption{Coefficients for fit of the CFCs Schmidt number (Eq. \autoref{equ_Sc}). }
+\caption{Coefficients for fit of the CFCs Schmidt number (Eq. \autoref{equ_Sc}).}
 \vskip4mm
 \centering
 …
 %----------------------------------------------------------------------------------------------------------
 The C14 package implemented in NEMO by Anne Mouchet models ocean $\Dcq$.
+The C14 package has been implemented in NEMO by Anne Mouchet $\Dcq$.
 It offers several possibilities: $\Dcq$ as a physical tracer of the ocean ventilation (natural $\cq$), assessment of bomb radiocarbon uptake, as well as transient studies of paleo-historical ocean radiocarbon distributions.
 …
 Let  $\Rq$ represent the ratio of $\cq$ atoms to the total number of carbon atoms in the sample, i.e. $\cq/\mathrm{C}$.
 Then, radiocarbon anomalies are reported as
+Then, radiocarbon anomalies are reported as:
 \begin{equation}
 …
 where $\Rq_{\textrm{ref}}$ is a reference ratio.
 For the purpose of ocean ventilation studies $\Rq_{\textrm{ref}}$ is set to one.
+For the purpose of ocean ventilation studies, $\Rq_{\textrm{ref}}$ is set to one.
 Here we adopt the approach of \cite{fiadeiro_1982} and \cite{toggweiler_1989a,toggweiler_1989b} in which  the ratio $\Rq$ is transported rather than the individual concentrations C and $\cq$.
 …
 The radiocarbon decay rate (\forcode{rlam14}; in \texttt{trcnam\_c14} module) is set to $\lambda=(1/8267)$ yr$^{-1}$ \citep{stuiver_1977}, which corresponds to a half-life of 5730 yr.\\[1pt]
+%
 The Schmidt number $Sc$, Eq. \autoref{eq:wanc14}, is calculated with the help of the formulation of \cite{wanninkhof_2014}.
+The Schmidt number $Sc$, Eq. \autoref{eq:wanc14}, is calculated using the formulation of \cite{wanninkhof_2014}.
 The $\cd$ solubility $K_0$ in \autoref{eq:Rspeed} is taken from \cite{weiss_1974}. $K_0$ and $Sc$ are computed with the OGCM temperature and salinity fields (\texttt{trcsms\_c14} module).\\[1pt]
+%
 …
 \end{figure}
 Performing this type of experiment requires that a pre-industrial equilibrium run be performed beforehand (\forcode{ln\_rsttr} should be set to \texttt{.TRUE.}).
 An exception to this rule is when wishing to perform a perturbation bomb experiment as was possible with the package \texttt{C14b}.
+Performing this type of experiment requires that a pre-industrial equilibrium run has been performed beforehand (\forcode{ln\_rsttr} should be set to \texttt{.TRUE.}).
+An exception to this rule is when performing a perturbation bomb experiment as was possible with the package \texttt{C14b}.
 It is still possible to easily set-up that type of transient experiment for which no previous run is needed.
 In addition to the instructions as given in this section it is however necessary to adapt the \texttt{atmc14.dat} file so that it does no longer contain any negative $\Dcq$ values (Suess effect in the pre-bomb period).
+In addition to the instructions given in this section, it is however necessary to adapt the \texttt{atmc14.dat} file so that it does no longer contain any negative $\Dcq$ values (Suess effect in the pre-bomb period).
 The model  is integrated from a given initial date following the observed records provided from 1765 AD on ( Fig. \autoref{fig:bomb}).
 …
 Dates in these forcing files are expressed as yr AD.
 To ensure that the atmospheric forcing is applied properly as well as that output files contain consistent dates and inventories the experiment should be set up carefully:
+To ensure that the atmospheric forcing is applied properly as well as that output files contain consistent dates and inventories, the experiment should be set up carefully:
 \begin{itemize}
 …
 \end{itemize}
 If the experiment date is outside the data time span then the first or last atmospheric concentrations are prescribed depending on whether the date is earlier or later.
 Note that \forcode{tyrc14\_beg} (\texttt{namelist\_c14}) is not used in this context.
+If the experiment date is outside the data time span, the first or last atmospheric concentrations are then prescribed depending on whether the date is earlier or later.
+   Note that \forcode{tyrc14\_beg} (\texttt{namelist\_c14}) is not used in this context.
+%
 …
 All output fields in Table \autoref{tab:out} are routinely computed.
 It depends on the actual settings in \texttt{iodef.xml} whether they are stored or not.
+It depends on the actual settings in \texttt{iodef.xml} whether they are saved or not.
+%
 \begin{table}[!h]
 …
 \subsection{PISCES biogeochemical model}
+PISCES is a biogeochemical model which simulates the lower trophic levels of marine ecosystem (phytoplankton, microzooplankton and mesozooplankton) and the biogeochemical cycles of carbonand of the main nutrients (P, N, Fe, and Si).
+The  model is intended to be used for both regional and global configurations at high or low spatial resolutions as well as for  short-term (seasonal, interannual) and long-term (climate change, paleoceanography) analyses.
+PISCES is a biogeochemical model that simulates the lower trophic levels of marine ecosystem (phytoplankton, microzooplankton, and mesozooplankton) and the biogeochemical cycles of carbon and of the main nutrients (P, N, Si, and Fe) (\autoref{img_piscesdesign} and \autoref{img_pisces}).
+\begin{figure}[ht]
+   \begin{center}
+      \vspace{0cm}
+      \includegraphics[width=0.80\textwidth]{Fig_PISCES_model}
+      \caption{Schematic view of the PISCES-v2 model (figure by Jorge Martinez-Rey).}
+      \label{img_piscesdesign}
+   \end{center}
+\end{figure}
+\begin{figure}[!h]
+   \centering
+   \includegraphics[width=0.80\textwidth]{PISCES_tracers}
+   \caption{Surface concentrations of NO$_{3}$, PO$_{4}$, total chlorophyll, and air-sea CO$_{2}$ flux from the last year of a 62-year simulation.}
+   \label{img_pisces}
+\end{figure}
+The  model is intended to be used for both regional and global configurations at high or low spatial resolutions as well as for short-term (seasonal, interannual) and long-term (climate change, paleoceanography) analyses.
 Two versions of PISCES are available in NEMO v4.0 :
+PISCES-v2, by setting in namelist\_pisces\_ref  \np{ln\_p4z} to true,  can be seen as one of the many Monod models \citep{monod_1958}.
+It assumes a constant Redfield ratio and phytoplankton growth depends on the external concentration in nutrients.
+There are twenty-four prognostic variables (tracers) including two phytoplankton compartments  (diatoms and nanophytoplankton), two zooplankton size-classes (microzooplankton and  mesozooplankton) and a description of the carbonate chemistry.
+Formulations in PISCES-v2 are based on a mixed Monod/Quota formalism: On one hand, stoichiometry of C/N/P is fixed and growth rate of phytoplankton is limited by the external availability in N, P and Si.
+On the other hand, the iron and silicium quotas are variable and growth rate of phytoplankton is limited by the internal availability in Fe.
+Various parameterizations can be activated in PISCES-v2, setting for instance the complexity of iron chemistry or the description of particulate organic materials.
+PISCES-QUOTA has been built on the PISCES-v2 model described in \citet{aumont_2015}.
+PISCES-QUOTA has thirty-nine prognostic compartments.
+Phytoplankton growth can be controlled by five modeled limiting nutrients: Nitrate and Ammonium, Phosphate, Silicate and Iron.
+Five living compartments are represented: Three phytoplankton size classes/groups corresponding to picophytoplankton, nanophytoplankton and diatoms, and two zooplankton size classes which are microzooplankton and mesozooplankton.
+For phytoplankton, the prognostic variables are the carbon, nitrogen, phosphorus,  iron, chlorophyll and silicon biomasses (the latter only for diatoms).
+This means that the N/C, P/C, Fe/C and Chl/C ratios of both phytoplankton groups as well as the Si/C ratio of diatoms are prognostically predicted  by the model.
+Zooplankton are assumed to be strictly homeostatic \citep[e.g.,][]{sterner_2003,woods_2013,meunier_2014}.
+As a consequence, the C/N/P/Fe ratios of these groups are maintained constant and are not allowed to vary.
+In PISCES, the Redfield ratios C/N/P are set to 122/16/1 \citep{takahashi_1985} and the -O/C ratio is set to 1.34 \citep{kortzinger_2001}.
+No silicified zooplankton is assumed.
+The bacterial pool is not yet explicitly modeled.
+\begin{itemize}
+   \item PISCES-v2, by setting \textit{ln\_p4z} = \texttt{.true.} in \textit{namelist\_pisces\_ref}. This version can be seen as one of the many Monod models \citep{monod_1958}. It assumes a constant Redfield ratio and phytoplankton growth depends on the external concentration in nutrients. There are twenty-four prognostic variables (tracers) including two phytoplankton compartments  (diatoms and nanophytoplankton), two zooplankton size-classes (microzooplankton and  mesozooplankton) and a description of the carbonate chemistry. Formulations in PISCES-v2 are based on a mixed Monod/Quota formalism: On one hand, stoichiometry of C/N/P is fixed and growth rate of phytoplankton is limited by the external availability in N, P, and Si. On the other hand, the iron and silicium quotas are variable and growth rate of phytoplankton is limited by the internal availability in Fe. Various parameterizations can be activated in PISCES-v2, setting for instance the complexity of iron chemistry or the description of particulate organic materials.
+   \item PISCES-QUOTA, by setting \textit{ln\_p5z} = \texttt{.true.} in \textit{namelist\_pisces\_ref}. This version has been built on the PISCES-v2 model described in \citet{aumont_2015}. PISCES-QUOTA has thirty-nine prognostic compartments. Phytoplankton growth is controlled by five modeled limiting nutrients: Nitrate and Ammonium, Phosphate, Silicate, and Iron. Five living compartments are represented: Three phytoplankton size classes/groups corresponding to picophytoplankton, nanophytoplankton, and diatoms, and two zooplankton size classes, which are microzooplankton and mesozooplankton. For phytoplankton, the prognostic variables are the carbon, nitrogen, phosphorus,  iron, chlorophyll and silicon biomasses (the latter only for diatoms). This means that the N/C, P/C, Fe/C, and Chl/C ratios of the three phytoplankton groups as well as the Si/C ratio of diatoms are prognostically predicted by the model. Zooplankton are assumed to be strictly homeostatic \citep[e.g.,][]{sterner_2003,woods_2013,meunier_2014}. As a consequence, the C/N/P/Fe ratios of these groups are maintained constant and are not allowed to vary. In PISCES, the Redfield ratios C/N/P are set to 122/16/1 \citep{takahashi_1985} and the -O/C ratio is set to 1.34 \citep{kortzinger_2001}. No silicified zooplankton is assumed. The bacterial pool is not yet explicitly modeled.
+\end{itemize}
 There are three non-living compartments: Semi-labile dissolved organic matter, small sinking particles, and large sinking particles.
 As a consequence of the variable stoichiometric ratios of phytoplankton and of the stoichiometric regulation of zooplankton, elemental ratios in organic matter cannot be supposed constant anymore as that was the case in PISCES-v2.
 Indeed, the nitrogen, phosphorus, iron, silicon and calcite pools of the particles are now all explicitly modeled.
+Indeed, the nitrogen, phosphorus, iron, silicon, and calcite pools of the particles are now all explicitly modeled.
 The sinking speed of the particles is not altered by their content in calcite and biogenic silicate (''The ballast effect'', \citep{honjo_1996,armstrong_2001}).
 The latter particles are assumed to sink at the same speed as the large organic matter particles.
 …
 \label{Mytrc}
 The NEMO-TOP has only one built-in biogeochemical model - PISCES - but there are several BGC models - MEDUSA, ERSEM, BFM or ECO3M - which are meant to be coupled with the NEMO dynamics.
 Therefore it was necessary to provide to the users a framework for easily add their own BGCM model, that can be a single passive tracer.
+NEMO-TOP has one built-in biogeochemical model - PISCES - but there are several BGC models - MEDUSA, ERSEM, BFM or ECO3M - which are meant to be used within the NEMO plateform.
+Therefore it was necessary to provide to the users a framework to easily add their own BGCM model.
 The generalized interface is pivoted on MY\_TRC module that contains template files to build the coupling between NEMO and any external BGC model.
+The call to MY\_TRC is activated by setting  \textit{ln\_my\_trc} = \texttt{.true.} in namelist \textit{namtrc}
+Call to MY\_TRC is activated by setting  \textit{ln\_my\_trc} = \texttt{.true.} in namelist \textit{namtrc}.\\
 The following 6 fortran files are available in MY\_TRC with the specific purposes here described.
 …
   \item \textit{trcsms\_my\_trc.F90} :  The routine performs the call to Boundary Conditions and its main purpose is to contain the Source-Minus-Sinks terms due to the biogeochemical processes of the external model.
 Be aware that lateral boundary conditions are applied in trcnxt routine.
 IMPORTANT: the routines to compute the light penetration along the water column and the tracer vertical sinking should be defined/called in here, as generalized modules are still missing in the code.
  \item \textit{trcice\_my\_trc.F90} : Here it is possible to prescribe the tracers concentrations in the seaice that will be used as boundary conditions when ice melting occurs (nn\_ice\_tr =1 in namtrc\_ice).
+IMPORTANT: the routines to compute light penetration along the water column and the tracer vertical sinking should be defined/called in here, as generalized modules are still missing in the code.
+ \item \textit{trcice\_my\_trc.F90} : Here it is possible to prescribe the tracers concentrations in sea ice that will be used as boundary conditions when ice formation and melting occurs (nn\_ice\_tr =1 in namtrc\_ice).
 See e.g. the correspondent PISCES subroutine.
  \item \textit{trcwri\_my\_trc.F90} : This routine performs the output of the model tracers using IOM module (see Manual Chapter Output and Diagnostics).
 …
 \label{Offline}
+%------------------------------------------namtrc_sms----------------------------------------------------
+\nlst{namdta_dyn}
+%-------------------------------------------------------------------------------------------------------------
+Coupling passive tracers offline with NEMO requires precomputed  physical fields from OGCM.
+Those fields are read from files and interpolated on-the-fly at each model time step
+At least the following dynamical parameters should be absolutely passed to the transport : ocean velocities, temperature, salinity, mixed layer depth and for ecosystem models like PISCES, sea ice concentration, short wave radiation at the ocean surface, wind speed (or at least, wind stress).
+The so-called offline mode is useful since it has lower computational costs for example to perform very longer simulations - about 3000 years - to reach equilibrium of CO2 sinks for climate-carbon studies.
+The offline interface is located in the code repository : \path{<repository>/src/OFF/}.
+It is activated by adding the CPP key  \textit{key\_offline} to the CPP keys list.
+There are two specifics routines for the Offline code :
+Coupling passive tracers offline with NEMO requires precomputed physical fields
+ from OGCM. Those fields are read in files and interpolated on-the-fly at each model
+ time step. There are two sets of fields to perform offline simulations :
 \begin{itemize}
+   \item \textit{dtadyn.F90} :  this module allows to read and compute the dynamical fields at each model time-step
+   \item \textit{nemogcm.F90} :  a degraded version of the main nemogcm.F90 code of NEMO to manage the time-stepping
+   \item linear free surface ( ln\_linssh = .true. )  where the vertical scale factor is constant with time. At least, the following dynamical parameters should be absolutely passed
+   to transport : the effective ocean transport velocities (eulerian plus the eddy induced plus all others parameterizations), vertical diffusion coefficient and the freshwater flux
+.
+   %------------------------------------------namtrc_sms----------------------------------------------------
+   \nlst{namdta_dyn_linssh}
+   %-----------------------------------------------------------------------------------------------------------
+   \item non linear free surface ( ln\_linssh = .false. or key\_qco ) : the same fields than the ones in the linear free surface case. In addition, the horizontal divergence transport is needed to  recompute the time evolution of the sea surface heigth and the vertical scale factor and depth, and thus the time evolution of the vertical transport velocity.
+   %------------------------------------------namtrc_sms----------------------------------------------------
+   \nlst{namdta_dyn_nolinssh}
+   %-----------------------------------------------------------------------------------------------------------
 \end{itemize}
+%-
+%-
+%-
+%-  Describes here the specifities of oflline : At least the dynamical variables needed - u/v/w transport T/S for isopycnal MLD for biogeo models etc ...
+%-  the specfities of vvl - ssh + runoffs and how to
+%-
+Additionally, temperature, salinity, and mixed layer depth are needed to compute slopes for isopycnal diffusion. Some ecosystem models like PISCES need sea ice concentration, short-wave radiation at the ocean surface, and wind speed (or at least, wind stress).
+The so-called offline mode is useful since it has lower computational costs for example to perform very longer simulations – about 3000 years - to reach equilibrium of CO$_{2}$ sinks for climate-carbon studies.
+The offline interface is located in the code repository : <repository>/src/OFF/. It is activated by adding the\textit{ key\_offline} CPP key to the CPP keys list.
+There are
+two specifics routines for the offline code :
+\begin{itemize}
+   \item dtadyn.F90 : this module reads and computes the dynamical fields at
+each model time-step
+   \item nemogcm.F90 : a degraded version of the main nemogcm.F90 code of NEMO to
+manage the time-stepping
+\end{itemize}
 \end{document}

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/doc/latex/TOP/subfiles/model_setup.tex

-                      r11591
+                      r14958
 \chapter{ Model Setup}
+The usage of TOP is activated i) by including in the configuration definition the component TOP and ii) by adding the macro key\_top in the configuration CPP file (see for more details “Learn more about the model”).
+As an example, the user can refer to already available configurations in the code, ORCA2\_ICE\_PISCES being the NEMO biogeochemical demonstrator and GYRE\_BFM to see the required configuration elements to couple with an external biogeochemical model (see also Section 4).\\
+Note that, since version 4.0, TOP interface core functionalities are activated by means of logical keys and all submodules preprocessing macros from previous versions were removed.\\
+Below is the list of preprocessing keys that apply to the TOP interface (beside key\_top):
+\begin{itemize}
+   \item key\_xios use XIOS I/O
+   \item key\_agrif enables AGRIF coupling
+   \item key\_trdtrc and key\_trdmxl\_trc trend computation for tracers
+\end{itemize}
+There are only two entry points in the NEMOGCM model for passive tracers :
+\begin{itemize}
+   \item initialization (trcini) : general initialization of global variables and parameters of BGCM
+   \item time-stepping (trcstp) : time-evolution of SMS first, then time evolution of tracers by transport
+\end{itemize}
 \section{ Setting up a passive tracer configuration}
 %------------------------------------------namtrc_int----------------------------------------------------
 …
 %-------------------------------------------------------------------------------------------------------------
+The usage of TOP is activated
+\begin{itemize}
+         \item by including in the configuration definition the component TOP\_SRC
+         \item by adding the macro \textit{key\_top} in the configuration cpp file
+\end{itemize}
+As an example, the user can refer to already available configurations in the code, GYRE\_PISCES being the NEMO biogeochemical demonstrator and GYRE\_BFM to see the required configuration elements to couple with an external biogeochemical model (see also section \S\ref{SMS_models}) .
+Note that, since version 4.0, TOP interface core functionalities are activated by means of logical keys and all submodules preprocessing macros from previous versions were removed.
+There are only three specific keys remaining in TOP
+\begin{itemize}
+        \item \textit{key\_top} : to enables passive tracer module
+        \item \textit{key\_trdtrc} and \textit{key\_trdmxl\_trc} : trend computation for tracers
+\end{itemize}
+For a remind, the revisited structure of TOP interface now counts for five different modules handled in namelist\_top :
+As a reminder, the revisited structure of TOP interface now counts for five different modules handled in namelist\_top :
 \begin{itemize}
         \item \textbf{PISCES}, default BGC model
         \item \textbf{MY\_TRC}, template for creation of new modules couplings (maybe run a single passive tracer)
         \item \textbf{CFC}, inert carbon tracers dynamics (CFC11,CFC12,SF6) Updated with OMIP-BGC guidelines (Orr et al, 2016)
+        \item \textbf{CFC}, inert tracers dynamics (CFC$_{11}$,CFC$_{12}$,SF$_{6}$) updated based on OMIP-BGC guidelines (Orr et al, 2016)
         \item \textbf{C14}, radiocarbon passive tracer
         \item \textbf{AGE}, water age tracking revised implementation
+        \item \textbf{AGE}, water age tracking
 \end{itemize}
+The modular approach was implemented also in the definition of the total number of passive tracers (jptra). This results from to user setting from the namelist \textit{namtrc}
+For inert, C14, and Age tracers, all variables settings (\textit{sn\_tracer} definitions) are hard-coded in \textit{trc\_nam\_*} routines. For instance, for Age tracer:
+%------------------------------------------namtrc_int----------------------------------------------------
+\nlst{nam_trc_age}
+%---------------------------------------------------------------------------------------------------------
+\section{ TOP Tracer Initialisation}
+The modular approach was also implemented in the definition of the total number of passive tracers (jptra) which is specified by the user in  \textit{namtrc}
+\section{ TOP Tracer Initialization}
+Two main types of data structure are used within TOP interface to initialize tracer properties and to provide related initial and boundary conditions.
+In addition to providing name and metadata for tracers, the use of initial and boundary conditions is also defined here (sn\_tracer).
+The data structure is internally initialized by the code with dummy names and all initialization/forcing logical fields are set to \textit{false} .
+Below are listed some features/options of the TOP interface accessible through the \textit{namelist\_top\_ref} and modifiable by means of \textit{namelist\_top\_cfg} (as for NEMO physical ones).
+There are three options to initialize TOP tracers in the \textit{namelist\_top } file: (1) initialization to hard-coded constant values when \textit{ln\_trcdta} at \textit{false}, (2) initialization from files when \textit{ln\_trcdta} at \textit{true}, and (3) initialisation from restart files by setting \textit{ln\_rsttr} to \textit{true} in \textit{namelist}.
+In the following, an example of the full structure definition is given for four tracers (DIC, Fe, NO$_{3}$, PHY) with initial conditions and different surface boundary and coastal forcings for DIC, Fe, and NO$_{3}$:
+%------------------------------------------namtrc_int----------------------------------------------------
+\nlst{namtrc_cfg}
+%---------------------------------------------------------------------------------------------------------
+You have to activate which tracers (\textit{sn\_tracer}) you want to initialize by setting them to \texttt{true} in the  column.
+\nlst{namtrc_dta_cfg}
+In \textit{namtrc\_dta}, you prescribe from which files the tracer are initialized (\textit{sn\_trcdta}).
+A multiplicative factor can also be set for each tracer (\textit{rn\_trfac}).
 \section{ TOP Boundaries Conditions}
+\subsection{Surface and lateral boundaries}
+Lateral and surface boundary conditions for passive tracers are prescribed in \textit{namtrc\_bc} as well as whether temporal interpolation of these files is enabled. Here we show the cases of Fe and NO$_{3}$ from dust and rivers with different output frequencies.
+%------------------------------------------namtrc_bc----------------------------------------------------
+\nlst{namtrc_bc_cfg}
+%---------------------------------------------------------------------------------------------------------
+\subsection{Antartic Ice Sheet tracer supply}
+As a reminder, the supply of passive tracers from the AIS is currently implemented only for dissolved Fe. The activation of this Fe source is done by setting \textit{ln\_trcais} to \textit{true} and by adding the Fe tracer (\textit{sn\_tracer(2) = .true.}) in the 'ais' column in \textit{\&namtrc} (see section 2.2). \\
+As the external source of Fe from the AIS is represented by associating  a sedimentary Fe content (with a solubility fraction) to the freshwater fluxes of icebergs and ice shelves, these fluxes have to be activated in \textit{namelist\_cfg}. The reading of the freshwater flux file from ice shelves is activated in \textit{namisf} with the namelist parameter \textit{ln\_isf} set to \textit{true}.
+You have to choose between two options depending whether the cavities under ice shelves are open or not in your grid configuration:
+\begin{itemize}
+   \item ln\_isfcav\_mlt = .false. (resolved cavities)
+   \item ln\_isfpar\_mlt = .true. (parameterized distribution for unopened cavities)
+\end{itemize}
+%------------------------------------------namisf----------------------------------------------------
+\nlst{namisf_cfg_eORCA1}
+%-----------------------------------------------------------------------------------------------------
+Runoff from icebergs is activated by setting \textit{ln\_rnf\_icb} to \textit{true} in the \textit{\&namsbc\_rnf} section of \textit{namelist\_cfg}.
+%------------------------------------------namsbc_rnf--------------------------------------------------
+\nlst{namsbc_rnf_cfg_eORCA1}
+%---------------------------------------------------------------------------------------------------------
+The freshwater flux from ice shelves and icebergs is based on observations and modeled climatologies and is available for eORCA1 and eORCA025 grids :
+\begin{itemize}
+   \item runoff-icb\_DaiTrenberth\_Depoorter\_eORCA1\_JD.nc
+   \item runoff-icb\_DaiTrenberth\_Depoorter\_eORCA025\_JD.nc
+\end{itemize}
+%------------------------------------------namtrc_ais----------------------------------------------------
+\nlst{namtrc_ais_cfg}
+%---------------------------------------------------------------------------------------------------------
+Two options for tracer concentrations in iceberg and ice shelf can be set with the namelist parameter \textit{nn\_ais\_tr}:
+\begin{itemize}
+   \item 0 : null concentrations corresponding to dilution of BGC tracers due to freshwater fluxes from icebergs and ice shelves
+   \item 1 : prescribed concentrations set with the \textit{rn\_trafac} factor
+\end{itemize}
+The depth until which Fe from melting iceberg is delivered can be set with the namelist parameter \textit{rn\_icbdep}. The value of 120 m is the average underwater depth of the different iceberg size classes modeled by the NEMO iceberg module, which was used to produce the freshwater flux climatology of icebergs.
 \end{document}

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/ICE/icedia.F90

-                      r14072
+                      r14958
       REAL(wp)   ::   zbg_ivol, zbg_item, zbg_area, zbg_isal
       REAL(wp)   ::   zbg_svol, zbg_stem
+      REAL(wp)   ::   zbg_ipvol, zbg_ilvol
       REAL(wp)   ::   z_frc_voltop, z_frc_temtop, z_frc_sal
       REAL(wp)   ::   z_frc_volbot, z_frc_tembot
 …
       ! ----------------------- !
       IF(  iom_use('ibgvol_tot' ) .OR. iom_use('sbgvol_tot' ) .OR. iom_use('ibgarea_tot') .OR. &
+         & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') ) THEN
+         & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') .OR. &
+         & iom_use('ipbgvol_tot' ) .OR. iom_use('ilbgvol_tot' ) ) THEN
          zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! ice volume (km3)
 …
          zbg_item = glob_sum( 'icedia', et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J)
          zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J)
+         ! ponds
+         zbg_ipvol = glob_sum( 'icedia', vt_ip(:,:) * e1e2t(:,:) ) * 1.e-9  ! ice pond volume (km3)
+         zbg_ilvol = glob_sum( 'icedia', vt_il(:,:) * e1e2t(:,:) ) * 1.e-9  ! ice pond lid volume (km3)
          CALL iom_put( 'ibgvol_tot'  , zbg_ivol )
 …
          CALL iom_put( 'ibgheat_tot' , zbg_item )
          CALL iom_put( 'sbgheat_tot' , zbg_stem )
+         ! ponds
+         CALL iom_put( 'ipbgvol_tot' , zbg_ipvol )
+         CALL iom_put( 'ilbgvol_tot' , zbg_ilvol )
       ENDIF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/ICE/icestp.F90

r14072	r14958
460	460	qcn_ice (ji,jj,jl) = 0._wp ! conductive flux (ln_cndflx=T & ln_cndemule=T)
461	461	qtr_ice_bot(ji,jj,jl) = 0._wp ! part of solar radiation transmitted through the ice needed at least for outputs
	462	qml_ice (ji,jj,jl) = 0._wp ! surface melt heat flux
462	463	! Melt pond surface melt diagnostics (mv - more efficient: grouped into one water volume flux)
463	464	dh_i_sum_2d(ji,jj,jl) = 0._wp

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/ICE/icethd.F90

r14433	r14958
536	536	CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) )
537	537	CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_top_1d(1:npti), qcn_ice_top(:,:,kl) )
	538	CALL tab_1d_2d( npti, nptidx(1:npti), qml_ice_1d (1:npti), qml_ice (:,:,kl) )
538	539	! extensive variables
539	540	CALL tab_1d_2d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i (:,:,kl) )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/ICE/icethd_dh.F90

-                      r14072
+                      r14958
       zevap_rema(1:npti) = 0._wp
       DO ji = 1, npti
+         IF( evap_ice_1d(ji) > 0._wp ) THEN
+            zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0
+            zevap_rema(ji) = MAX( 0._wp, evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos ) ! remaining evap in kg.m-2 (used for ice sublimation later on)
+         ENDIF
+         zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0
+         zevap_rema(ji) = evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos               ! remaining evap in kg.m-2 (used for ice sublimation later on)
       END DO

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/ICE/icethd_ent.F90

r13547	r14958
121	121	DO ji = 1, npti
122	122	rswitch = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )
123		qnew(ji,jk1) = rswitch * ~~( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )~~
	123	qnew(ji,jk1) = rswitch * MAX( 0._wp, zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) ! max for roundoff error
124	124	END DO
125	125	END DO

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/ICE/iceupdate.F90

-                      r14595
+                      r14958
       IF( iom_use('hfxcndbot'  ) )   CALL iom_put( 'hfxcndbot'  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux
       IF( iom_use('hfxcndtop'  ) )   CALL iom_put( 'hfxcndtop'  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux
 !!    IF( iom_use('hfxmelt'    ) )   CALL iom_put( 'hfxmelt'    , SUM( qml_ice     * a_i_b, dim=3 ) )   ! Surface melt flux
 !!    IF( iom_use('hfxldmelt'  ) )   CALL iom_put( 'hfxldmelt'  ,      fhld        * at_i_b         )   ! Heat in lead for ice melting
 !!    IF( iom_use('hfxldgrow'  ) )   CALL iom_put( 'hfxldgrow'  ,      qlead       * r1_Dt_ice      )   ! Heat in lead for ice growth
+      IF( iom_use('hfxmelt'    ) )   CALL iom_put( 'hfxmelt'    , SUM( qml_ice     * a_i_b, dim=3 ) )   ! Surface melt flux
+      IF( iom_use('hfxldmelt'  ) )   CALL iom_put( 'hfxldmelt'  ,      fhld        * at_i_b         )   ! Heat in lead for ice melting
+      IF( iom_use('hfxldgrow'  ) )   CALL iom_put( 'hfxldgrow'  ,      qlead       * r1_Dt_ice      )   ! Heat in lead for ice growth
       ! controls

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ASM/asminc.F90

-                      r14090
+                      r14958
    USE par_oce         ! Ocean space and time domain variables
    USE dom_oce         ! Ocean space and time domain
-   USE domtile
    USE domvvl          ! domain: variable volume level
    USE ldfdyn          ! lateral diffusion: eddy viscosity coefficients
 …
+      !
       INTEGER  :: ji, jj, jk
       INTEGER  :: it, itile
+      INTEGER  :: it
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values
 …
             zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step
+            !
             IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
                IF(lwp) THEN
                   WRITE(numout,*)
 …
          ENDIF
+         !
          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
             IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work
                DEALLOCATE( t_bkginc )
 …
             IF (ln_temnofreeze) THEN
                ! Do not apply negative increments if the temperature will fall below freezing
                WHERE( t_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_tem,Kmm) + t_bkginc(A2D(0),:) > fzptnz(:,:,:) )
                   pts(A2D(0),:,jp_tem,Kmm) = t_bkg(A2D(0),:) + t_bkginc(A2D(0),:)
+               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) )
+                  pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)
                END WHERE
             ELSE
+               DO_3D( 0, 0, 0, 0, 1, jpk )
+                  pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk)
+               END_3D
+               pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)
             ENDIF
             IF (ln_salfix) THEN
                ! Do not apply negative increments if the salinity will fall below a specified
                ! minimum value salfixmin
                WHERE( s_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_sal,Kmm) + s_bkginc(A2D(0),:) > salfixmin )
                   pts(A2D(0),:,jp_sal,Kmm) = s_bkg(A2D(0),:) + s_bkginc(A2D(0),:)
+               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin )
+                  pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)
                END WHERE
             ELSE
+               DO_3D( 0, 0, 0, 0, 1, jpk )
+                  pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk)
+               END_3D
+            ENDIF
+            DO_3D( 0, 0, 0, 0, 1, jpk )
+               pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm)             ! Update before fields
+            END_3D
+               pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)
+            ENDIF
+            pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm)                 ! Update before fields
             CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities
 …
 !!gm
+            ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*)
+            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
+               itile = ntile
+               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain
+               IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           &
+                  &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
+                  &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level
+               IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       &
+                  &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF)
+                  &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level
+               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain
+            ENDIF
+            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+               DEALLOCATE( t_bkginc )
+               DEALLOCATE( s_bkginc )
+               DEALLOCATE( t_bkg    )
+               DEALLOCATE( s_bkg    )
+            ENDIF
+         !
+            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           &
+               &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
+               &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       &
+               &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF)
+               &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+            DEALLOCATE( t_bkg    )
+            DEALLOCATE( s_bkg    )
          ENDIF
+         !
 …
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv       ! ocean velocities and RHS of momentum equation
+      !
       INTEGER :: jk
+      INTEGER :: ji, jj, jk
       INTEGER :: it
       REAL(wp) :: zincwgt  ! IAU weight for current time step
 …
             zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step
+            !
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it)
+                  WRITE(numout,*) '~~~~~~~~~~~~'
+               ENDIF
             ENDIF
+            !
             ! Update the dynamic tendencies
+            DO jk = 1, jpkm1
+               puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + u_bkginc(:,:,jk) * zincwgt
+               pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + v_bkginc(:,:,jk) * zincwgt
+            END DO
+            !
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( u_bkginc )
+               DEALLOCATE( v_bkginc )
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + u_bkginc(ji,jj,jk) * zincwgt
+               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + v_bkginc(ji,jj,jk) * zincwgt
+            END_3D
+            !
+            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+               IF ( kt == nitiaufin_r ) THEN
+                  DEALLOCATE( u_bkginc )
+                  DEALLOCATE( v_bkginc )
+               ENDIF
             ENDIF
+            !
 …
+      !
       INTEGER :: it
       INTEGER :: jk
+      INTEGER :: ji, jj, jk
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       !!----------------------------------------------------------------------
 …
             zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step
+            !
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', &
+                     &  kt,' with IAU weight = ', wgtiau(it)
+                  WRITE(numout,*) '~~~~~~~~~~~~'
+               ENDIF
             ENDIF
+            !
 …
             ! (applied in dynspg.*)
 #if defined key_asminc
+            ssh_iau(:,:) = ssh_bkginc(:,:) * zincwgt
+            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+               ssh_iau(ji,jj) = ssh_bkginc(ji,jj) * zincwgt
+            END_2D
 #endif
+            !
 …
+            !
             ! test on ssh_bkginc needed as ssh_asm_inc is called twice by time step
+            IF (ALLOCATED(ssh_bkginc)) DEALLOCATE( ssh_bkginc )
+            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+               IF (ALLOCATED(ssh_bkginc)) DEALLOCATE( ssh_bkginc )
+            ENDIF
+            !
 #if defined key_asminc
+            ssh_iau(:,:) = 0._wp
+            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+               ssh_iau(ji,jj) = 0._wp
+            END_2D
 #endif
+            !
 …
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
       !!
       INTEGER  ::   jk                                        ! dummy loop index
+      INTEGER  ::   ji, jj, jk                                ! dummy loop index
       REAL(wp), DIMENSION(:,:)  , POINTER       ::   ztim     ! local array
       !!----------------------------------------------------------------------
 …
+      !
       IF( ln_linssh ) THEN
+         phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1)
+         DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls )
+            phdivn(ji,jj,1) = phdivn(ji,jj,1) - ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) * tmask(ji,jj,1)
+         END_2D
       ELSE
+         ALLOCATE( ztim(jpi,jpj) )
+         ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) )
+         DO jk = 1, jpkm1
+            phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk)
+         END DO
+         ALLOCATE( ztim(A2D(nn_hls)) )
+         DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls )
+            ztim(ji,jj) = ssh_iau(ji,jj) / ( ht(ji,jj) + 1.0 - ssmask(ji,jj) )
+            DO jk = 1, jpkm1
+               phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ztim(ji,jj) * tmask(ji,jj,jk)
+            END DO
+         END_2D
+         !
          DEALLOCATE(ztim)
 …
             ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments)
+            !
             IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
                IF(lwp) THEN
                   WRITE(numout,*)
 …
 #endif
+            !
             IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
                IF ( kt == nitiaufin_r ) THEN
                   DEALLOCATE( seaice_bkginc )
 …
             END_2D
 #endif
             IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
                IF ( .NOT. PRESENT(kindic) ) THEN
                   DEALLOCATE( seaice_bkginc )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/BDY/bdydyn3d.F90

r14433	r14958
349	349	REAL(wp) :: zwgt ! boundary weight
350	350	!!----------------------------------------------------------------------
	351	IF( l_istiled .AND. ntile /= 1 ) RETURN ! Do only for the full domain
351	352	!
352	353	IF( ln_timing ) CALL timing_start('bdy_dyn3d_dmp')

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/BDY/bdyice.F90

-                      r14433
+                      r14958
             h_i (ji,jj,  jl) = ( h_i (ji,jj,  jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  depth
             h_s (ji,jj,  jl) = ( h_s (ji,jj,  jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth
             t_i (ji,jj,:,jl) = ( t_i (ji,jj,:,jl) * zwgt1 + dta%t_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  temperature
             t_s (ji,jj,:,jl) = ( t_s (ji,jj,:,jl) * zwgt1 + dta%t_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow temperature
             t_su(ji,jj,  jl) = ( t_su(ji,jj,  jl) * zwgt1 + dta%tsu(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Surf temperature
             s_i (ji,jj,  jl) = ( s_i (ji,jj,  jl) * zwgt1 + dta%s_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  salinity
+            t_i (ji,jj,:,jl) =                              dta%t_i(i_bdy,jl)          * tmask(ji,jj,1)  ! Ice  temperature
+            t_s (ji,jj,:,jl) =                              dta%t_s(i_bdy,jl)          * tmask(ji,jj,1)  ! Snow temperature
+            t_su(ji,jj,  jl) =                              dta%tsu(i_bdy,jl)          * tmask(ji,jj,1)  ! Surf temperature
+            s_i (ji,jj,  jl) =                              dta%s_i(i_bdy,jl)          * tmask(ji,jj,1)  ! Ice  salinity
             a_ip(ji,jj,  jl) = ( a_ip(ji,jj,  jl) * zwgt1 + dta%aip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond concentration
             h_ip(ji,jj,  jl) = ( h_ip(ji,jj,  jl) * zwgt1 + dta%hip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond depth
 …
                sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
                DO jk = 1, nlay_s
+                  t_s(ji,jj,jk,jl) = MIN( t_s(ji,jj,jk,jl), -0.15_wp + rt0 )           ! Force t_s to be lower than -0.15deg (arbitrary) => likely conservation issue
+                  !                                                                    !       otherwise instant melting can occur
                   e_s(ji,jj,jk,jl) = rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus )   ! enthalpy in J/m3
                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s           ! enthalpy in J/m2
                END DO
+               t_su(ji,jj,jl) = MIN( t_su(ji,jj,jl), -0.15_wp + rt0 )                  ! Force t_su to be lower than -0.15deg (arbitrary)
                DO jk = 1, nlay_i
                   ztmelts          = - rTmlt  * sz_i(ji,jj,jk,jl)             ! Melting temperature in C
                   t_i(ji,jj,jk,jl) = MIN( t_i(ji,jj,jk,jl), ztmelts + rt0 )   ! Force t_i to be lower than melting point => likely conservation issue
+                  t_i(ji,jj,jk,jl) = MIN( t_i(ji,jj,jk,jl), (ztmelts-0.15_wp) + rt0 )  ! Force t_i to be lower than melting point (-0.15) => likely conservation issue
+                  !
                   e_i(ji,jj,jk,jl) = rhoi * ( rcpi  * ( ztmelts - ( t_i(ji,jj,jk,jl) - rt0 ) )           &   ! enthalpy in J/m3
 …
                      IF( zflag == -1. .AND. ji > 1 .AND. ji < jpi )   THEN
                         IF    ( vt_i(ji  ,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_ice(ji-1,jj)
                         ELSEIF( vt_i(ji+1,jj) > 0. )   THEN   ;   u_ice(ji,jj) = 0._wp
+                        ELSEIF( vt_i(ji+1,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_oce(ji,jj)
                         END IF
                      END IF
 …
                      IF( zflag ==  1. .AND. ji+1 < jpi+1 )   THEN
                         IF    ( vt_i(ji+1,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_ice(ji+1,jj)
                         ELSEIF( vt_i(ji  ,jj) > 0. )   THEN   ;   u_ice(ji,jj) = 0._wp
+                        ELSEIF( vt_i(ji  ,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_oce(ji,jj)
                         END IF
                      END IF
 …
                      IF( zflag == -1. .AND. jj > 1 .AND. jj < jpj )   THEN
                         IF    ( vt_i(ji,jj  ) > 0. )   THEN   ;   v_ice(ji,jj) = v_ice(ji,jj-1)
                         ELSEIF( vt_i(ji,jj+1) > 0. )   THEN   ;   v_ice(ji,jj) = 0._wp
+                        ELSEIF( vt_i(ji,jj+1) > 0. )   THEN   ;   v_ice(ji,jj) = v_oce(ji,jj)
                         END IF
                      END IF
 …
                      IF( zflag ==  1. .AND. jj < jpj )   THEN
                         IF    ( vt_i(ji,jj+1) > 0. )   THEN   ;   v_ice(ji,jj) = v_ice(ji,jj+1)
                         ELSEIF( vt_i(ji,jj  ) > 0. )   THEN   ;   v_ice(ji,jj) = 0._wp
+                        ELSEIF( vt_i(ji,jj  ) > 0. )   THEN   ;   v_ice(ji,jj) = v_oce(ji,jj)
                         END IF
                      END IF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/BDY/bdytra.F90

r14433	r14958
158	158	INTEGER :: ib_bdy ! Loop index
159	159	!!----------------------------------------------------------------------
160		IF( ~~ntile /= 0~~ .AND. ntile /= 1 ) RETURN ! Do only for the full domain
	160	IF( l_istiled .AND. ntile /= 1 ) RETURN ! Do only for the full domain
161	161	!
162	162	IF( ln_timing ) CALL timing_start('bdy_tra_dmp')

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DIA/diaar5.F90

-                      r14072
+                      r14958
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   hstr_adv, hstr_ldf
    LOGICAL  :: l_ar5
 …
       !!----------------------------------------------------------------------
+      !
+      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , &
+         &      hstr_adv(jpi,jpj,jpts,2), hstr_ldf(jpi,jpj,jpts,2), STAT=dia_ar5_alloc )
+      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk), STAT=dia_ar5_alloc )
+      !
       CALL mpp_sum ( 'diaar5', dia_ar5_alloc )
 …
    END SUBROUTINE dia_ar5
+   ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support, will not output haloes)
    SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx )
       !!----------------------------------------------------------------------
 …
+      !
       INTEGER    ::  ji, jj, jk
+      IF( cptr /= 'adv' .AND. cptr /= 'ldf' ) RETURN
+      IF( ktra /= jp_tem .AND. ktra /= jp_sal ) RETURN
+      REAL(wp), DIMENSION(A2D(nn_hls))  :: z2d
+      z2d(:,:) = puflx(:,:,1)
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)
+      END_3D
       IF( cptr == 'adv' ) THEN
+         DO_2D( 0, 0, 0, 0 )
+            hstr_adv(ji,jj,ktra,1) = puflx(ji,jj,1)
+            hstr_adv(ji,jj,ktra,2) = pvflx(ji,jj,1)
+         END_2D
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            hstr_adv(ji,jj,ktra,1) = hstr_adv(ji,jj,ktra,1) + puflx(ji,jj,jk)
+            hstr_adv(ji,jj,ktra,2) = hstr_adv(ji,jj,ktra,2) + pvflx(ji,jj,jk)
+         END_3D
+         IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d(:,:) )  ! advective heat transport in i-direction
+         IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * z2d(:,:) )  ! advective salt transport in i-direction
       ELSE IF( cptr == 'ldf' ) THEN
+         DO_2D( 0, 0, 0, 0 )
+            hstr_ldf(ji,jj,ktra,1) = puflx(ji,jj,1)
+            hstr_ldf(ji,jj,ktra,2) = pvflx(ji,jj,1)
+         END_2D
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            hstr_ldf(ji,jj,ktra,1) = hstr_ldf(ji,jj,ktra,1) + puflx(ji,jj,jk)
+            hstr_ldf(ji,jj,ktra,2) = hstr_ldf(ji,jj,ktra,2) + pvflx(ji,jj,jk)
+         END_3D
+      ENDIF
+      IF( ntile == 0 .OR. ntile == nijtile ) THEN
+         IF( cptr == 'adv' ) THEN
+            IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,1) )  ! advective heat transport in i-direction
+            IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * hstr_adv(:,:,ktra,1) )  ! advective salt transport in i-direction
+            IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,2) )  ! advective heat transport in j-direction
+            IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * hstr_adv(:,:,ktra,2) )  ! advective salt transport in j-direction
+         ENDIF
+         IF( cptr == 'ldf' ) THEN
+            IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,1) ) ! diffusive heat transport in i-direction
+            IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * hstr_ldf(:,:,ktra,1) ) ! diffusive salt transport in i-direction
+            IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,2) ) ! diffusive heat transport in j-direction
+            IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * hstr_ldf(:,:,ktra,2) ) ! diffusive salt transport in j-direction
+         ENDIF
+         IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in i-direction
+         IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * z2d(:,:) ) ! diffusive salt transport in i-direction
+      ENDIF
+      !
+      z2d(:,:) = pvflx(:,:,1)
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)
+      END_3D
+      IF( cptr == 'adv' ) THEN
+         IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d(:,:) )  ! advective heat transport in j-direction
+         IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * z2d(:,:) )  ! advective salt transport in j-direction
+      ELSE IF( cptr == 'ldf' ) THEN
+         IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in j-direction
+         IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * z2d(:,:) ) ! diffusive salt transport in j-direction
       ENDIF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DIA/diaptr.F90

-                      r14229
+                      r14958
 CONTAINS
+   ! NOTE: [tiling] tiling sometimes changes the diagnostics very slightly, usually where there are few zonal points e.g. the northern Indian Ocean basin. The difference is usually very small, for one point in one diagnostic. Presumably this is because of the additional zonal integration step over tiles.
    SUBROUTINE dia_ptr( kt, Kmm, pvtr )
       !!----------------------------------------------------------------------
 …
          ! Calculate diagnostics only when zonal integrals have finished
          IF( ntile == 0 .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr)
+         IF( .NOT. l_istiled .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr)
       ENDIF
 …
+         !
          IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN
-            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain
             CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml
             z2d(:,:) = ptr_ci_2d( z2d(:,:) )
             CALL iom_put( 'uocetr_vsum_cumul', z2d )
-            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain
          ENDIF
+         !
 …
 #if ! defined key_mpi_off
       IF( ntile == 0 .OR. ntile == nijtile ) THEN
+      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
          ish1d(1) = jpj*nbasin
          ish2d(1) = jpj ; ish2d(2) = nbasin
 …
 #if ! defined key_mpi_off
       IF( ntile == 0 .OR. ntile == nijtile ) THEN
+      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
          ish1d(1) = jpj*jpk*nbasin
          ish3d(1) = jpj ; ish3d(2) = jpk ; ish3d(3) = nbasin

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/dom_oce.F90

-                      r14433
+                      r14958
    INTEGER         ::   nn_ltile_i, nn_ltile_j
    ! Domain tiling (all tiles)
+   ! Domain tiling
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsi_a       !: start of internal part of tile domain
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsj_a       !
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntei_a       !: end of internal part of tile domain
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntej_a       !
+   LOGICAL, PUBLIC                                  ::   l_istiled    ! whether tiling is currently active or not
    !                             !: domain MPP decomposition parameters

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/domain.F90

-                      r14433
+                      r14958
       !           !==  Reference coordinate system  ==!
+      !
       CALL dom_glo                            ! global domain versus local domain
       CALL dom_nam                            ! read namelist ( namrun, namdom )
       CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain
+      CALL dom_glo                      ! global domain versus local domain
+      CALL dom_nam                      ! read namelist ( namrun, namdom )
+      CALL dom_tile_init                ! Tile domain
+      !

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/domqco.F90

-                      r14433
+                      r14958
       CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) )
 #endif
+      ! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1]
+      IF( nn_hls == 2 ) CALL lbc_lnk( 'dom_qco_zgr', r3u(:,:,Kbb), 'U', 1._wp, r3v(:,:,Kbb), 'V', 1._wp, &
+         &                                           r3u(:,:,Kmm), 'U', 1._wp, r3v(:,:,Kmm), 'V', 1._wp )
+      !
    END SUBROUTINE dom_qco_zgr
 …
+      !
+      !
+      pr3t(:,:) = pssh(:,:) * r1_ht_0(:,:)   !==  ratio at t-point  ==!
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+         pr3t(ji,jj) = pssh(ji,jj) * r1_ht_0(ji,jj)   !==  ratio at t-point  ==!
+      END_2D
+      !
+      !
 …
 #if ! defined key_qcoTest_FluxForm
       !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average
          DO_2D( 0, 0, 0, 0 )
             pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  &
                &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj)
             pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  &
                &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj)
          END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+         pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  &
+            &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj)
+         pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  &
+            &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj)
+      END_2D
 !!st      ELSE                                         !- Flux Form   (simple averaging)
 #else
          DO_2D( 0, 0, 0, 0 )
             pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj)
             pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj)
          END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+         pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj)
+         pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj)
+      END_2D
 !!st      ENDIF
 #endif
+      !
       IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only
          CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp )
+         !
+         !
 …
          !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average
+            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line
+               pr3f(ji,jj) = 0.25_wp * (  e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )  &
+                  &                     + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )  &
+                  &                     + e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  &
+                  &                     + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj)
+            END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line
+         ! round brackets added to fix the order of floating point operations
+         ! needed to ensure halo 1 - halo 2 compatibility
+         pr3f(ji,jj) = 0.25_wp * ( ( e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )   &
+            &                      + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )   &
+            &                      )                                      & ! bracket for halo 1 - halo 2 compatibility
+            &                     + ( e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  &
+            &                       + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  &
+            &                       )                                     & ! bracket for halo 1 - halo 2 compatibility
+            &                    ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj)
+      END_2D
 !!st         ELSE                                      !- Flux Form   (simple averaging)
 #else
+            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line
+               pr3f(ji,jj) = 0.25_wp * (  pssh(ji,jj  ) + pssh(ji+1,jj  )  &
+                  &                     + pssh(ji,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj)
+            END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+         ! round brackets added to fix the order of floating point operations
+         ! needed to ensure halo 1 - halo 2 compatibility
+         pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj  ) + pssh(ji+1,jj  ) ) &
+            &                     + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)  &
+            &                       )                                  & ! bracket for halo 1 - halo 2 compatibility
+            &                    ) * r1_hf_0(ji,jj)
+      END_2D
 !!st         ENDIF
 #endif
          !                                                 ! lbc on ratio at u-,v-,f-points
          CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp )
+         !
       ENDIF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/domtile.F90

-                      r14090
+                      r14958
+   !
    USE prtctl         ! Print control (prt_ctl_info routine)
+   USE lib_mpp , ONLY : ctl_stop, ctl_warn
    USE in_out_manager ! I/O manager
 …
    PRIVATE
+   PUBLIC dom_tile   ! called by step.F90
+   PUBLIC dom_tile         ! called by step.F90
+   PUBLIC dom_tile_start   ! called by various
+   PUBLIC dom_tile_stop    ! "      "
+   PUBLIC dom_tile_init    ! called by domain.F90
+   LOGICAL, ALLOCATABLE, DIMENSION(:) ::   l_tilefin    ! whether a tile is finished or not
    !!----------------------------------------------------------------------
 …
 CONTAINS
+   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile )
+   SUBROUTINE dom_tile_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_tile_init  ***
+      !!
+      !! ** Purpose :   Initialise tile domain variables
+      !!
+      !! ** Action  : - ntsi, ntsj     : start of internal part of domain
+      !!              - ntei, ntej     : end of internal part of domain
+      !!              - ntile          : current tile number
+      !!              - nijtile        : total number of tiles
+      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right)
+      !!              - nthb, ntht     :              "         "               (bottom, top)
+      !!              - l_istiled      : whether tiling is currently active or not
+      !!              - l_tilefin      : whether a tile is finished or not
+      !!----------------------------------------------------------------------
+      INTEGER ::   jt                                     ! dummy loop argument
+      INTEGER ::   iitile, ijtile                         ! Local integers
+      !!----------------------------------------------------------------------
+      IF( ln_tile .AND. nn_hls /= 2 ) CALL ctl_stop('dom_tile_init: Tiling is only supported for nn_hls = 2')
+      ntile = 0                     ! Initialise to full domain
+      nijtile = 1
+      ntsi = Nis0
+      ntsj = Njs0
+      ntei = Nie0
+      ntej = Nje0
+      nthl = 0
+      nthr = 0
+      nthb = 0
+      ntht = 0
+      l_istiled = .FALSE.
+      IF( ln_tile ) THEN            ! Calculate tile domain indices
+         iitile = Ni_0 / nn_ltile_i       ! Number of tiles
+         ijtile = Nj_0 / nn_ltile_j
+         IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1
+         IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1
+         nijtile = iitile * ijtile
+         ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile), l_tilefin(nijtile) )
+         l_tilefin(:) = .FALSE.
+         ntsi_a(0) = Nis0                 ! Full domain
+         ntsj_a(0) = Njs0
+         ntei_a(0) = Nie0
+         ntej_a(0) = Nje0
+         DO jt = 1, nijtile               ! Tile domains
+            ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile)
+            ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile)
+            ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0)
+            ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0)
+         ENDDO
+      ENDIF
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_tile : Domain tiling decomposition'
+         WRITE(numout,*) '~~~~~~~~'
+         IF( ln_tile ) THEN
+            WRITE(numout,*) iitile, 'tiles in i'
+            WRITE(numout,*) '    Starting indices'
+            WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile)
+            WRITE(numout,*) '    Ending indices'
+            WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile)
+            WRITE(numout,*) ijtile, 'tiles in j'
+            WRITE(numout,*) '    Starting indices'
+            WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile)
+            WRITE(numout,*) '    Ending indices'
+            WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile)
+         ELSE
+            WRITE(numout,*) 'No domain tiling'
+            WRITE(numout,*) '    i indices =', ntsi, ':', ntei
+            WRITE(numout,*) '    j indices =', ntsj, ':', ntej
+         ENDIF
+      ENDIF
+   END SUBROUTINE dom_tile_init
+   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile, ldhold, cstr )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE dom_tile  ***
       !!
       !! ** Purpose :   Set tile domain variables
+      !! ** Purpose :   Set the current tile and its domain indices
       !!
       !! ** Action  : - ktsi, ktsj     : start of internal part of domain
       !!              - ktei, ktej     : end of internal part of domain
+      !!              - ntile          : current tile number
+      !!              - nijtile        : total number of tiles
+      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right)
+      !!              - nthb, ntht     :              "         "               (bottom, top)
+      !!              - ktile          : set the current tile number (ntile)
       !!----------------------------------------------------------------------
       INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej      ! Tile domain indices
+      INTEGER, INTENT(in), OPTIONAL :: ktile              ! Tile number
+      INTEGER ::   jt                                     ! dummy loop argument
+      INTEGER ::   iitile, ijtile                         ! Local integers
+      CHARACTER (len=11) ::   charout
+      !!----------------------------------------------------------------------
+      IF( PRESENT(ktile) .AND. ln_tile ) THEN
+         ntile = ktile                 ! Set domain indices for tile
+         ktsi = ntsi_a(ktile)
+         ktsj = ntsj_a(ktile)
+         ktei = ntei_a(ktile)
+         ktej = ntej_a(ktile)
+      INTEGER, INTENT(in)  :: ktile                       ! Tile number
+      LOGICAL, INTENT(in), OPTIONAL :: ldhold             ! Pause/resume (.true.) or set (.false.) current tile
+      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr    ! Debug information (added to warnings)
+      CHARACTER(len=23) :: clstr
+      LOGICAL :: llhold
+      CHARACTER(len=11)   :: charout
+      INTEGER :: iitile
+      !!----------------------------------------------------------------------
+      llhold = .FALSE.
+      IF( PRESENT(ldhold) ) llhold = ldhold
+      clstr = ''
+      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
+      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot use dom_tile with ln_tile = .false.')
+      IF( .NOT. llhold ) THEN
+         IF( .NOT. l_istiled ) THEN
+            CALL ctl_warn('Cannot call dom_tile when tiling is inactive'//clstr)
+            RETURN
+         ENDIF
+         IF( ntile /= 0 ) l_tilefin(ntile) = .TRUE.         ! If setting a new tile, the current tile is complete
+         ntile = ktile                                      ! Set the new tile
          IF(sn_cfctl%l_prtctl) THEN
             WRITE(charout, FMT="('ntile =', I4)") ktile
+            WRITE(charout, FMT="('ntile =', I4)") ntile
             CALL prt_ctl_info( charout )
          ENDIF
+      ELSE
+         ntile = 0                     ! Initialise to full domain
+         nijtile = 1
+         ktsi = Nis0
+         ktsj = Njs0
+         ktei = Nie0
+         ktej = Nje0
+         IF( ln_tile ) THEN            ! Calculate tile domain indices
+            iitile = Ni_0 / nn_ltile_i       ! Number of tiles
+            ijtile = Nj_0 / nn_ltile_j
+            IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1
+            IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1
+            nijtile = iitile * ijtile
+            ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) )
+            ntsi_a(0) = ktsi                 ! Full domain
+            ntsj_a(0) = ktsj
+            ntei_a(0) = ktei
+            ntej_a(0) = ktej
+            DO jt = 1, nijtile               ! Tile domains
+               ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile)
+               ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile)
+               ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0)
+               ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0)
+            ENDDO
+         ENDIF
+         IF(lwp) THEN                  ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) 'dom_tile : Domain tiling decomposition'
+            WRITE(numout,*) '~~~~~~~~'
+            IF( ln_tile ) THEN
+               WRITE(numout,*) iitile, 'tiles in i'
+               WRITE(numout,*) '    Starting indices'
+               WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile)
+               WRITE(numout,*) '    Ending indices'
+               WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile)
+               WRITE(numout,*) ijtile, 'tiles in j'
+               WRITE(numout,*) '    Starting indices'
+               WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile)
+               WRITE(numout,*) '    Ending indices'
+               WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile)
+            ELSE
+               WRITE(numout,*) 'No domain tiling'
+               WRITE(numout,*) '    i indices =', ktsi, ':', ktei
+               WRITE(numout,*) '    j indices =', ktsj, ':', ktej
+            ENDIF
+         ENDIF
+      ENDIF
+      ENDIF
+      ktsi = ntsi_a(ktile)                                  ! Set the domain indices
+      ktsj = ntsj_a(ktile)
+      ktei = ntei_a(ktile)
+      ktej = ntej_a(ktile)
+      ! Calculate the modifying factor on DO loop bounds (1 = do not work on points that have already been processed by a neighbouring tile)
+      nthl = 0 ; nthr = 0 ; nthb = 0 ; ntht = 0
+      iitile = Ni_0 / nn_ltile_i
+      IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1
+      IF( ktsi > Nis0 ) THEN ; IF( l_tilefin(ktile - 1     ) ) nthl = 1 ; ENDIF    ! Left adjacent tile
+      IF( ktei < Nie0 ) THEN ; IF( l_tilefin(ktile + 1     ) ) nthr = 1 ; ENDIF    ! Right  "  "
+      IF( ktsj > Njs0 ) THEN ; IF( l_tilefin(ktile - iitile) ) nthb = 1 ; ENDIF    ! Bottom "  "
+      IF( ktej < Nje0 ) THEN ; IF( l_tilefin(ktile + iitile) ) ntht = 1 ; ENDIF    ! Top    "  "
    END SUBROUTINE dom_tile
+   SUBROUTINE dom_tile_start( ldhold, cstr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_tile_start  ***
+      !!
+      !! ** Purpose : Start or resume the use of tiling
+      !!
+      !! ** Method  : dom_tile_start & dom_tile_stop are used to declare a tiled region of code.
+      !!
+      !!              Tiling is active/inactive (l_istiled = .true./.false.) within/outside of this code region.
+      !!              After enabling tiling, no tile will initially be set (the full domain will be used) and dom_tile must
+      !!              be called to set a specific tile to work on. Furthermore, all tiles will be marked as incomplete
+      !!              (ln_tilefin(:) = .false.).
+      !!
+      !!              Tiling can be paused/resumed within the tiled code region by calling dom_tile_stop/dom_tile_start
+      !!              with ldhold = .true.. This can be used to temporarily revert back to using the full domain.
+      !!
+      !!                 CALL dom_tile_start                                  ! Enable tiling
+      !!                    CALL dom_tile(ntsi, ntei, ntsj, ntej, ktile=n)    ! Set current tile "n"
+      !!                    ...
+      !!                    CALL dom_tile_stop(.TRUE.)                        ! Pause tiling (temporarily disable)
+      !!                    ...
+      !!                    CALL dom_tile_start(.TRUE.)                       ! Resume tiling
+      !!                 CALL dom_tile_stop                                   ! Disable tiling
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Resume (.true.) or start (.false.)
+      LOGICAL :: llhold
+      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings)
+      CHARACTER(len=23) :: clstr
+      !!----------------------------------------------------------------------
+      llhold = .FALSE.
+      IF( PRESENT(ldhold) ) llhold = ldhold
+      clstr = ''
+      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
+      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot resume/start tiling as ln_tile = .false.')
+      IF( l_istiled ) THEN
+         CALL ctl_warn('Cannot resume/start tiling as it is already active'//clstr)
+         RETURN
+      ! TODO: [tiling] this warning will always be raised outside a tiling loop (cannot check for pause rather than stop)
+      ELSE IF( llhold .AND. ntile == 0 ) THEN
+         CALL ctl_warn('Cannot resume tiling as it is not paused'//clstr)
+         RETURN
+      ENDIF
+      ! Whether resumed or started, the tiling is made active. If resumed, the domain indices for the current tile are used.
+      IF( llhold ) CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=ntile, ldhold=.TRUE., cstr='dom_tile_start'//clstr)
+      l_istiled = .TRUE.
+   END SUBROUTINE dom_tile_start
+   SUBROUTINE dom_tile_stop( ldhold, cstr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_tile_stop  ***
+      !!
+      !! ** Purpose : End or pause the use of tiling
+      !!
+      !! ** Method  : See dom_tile_start
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Pause (.true.) or stop (.false.)
+      LOGICAL :: llhold
+      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings)
+      CHARACTER(len=23) :: clstr
+      !!----------------------------------------------------------------------
+      llhold = .FALSE.
+      IF( PRESENT(ldhold) ) llhold = ldhold
+      clstr = ''
+      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
+      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot pause/stop tiling as ln_tile = .false.')
+      IF( .NOT. l_istiled ) THEN
+         CALL ctl_warn('Cannot pause/stop tiling as it is inactive'//clstr)
+         RETURN
+      ENDIF
+      ! Whether paused or stopped, the tiling is made inactive and the full domain indices are used.
+      ! If stopped, there is no active tile (ntile = 0) and the finished tile indicators are reset
+      CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=0, ldhold=llhold, cstr='dom_tile_stop'//clstr)
+      IF( .NOT. llhold ) l_tilefin(:) = .FALSE.
+      l_istiled = .FALSE.
+   END SUBROUTINE dom_tile_stop
    !!======================================================================
 END MODULE domtile

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/domutl.F90

-                      r14072
+                      r14958
    INTERFACE is_tile
       MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d
+      MODULE PROCEDURE is_tile_2d_sp, is_tile_3d_sp, is_tile_4d_sp, is_tile_2d_dp, is_tile_3d_dp, is_tile_4d_dp
    END INTERFACE is_tile
 …
+   FUNCTION is_tile_2d( pt )
+      !!
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt
+      INTEGER :: is_tile_2d
+      !!
+      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_2d = 1
+   INTEGER FUNCTION is_tile_2d_sp( pt )
+      REAL(sp), DIMENSION(:,:), INTENT(in) ::   pt
+      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_2d_sp = 1
       ELSE
          is_tile_2d = 0
+         is_tile_2d_sp = 0
       ENDIF
    END FUNCTION is_tile_2d
+   END FUNCTION is_tile_2d_sp
+   FUNCTION is_tile_3d( pt )
+      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt
+      INTEGER :: is_tile_3d
+      !!
+      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_3d = 1
+   INTEGER FUNCTION is_tile_2d_dp( pt )
+      REAL(dp), DIMENSION(:,:), INTENT(in) ::   pt
+      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_2d_dp = 1
       ELSE
          is_tile_3d = 0
+         is_tile_2d_dp = 0
       ENDIF
    END FUNCTION is_tile_3d
+   END FUNCTION is_tile_2d_dp
+   FUNCTION is_tile_4d( pt )
+      !!
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in) ::   pt
+      INTEGER :: is_tile_4d
+      !!
+      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_4d = 1
+   INTEGER FUNCTION is_tile_3d_sp( pt )
+      REAL(sp), DIMENSION(:,:,:), INTENT(in) ::   pt
+      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_3d_sp = 1
       ELSE
          is_tile_4d = 0
+         is_tile_3d_sp = 0
       ENDIF
    END FUNCTION is_tile_4d
+   END FUNCTION is_tile_3d_sp
+   INTEGER FUNCTION is_tile_3d_dp( pt )
+      REAL(dp), DIMENSION(:,:,:), INTENT(in) ::   pt
+      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_3d_dp = 1
+      ELSE
+         is_tile_3d_dp = 0
+      ENDIF
+   END FUNCTION is_tile_3d_dp
+   INTEGER FUNCTION is_tile_4d_sp( pt )
+      REAL(sp), DIMENSION(:,:,:,:), INTENT(in) ::   pt
+      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_4d_sp = 1
+      ELSE
+         is_tile_4d_sp = 0
+      ENDIF
+   END FUNCTION is_tile_4d_sp
+   INTEGER FUNCTION is_tile_4d_dp( pt )
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(in) ::   pt
+      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN
+         is_tile_4d_dp = 1
+      ELSE
+         is_tile_4d_dp = 0
+      ENDIF
+   END FUNCTION is_tile_4d_dp
    !!======================================================================
 END MODULE domutl

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/domvvl.F90

-                      r14433
+                      r14958
       gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb)
       gdepw(:,:,1,Kbb) = 0.0_wp
       DO_3D( 1, 1, 1, 1, 2, jpk )                     ! vertical sum
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )                     ! vertical sum
          !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
          !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
 …
          zwu(:,:) = 0._wp
          zwv(:,:) = 0._wp
          DO_3D( 1, 0, 1, 0, 1, jpkm1 )   ! a - first derivative: diffusive fluxes
+         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )       ! a - first derivative: diffusive fluxes
             un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
                &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
 …
             zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
          END_3D
          DO_2D( 1, 1, 1, 1 )             ! b - correction for last oceanic u-v points
+         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                 ! b - correction for last oceanic u-v points
             un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
             vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
 …
          !                               ! d - thickness diffusion transport: boundary conditions
          !                             (stored for tracer advction and continuity equation)
          CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp)
+         IF( nn_hls == 1 ) CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp)
          ! 4 - Time stepping of baroclinic scale factors
          ! ---------------------------------------------
 …
       gdepw(:,:,1,Kmm) = 0.0_wp
       gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
       DO_3D( 1, 1, 1, 1, 2, jpk )
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )
         !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
                                                            ! 1 for jk = mikt

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/dtatsd.F90

-                      r14189
+                      r14958
       INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
       INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
-      INTEGER ::   itile
       INTEGER, DIMENSION(jpts), SAVE :: irec_b, irec_n
       REAL(wp)::   zl, zi                             ! local scalars
 …
       !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
+         itile = ntile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
+         IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. )             ! Use full domain
             CALL fld_read( kt, 1, sf_tsd )   !==   read T & S data at kt time step   ==!
+      !
 …
          ENDIF
 !!gm end
          IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain
+         IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. )            ! Revert to tile domain
       ENDIF
+      !
 …
       IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
+         !
          IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
             IF( kt == nit000 .AND. lwp )THEN
                WRITE(numout,*)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DOM/istate.F90

r14139	r14958
152	152	!
153	153	!!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
154		DO_3D( ~~1, 1, 1, 1~~, 1, jpkm1 )
	154	DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
155	155	uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
156	156	vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/divhor.F90

-                      r13558
+                      r14958
+      !
       INTEGER  ::   ji, jj, jk    ! dummy loop indices
-      REAL(wp) ::   zraur, zdep   ! local scalars
-      REAL(wp), DIMENSION(jpi,jpj) :: ztmp
       !!----------------------------------------------------------------------
+      !
 …
+      !
       IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+         hdiv(:,:,:) = 0._wp    ! initialize hdiv for the halos at the first time step
+         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
+            IF(lwp) WRITE(numout,*) '~~~~~~~   '
+         ENDIF
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+            hdiv(ji,jj,jk) = 0._wp    ! initialize hdiv for the halos at the first time step
+         END_3D
       ENDIF
+      !
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )                                    !==  Horizontal divergence  ==!
+         hdiv(ji,jj,jk) = (   e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      &
+            &               - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)      &
+            &               + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)      &
+            &               - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)  )   &
+            &            * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+      DO_3D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 )                                    !==  Horizontal divergence  ==!
+         ! round brackets added to fix the order of floating point operations
+         ! needed to ensure halo 1 - halo 2 compatibility
+         hdiv(ji,jj,jk) = (  ( e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)     &
+            &                - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)     &
+            &                )                                                             & ! bracket for halo 1 - halo 2 compatibility
+            &              + ( e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)     &
+            &                - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)     &
+            &                )                                                             & ! bracket for halo 1 - halo 2 compatibility
+            &             )  * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
       END_3D
+      !
 …
+      !
 #endif
+      !
       IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field)
+      !
       CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change)
+      IF (nn_hls==1) CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change)
+      !
       IF( ln_timing )   CALL timing_stop('div_hor')

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynadv_cen2.F90

-                      r13497
+                      r14958
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu_t, zfu_f, zfu_uw, zfu
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::  zfu_t, zfu_f, zfu_uw, zfu
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw
       !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 .AND. lwp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection'
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
       ENDIF
+      !
 …
+      !
       DO jk = 1, jpkm1                    ! horizontal transport
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
+         DO_2D( 1, 1, 1, 1 )
+            zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)
+            zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)
+         END_2D
          DO_2D( 1, 0, 1, 0 )              ! horizontal momentum fluxes (at T- and F-point)
             zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynadv_ubs.F90

-                      r14433
+                      r14958
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars
       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f, zfu_uw, zfu
       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f, zfv_vw, zfv, zfw
       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv
       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk)   ::   zfu_t, zfu_f, zfu_uw, zfu
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk)   ::   zfv_t, zfv_f, zfv_vw, zfv, zfw
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   zlu_uu, zlu_uv
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   zlv_vv, zlv_vu
       !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : UBS flux form momentum advection'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : UBS flux form momentum advection'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ENDIF
       ENDIF
+      !
 …
          !                                   ! =========================== !
          !                                         ! horizontal volume fluxes
+         zfu(:,:,jk) = e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            zfu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)
+            zfv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)
+         END_2D
+         !
+         DO_2D( 0, 0, 0, 0 )                       ! laplacian
+            zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj  ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj  ,jk,Kbb) ) * umask(ji,jj,jk)
+            zlv_vv(ji,jj,jk,1) = ( pvv (ji  ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji  ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk)
+            zlu_uv(ji,jj,jk,1) = ( puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb) ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb) ) * fmask(ji-1,jj  ,jk)
+            !
+            zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk)
+            zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
+            zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+               &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! laplacian
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            zlu_uu(ji,jj,jk,1) = ( ( puu (ji+1,jj  ,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 + ( puu (ji-1,jj  ,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 ) * umask(ji  ,jj  ,jk)
+            zlv_vv(ji,jj,jk,1) = ( ( pvv (ji  ,jj+1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 + ( pvv (ji  ,jj-1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 ) * vmask(ji  ,jj  ,jk)
+            zlu_uv(ji,jj,jk,1) = (  puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb)  ) * fmask(ji  ,jj  ,jk)   &
+               &               - (  puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb)  ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,1) = (  pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb)  ) * fmask(ji  ,jj  ,jk)   &
+               &               - (  pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb)  ) * fmask(ji-1,jj  ,jk)
+            !
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            zlu_uu(ji,jj,jk,2) = ( ( zfu(ji+1,jj  ,jk) - zfu(ji  ,jj  ,jk)           &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 + ( zfu(ji-1,jj  ,jk) - zfu(ji  ,jj  ,jk)           &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 ) * umask(ji  ,jj  ,jk)
+            zlv_vv(ji,jj,jk,2) = ( ( zfv(ji  ,jj+1,jk) - zfv(ji  ,jj  ,jk)           &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 + ( zfv(ji  ,jj-1,jk) - zfv(ji  ,jj  ,jk)           &
+               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+               &                 ) * vmask(ji  ,jj  ,jk)
+            zlu_uv(ji,jj,jk,2) = (  zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk)  ) * fmask(ji  ,jj  ,jk)             &
+               &               - (  zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk)  ) * fmask(ji  ,jj-1,jk)
+            zlv_vu(ji,jj,jk,2) = (  zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk)  ) * fmask(ji  ,jj  ,jk)             &
+               &               - (  zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk)  ) * fmask(ji-1,jj  ,jk)
          END_2D
       END DO
       CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  &
          &                        zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp,  &
          &                        zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp,  &
          &                        zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp   )
+      IF( nn_hls == 1 ) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', -1.0_wp , zlu_uv(:,:,:,1), 'U', -1.0_wp,  &
+                                              &   zlu_uu(:,:,:,2), 'U', -1.0_wp , zlu_uv(:,:,:,2), 'U', -1.0_wp,  &
+                                              &   zlv_vv(:,:,:,1), 'V', -1.0_wp , zlv_vu(:,:,:,1), 'V', -1.0_wp,  &
+                                              &   zlv_vv(:,:,:,2), 'V', -1.0_wp , zlv_vu(:,:,:,2), 'V', -1.0_wp   )
+      !
       !                                      ! ====================== !
 …
       DO jk = 1, jpkm1                       ! ====================== !
          !                                         ! horizontal volume fluxes
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
+         DO_2D( 1, 1, 1, 1 )
+            zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)
+            zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)
+         END_2D
+         !
          DO_2D( 1, 0, 1, 0 )                       ! horizontal momentum fluxes at T- and F-point

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynatf.F90

-                      r14433
+                      r14958
          IF( ln_linssh ) THEN             ! Fixed volume !
             !                             ! =============!
             DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
                puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) )
                pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) )
 …
                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' )
                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' )
                DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
                   puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) )
                   pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) )
 …
                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' )
                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' )
                DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
                   zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa)
                   zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa)
 …
       ENDIF ! .NOT. l_1st_euler
+      !
+      ! This is needed for dyn_ldf_blp to be restartable
+      IF( nn_hls == 2 ) CALL lbc_lnk( 'dynatf', puu(:,:,:,Kmm), 'U', -1.0_wp, pvv(:,:,:,Kmm), 'V', -1.0_wp )
       ! Set "now" and "before" barotropic velocities for next time step:
       ! JC: Would be more clever to swap variables than to make a full vertical

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynatf_qco.F90

-                      r14475
+                      r14958
          IF( ln_linssh ) THEN             ! Fixed volume !
             !                             ! =============!
             DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
                puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) )
                pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) )
 …
             IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
                ! Before filtered scale factor at (u/v)-points
                DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
                   puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) )
                   pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) )
 …
             ELSE                          ! Asselin filter applied on thickness weighted velocity
+               !
                DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
                   zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa)
                   zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa)
 …
       ENDIF ! .NOT. l_1st_euler
+      !
+      ! This is needed for dyn_ldf_blp to be restartable
+      IF( nn_hls == 2 ) CALL lbc_lnk( 'dynatfqco', puu(:,:,:,Kmm), 'U', -1.0_wp, pvv(:,:,:,Kmm), 'V', -1.0_wp )
       ! Set "now" and "before" barotropic velocities for next time step:
       ! JC: Would be more clever to swap variables than to make a full vertical

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynhpg.F90

-                      r14433
+                      r14958
       INTEGER  ::   ji, jj, jk       ! dummy loop indices
       REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::  zhpi, zhpj
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case '
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::  zhpi, zhpj
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case '
+         ENDIF
       ENDIF
+      !
 …
       INTEGER  ::   iku, ikv                         ! temporary integers
       REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj
+      REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zgtsu, zgtsv
+      REAL(wp), DIMENSION(jpi,jpj)     :: zgru, zgrv
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization'
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk ) :: zhpi, zhpj
+      REAL(wp), DIMENSION(A2D(nn_hls),jpts) :: zgtsu, zgtsv
+      REAL(wp), DIMENSION(A2D(nn_hls)     ) :: zgru, zgrv
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization'
+         ENDIF
       ENDIF
 …
       REAL(wp) ::   zcoef0, zuap, zvap, ztmp       ! local scalars
       LOGICAL  ::   ll_tmp1, ll_tmp2               ! local logical variables
       REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zhpi, zhpj
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk)  ::   zhpi, zhpj
       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter
       !!----------------------------------------------------------------------
+      !
+      IF( ln_wd_il ) ALLOCATE(zcpx(jpi,jpj), zcpy(jpi,jpj))
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OCE original scheme used'
+      IF( ln_wd_il ) ALLOCATE(zcpx(A2D(nn_hls)), zcpy(A2D(nn_hls)))
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OCE original scheme used'
+         ENDIF
       ENDIF
+      !
 …
           END IF
         END_2D
-        CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )
       END IF
+      !
 …
       REAL(wp) ::   ze3w, ze3wi1, ze3wj1   ! local scalars
       REAL(wp) ::   zcoef0, zuap, zvap     !   -      -
       REAL(wp), DIMENSION(jpi,jpj,jpk ) ::  zhpi, zhpj
       REAL(wp), DIMENSION(jpi,jpj,jpts) ::  zts_top
       REAL(wp), DIMENSION(jpi,jpj)      ::  zrhdtop_oce
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk ) ::  zhpi, zhpj
+      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::  zts_top
+      REAL(wp), DIMENSION(A2D(nn_hls))      ::  zrhdtop_oce
       !!----------------------------------------------------------------------
+      !
 …
       ! compute rhd at the ice/oce interface (ocean side)
       ! usefull to reduce residual current in the test case ISOMIP with no melting
+      DO ji = 1, jpi
+        DO jj = 1, jpj
+          ikt = mikt(ji,jj)
+          zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm)
+          zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm)
+        END DO
+      END DO
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         ikt = mikt(ji,jj)
+         zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm)
+         zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm)
+      END_2D
       CALL eos( zts_top, risfdep, zrhdtop_oce )
 …
       INTEGER  ::   iktb, iktt          ! jk indices at tracer points for top and bottom points
       REAL(wp) ::   zcoef0, zep, cffw   ! temporary scalars
       REAL(wp) ::   z_grav_10, z1_12
+      REAL(wp) ::   z_grav_10, z1_12, z1_cff
       REAL(wp) ::   cffu, cffx          !    "         "
       REAL(wp) ::   cffv, cffy          !    "         "
       LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zhpj
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzx, zdzy, zdzz                          ! Primitive grid differences ('delta_xyz')
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdz_i, zdz_j, zdz_k                       ! Harmonic average of primitive grid differences ('d_xyz')
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdrhox, zdrhoy, zdrhoz                    ! Primitive rho differences ('delta_rho')
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdrho_i, zdrho_j, zdrho_k                 ! Harmonic average of primitive rho differences ('d_rho')
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z_rho_i, z_rho_j, z_rho_k                 ! Face intergrals
       REAL(wp), DIMENSION(jpi,jpj)     ::   zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j    ! temporary arrays
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zhpi, zhpj
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdzx, zdzy, zdzz                          ! Primitive grid differences ('delta_xyz')
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdz_i, zdz_j, zdz_k                       ! Harmonic average of primitive grid differences ('d_xyz')
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdrhox, zdrhoy, zdrhoz                    ! Primitive rho differences ('delta_rho')
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdrho_i, zdrho_j, zdrho_k                 ! Harmonic average of primitive rho differences ('d_rho')
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   z_rho_i, z_rho_j, z_rho_k                 ! Face intergrals
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j    ! temporary arrays
       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter
       !!----------------------------------------------------------------------
+      !
       IF( ln_wd_il ) THEN
          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) )
+         ALLOCATE( zcpx(A2D(nn_hls)) , zcpy(A2D(nn_hls)) )
         DO_2D( 0, 0, 0, 0 )
           ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
 …
           END IF
         END_2D
-        CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )
       END IF
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_djc : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme'
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:hpg_djc : hydrostatic pressure gradient trend'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme'
+         ENDIF
       ENDIF
 …
       zdz_k  (:,:,:) = 0._wp
+      DO_3D( 1, 1, 1, 1, 2, jpk-2 )
+         cffw = 2._wp * zdrhoz(ji  ,jj  ,jk) * zdrhoz(ji,jj,jk+1)
+         IF( cffw > zep) THEN
+            zdrho_k(ji,jj,jk) = cffw / ( zdrhoz(ji,jj,jk) + zdrhoz(ji,jj,jk+1) )
+         ENDIF
+      DO_3D( 1, 1, 1, 1, 2, jpk-2 )
+         cffw = MAX( 2._wp * zdrhoz(ji,jj,jk) * zdrhoz(ji,jj,jk+1), 0._wp )
+         z1_cff = zdrhoz(ji,jj,jk) + zdrhoz(ji,jj,jk+1)
+         zdrho_k(ji,jj,jk) = cffw / SIGN( MAX( ABS(z1_cff), zep ), z1_cff )
          zdz_k(ji,jj,jk) = 2._wp *   zdzz(ji,jj,jk) * zdzz(ji,jj,jk+1)   &
             &                  / ( zdzz(ji,jj,jk) + zdzz(ji,jj,jk+1) )
 …
 ! mb for sea-ice shelves we will need to re-write this upper boundary condition in the same form as the lower boundary condition
+      zdrho_k(:,:,1) = aco_bc_vrt * ( rhd    (:,:,2) - rhd    (:,:,1) ) - bco_bc_vrt * zdrho_k(:,:,2)
+      zdz_k  (:,:,1) = aco_bc_vrt * (-gde3w(:,:,2) + gde3w(:,:,1) ) - bco_bc_vrt * zdz_k  (:,:,2)
+      DO_2D( 1, 1, 1, 1 )
+         zdrho_k(ji,jj,1) = aco_bc_vrt * ( rhd  (ji,jj,2) - rhd  (ji,jj,1) ) - bco_bc_vrt * zdrho_k(ji,jj,2)
+         zdz_k  (ji,jj,1) = aco_bc_vrt * (-gde3w(ji,jj,2) + gde3w(ji,jj,1) ) - bco_bc_vrt * zdz_k  (ji,jj,2)
+      END_2D
       DO_2D( 1, 1, 1, 1 )
 …
       !  5. compute and store elementary horizontal differences in provisional arrays
       !----------------------------------------------------------------------------------------
+      DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+         zdrhox(ji,jj,jk) =   rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
+         zdzx  (ji,jj,jk) = - gde3w(ji+1,jj  ,jk) + gde3w(ji,jj,jk  )
+         zdrhoy(ji,jj,jk) =   rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
+         zdzy  (ji,jj,jk) = - gde3w(ji  ,jj+1,jk) + gde3w(ji,jj,jk  )
+      END_3D
+      CALL lbc_lnk( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V', 1. )
+      zdrhox(:,:,:) = 0._wp
+      zdzx  (:,:,:) = 0._wp
+      zdrhoy(:,:,:) = 0._wp
+      zdzy  (:,:,:) = 0._wp
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+         zdrhox(ji,jj,jk) = rhd  (ji+1,jj  ,jk) - rhd  (ji  ,jj  ,jk)
+         zdzx  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji+1,jj  ,jk)
+         zdrhoy(ji,jj,jk) = rhd  (ji  ,jj+1,jk) - rhd  (ji  ,jj  ,jk)
+         zdzy  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji  ,jj+1,jk)
+      END_3D
+      IF( nn_hls == 1 ) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1._wp, zdzx, 'U', -1._wp, zdrhoy, 'V', -1._wp, zdzy, 'V', -1._wp )
       !-------------------------------------------------------------------------
 …
       DO_3D( 0, 1, 0, 1, 1, jpkm1 )
+         cffu = 2._wp * zdrhox(ji-1,jj  ,jk) * zdrhox(ji,jj,jk  )
+         IF( cffu > zep ) THEN
+            zdrho_i(ji,jj,jk) = cffu / ( zdrhox(ji-1,jj,jk) + zdrhox(ji,jj,jk) )
+         ELSE
+            zdrho_i(ji,jj,jk ) = 0._wp
+         ENDIF
+         cffx = 2._wp * zdzx  (ji-1,jj  ,jk) * zdzx  (ji,jj,jk  )
+         IF( cffx > zep ) THEN
+            zdz_i(ji,jj,jk) = cffx / ( zdzx(ji-1,jj,jk) + zdzx(ji,jj,jk) )
+         ELSE
+            zdz_i(ji,jj,jk) = 0._wp
+         ENDIF
+         cffv = 2._wp * zdrhoy(ji  ,jj-1,jk) * zdrhoy(ji,jj,jk  )
+         IF( cffv > zep ) THEN
+            zdrho_j(ji,jj,jk) = cffv / ( zdrhoy(ji,jj-1,jk) + zdrhoy(ji,jj,jk) )
+         ELSE
+            zdrho_j(ji,jj,jk) = 0._wp
+         ENDIF
+         cffy = 2._wp * zdzy  (ji  ,jj-1,jk) * zdzy  (ji,jj,jk  )
+         IF( cffy > zep ) THEN
+            zdz_j(ji,jj,jk) = cffy / ( zdzy(ji,jj-1,jk) + zdzy(ji,jj,jk) )
+         ELSE
+            zdz_j(ji,jj,jk) = 0._wp
+         ENDIF
+         cffu = MAX( 2._wp * zdrhox(ji-1,jj,jk) * zdrhox(ji,jj,jk), 0._wp )
+         z1_cff = zdrhox(ji-1,jj,jk) + zdrhox(ji,jj,jk)
+         zdrho_i(ji,jj,jk) = cffu / SIGN( MAX( ABS(z1_cff), zep ), z1_cff )
+         cffx = MAX( 2._wp * zdzx(ji-1,jj,jk)   * zdzx(ji,jj,jk), 0._wp )
+         z1_cff = zdzx(ji-1,jj,jk)   + zdzx(ji,jj,jk)
+         zdz_i(ji,jj,jk)   = cffx / SIGN( MAX( ABS(z1_cff), zep ), z1_cff )
+         cffv = MAX( 2._wp * zdrhoy(ji,jj-1,jk) * zdrhoy(ji,jj,jk), 0._wp )
+         z1_cff = zdrhoy(ji,jj-1,jk) + zdrhoy(ji,jj,jk)
+         zdrho_j(ji,jj,jk) = cffv / SIGN( MAX( ABS(z1_cff), zep ), z1_cff )
+         cffy = MAX( 2._wp * zdzy(ji,jj-1,jk)   * zdzy(ji,jj,jk), 0._wp )
+         z1_cff = zdzy(ji,jj-1,jk)   + zdzy(ji,jj,jk)
+         zdz_j(ji,jj,jk)   = cffy / SIGN( MAX( ABS(z1_cff), zep ), z1_cff )
       END_3D
 …
          zz_drho_j(:,:) = zdrho_j(:,:,jk)
          zz_dz_j  (:,:) = zdz_j  (:,:,jk)
+         DO_2D( 0, 1, 0, 1)
+            ! Walls coming from left: should check from 2 to jpi-1 (and jpj=2-jpj)
+            IF (ji < jpi) THEN
+               IF ( umask(ji,jj,jk) > 0.5_wp .AND. umask(ji-1,jj,jk) < 0.5_wp .AND. umask(ji+1,jj,jk) > 0.5_wp)  THEN
+                  zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_i(ji+1,jj,jk)
+                  zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji+1,jj,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_i  (ji+1,jj,jk)
+               END IF
+         ! Walls coming from left: should check from 2 to jpi-1 (and jpj=2-jpj)
+         DO_2D( 0, 0, 0, 1 )
+            IF ( umask(ji,jj,jk) > 0.5_wp .AND. umask(ji-1,jj,jk) < 0.5_wp .AND. umask(ji+1,jj,jk) > 0.5_wp)  THEN
+               zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_i(ji+1,jj,jk)
+               zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji+1,jj,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_i  (ji+1,jj,jk)
             END IF
             ! Walls coming from right: should check from 3 to jpi (and jpj=2-jpj)
             IF (ji > 2) THEN
                IF ( umask(ji,jj,jk) < 0.5_wp .AND. umask(ji-1,jj,jk) > 0.5_wp .AND. umask(ji-2,jj,jk) > 0.5_wp) THEN
                   zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji-1,jj,jk) ) - bco_bc_hor * zdrho_i(ji-1,jj,jk)
                   zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji-1,jj,jk) ) - bco_bc_hor * zdz_i  (ji-1,jj,jk)
                END IF
+         END_2D
+         ! Walls coming from right: should check from 3 to jpi (and jpj=2-jpj)
+         DO_2D( -1, 1, 0, 1 )
+            IF ( umask(ji,jj,jk) < 0.5_wp .AND. umask(ji-1,jj,jk) > 0.5_wp .AND. umask(ji-2,jj,jk) > 0.5_wp) THEN
+               zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji-1,jj,jk) ) - bco_bc_hor * zdrho_i(ji-1,jj,jk)
+               zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji-1,jj,jk) ) - bco_bc_hor * zdz_i  (ji-1,jj,jk)
             END IF
             ! Walls coming from left: should check from 2 to jpj-1 (and jpi=2-jpi)
             IF (jj < jpj) THEN
                IF ( vmask(ji,jj,jk) > 0.5_wp .AND. vmask(ji,jj-1,jk) < 0.5_wp .AND. vmask(ji,jj+1,jk) > 0.5_wp)  THEN
                   zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_j(ji,jj+1,jk)
                   zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj+1,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_j  (ji,jj+1,jk)
                END IF
             END IF
             ! Walls coming from right: should check from 3 to jpj (and jpi=2-jpi)
             IF (jj > 2) THEN
                IF ( vmask(ji,jj,jk) < 0.5_wp .AND. vmask(ji,jj-1,jk) > 0.5_wp .AND. vmask(ji,jj-2,jk) > 0.5_wp) THEN
                   zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji,jj-1,jk) ) - bco_bc_hor * zdrho_j(ji,jj-1,jk)
                   zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji,jj-1,jk) ) - bco_bc_hor * zdz_j  (ji,jj-1,jk)
                END IF
+         END_2D
+         ! Walls coming from left: should check from 2 to jpj-1 (and jpi=2-jpi)
+         DO_2D( 0, 1, 0, 0 )
+            IF ( vmask(ji,jj,jk) > 0.5_wp .AND. vmask(ji,jj-1,jk) < 0.5_wp .AND. vmask(ji,jj+1,jk) > 0.5_wp)  THEN
+               zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_j(ji,jj+1,jk)
+               zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj+1,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_j  (ji,jj+1,jk)
+            END IF
+         END_2D
+         ! Walls coming from right: should check from 3 to jpj (and jpi=2-jpi)
+         DO_2D( 0, 1, -1, 1 )
+            IF ( vmask(ji,jj,jk) < 0.5_wp .AND. vmask(ji,jj-1,jk) > 0.5_wp .AND. vmask(ji,jj-2,jk) > 0.5_wp) THEN
+               zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji,jj-1,jk) ) - bco_bc_hor * zdrho_j(ji,jj-1,jk)
+               zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji,jj-1,jk) ) - bco_bc_hor * zdz_j  (ji,jj-1,jk)
             END IF
          END_2D
 …
       REAL(wp) :: zrhdt1
       REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2
       REAL(wp), DIMENSION(jpi,jpj)     ::   zpgu, zpgv   ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj)     ::   zsshu_n, zsshv_n
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdept, zrhh
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zpgu, zpgv   ! 2D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zsshu_n, zsshv_n
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdept, zrhh
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter
       !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian'
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian'
+         ENDIF
       ENDIF
 …
+      !
       IF( ln_wd_il ) THEN
          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) )
+         ALLOCATE( zcpx(A2D(nn_hls)) , zcpy(A2D(nn_hls)) )
          DO_2D( 0, 0, 0, 0 )
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (         &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+          IF(ll_tmp1) THEN
+            zcpx(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) )
+             zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+          ELSE
+            zcpx(ji,jj) = 0._wp
+          END IF
+          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            &
+               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  &
+               &                                                      > rn_wdmin1 + rn_wdmin2
+          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (      &
+               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                &
+               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+          IF(ll_tmp1) THEN
+            zcpy(ji,jj) = 1.0_wp
+          ELSE IF(ll_tmp2) THEN
+            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) )
+             zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp)
+            ll_tmp1 = MIN(   ssh(ji,jj,Kmm)              ,   ssh(ji+1,jj,Kmm)                 ) >       &
+               &      MAX( -ht_0(ji,jj)                  , -ht_0(ji+1,jj)                     ) .AND.   &
+               &      MAX(   ssh(ji,jj,Kmm) + ht_0(ji,jj),   ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) ) >       &
+               &      rn_wdmin1 + rn_wdmin2
+            ll_tmp2 = ( ABS(   ssh(ji,jj,Kmm) -   ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND.                   &
+               &      ( MAX(   ssh(ji,jj,Kmm) ,   ssh(ji+1,jj,Kmm) ) >                                  &
+               &        MAX( -ht_0(ji,jj)     , -ht_0(ji+1,jj)     ) + rn_wdmin1 + rn_wdmin2 )
+            IF(ll_tmp1) THEN
+               zcpx(ji,jj) = 1.0_wp
+            ELSE IF(ll_tmp2) THEN
+               ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here
+               zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                           &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) )
+               zcpx(ji,jj) = MAX(MIN( zcpx(ji,jj) , 1.0_wp),0.0_wp)
+            ELSE
+               zcpx(ji,jj) = 0._wp
+            END IF
+            ll_tmp1 = MIN(   ssh(ji,jj,Kmm)              ,   ssh(ji,jj+1,Kmm)                 ) >       &
+               &      MAX( -ht_0(ji,jj)                  , -ht_0(ji,jj+1)                     ) .AND.   &
+               &      MAX(   ssh(ji,jj,Kmm) + ht_0(ji,jj),   ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) ) >       &
+               &      rn_wdmin1 + rn_wdmin2
+            ll_tmp2 = ( ABS(   ssh(ji,jj,Kmm) -   ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND.                   &
+               &      ( MAX(   ssh(ji,jj,Kmm) ,   ssh(ji,jj+1,Kmm) ) >                                  &
+               &        MAX( -ht_0(ji,jj)     , -ht_0(ji,jj+1)     ) + rn_wdmin1 + rn_wdmin2 )
+            IF(ll_tmp1) THEN
+               zcpy(ji,jj) = 1.0_wp
+            ELSE IF(ll_tmp2) THEN
+               ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here
+               zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) &
+                           &    / (ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm)) )
+               zcpy(ji,jj) = MAX(MIN( zcpy(ji,jj) , 1.0_wp),0.0_wp)
             ELSE
                zcpy(ji,jj) = 0._wp
             ENDIF
          END_2D
-         CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )
       ENDIF
       ! Clean 3-D work arrays
       zhpi(:,:,:) = 0._wp
       zrhh(:,:,:) = rhd(:,:,:)
+      zrhh(:,:,:) = rhd(A2D(nn_hls),:)
       ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate
       DO_2D( 1, 1, 1, 1 )
        jk = mbkt(ji,jj)
        IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
        ELSEIF( jk ==  2   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
        ELSEIF( jk < jpkm1 ) THEN
           DO jkk = jk+1, jpk
              zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   &
                 &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2))
           END DO
        ENDIF
+         jk = mbkt(ji,jj)
+         IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
+         ELSEIF( jk ==  2   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
+         ELSEIF( jk < jpkm1 ) THEN
+            DO jkk = jk+1, jpk
+               zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   &
+                  &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2))
+            END DO
+         ENDIF
       END_2D
 …
       ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)"
       DO_2D( 0, 1, 0, 1 )
        zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
           &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm)
        ! assuming linear profile across the top half surface layer
        zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1
+         zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
+            &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm)
+         ! assuming linear profile across the top half surface layer
+         zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1
       END_2D
       ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)"
       DO_3D( 0, 1, 0, 1, 2, jpkm1 )
       zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
          &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
          &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
          &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
+         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
+            &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
+            &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
+            &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
       END_3D
 …
 !                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp
 !!gm not this:
+       zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * &
+                      & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp
+       zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * &
+                      & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp
+      END_2D
+      CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp )
+         zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * &
+                        & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp
+         zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * &
+                        & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp
+      END_2D
       DO_2D( 0, 0, 0, 0 )
        zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) )
        zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) )
+         zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) )
+         zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) )
       END_2D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
       zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm)
       zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm)
+         zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm)
+         zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm)
       END_3D
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )
       zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm)
       zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm)
+         zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm)
+         zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm)
       END_3D
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )
       zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
       zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
       zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
       zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+         zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+         zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+         zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+         zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
       END_3D
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+      zpwes = 0._wp; zpwed = 0._wp
+      zpnss = 0._wp; zpnsd = 0._wp
+      zuijk = zu(ji,jj,jk)
+      zvijk = zv(ji,jj,jk)
+      !!!!!     for u equation
+      IF( jk <= mbku(ji,jj) ) THEN
+         IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
+           jis = ji + 1; jid = ji
+         ELSE
+           jis = ji;     jid = ji +1
+         zpwes = 0._wp; zpwed = 0._wp
+         zpnss = 0._wp; zpnsd = 0._wp
+         zuijk = zu(ji,jj,jk)
+         zvijk = zv(ji,jj,jk)
+         !!!!!     for u equation
+         IF( jk <= mbku(ji,jj) ) THEN
+            IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
+              jis = ji + 1; jid = ji
+            ELSE
+              jis = ji;     jid = ji +1
+            ENDIF
+            ! integrate the pressure on the shallow side
+            jk1 = jk
+            DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
+               IF( jk1 == mbku(ji,jj) ) THEN
+                  zuijk = -zdept(jis,jj,jk1)
+                  EXIT
+               ENDIF
+               zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
+               zpwes = zpwes +                                      &
+                  integ_spline(zdept(jis,jj,jk1), zdeps,            &
+                                 asp(jis,jj,jk1), bsp(jis,jj,jk1),  &
+                                 csp(jis,jj,jk1), dsp(jis,jj,jk1))
+               jk1 = jk1 + 1
+            END DO
+            ! integrate the pressure on the deep side
+            jk1 = jk
+            DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
+               IF( jk1 == 1 ) THEN
+                  zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad)
+                  zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
+                                                    bsp(jid,jj,1)  , csp(jid,jj,1), &
+                                                    dsp(jid,jj,1)) * zdeps
+                  zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
+                  EXIT
+               ENDIF
+               zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
+               zpwed = zpwed +                                        &
+                  integ_spline(zdeps,             zdept(jid,jj,jk1),  &
+                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
+                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
+               jk1 = jk1 - 1
+            END DO
+            ! update the momentum trends in u direction
+            zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
+            IF( .NOT.ln_linssh ) THEN
+               zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
+                  &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) )
+            ELSE
+               zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
+            ENDIF
+            IF( ln_wd_il ) THEN
+               zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
+               zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
+            ENDIF
+            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk)
          ENDIF
+         ! integrate the pressure on the shallow side
+         jk1 = jk
+         DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
+           IF( jk1 == mbku(ji,jj) ) THEN
+             zuijk = -zdept(jis,jj,jk1)
+             EXIT
+           ENDIF
+           zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
+           zpwes = zpwes +                                    &
+                integ_spline(zdept(jis,jj,jk1), zdeps,            &
+                       asp(jis,jj,jk1),    bsp(jis,jj,jk1), &
+                       csp(jis,jj,jk1),    dsp(jis,jj,jk1))
+           jk1 = jk1 + 1
+         END DO
+         ! integrate the pressure on the deep side
+         jk1 = jk
+         DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
+           IF( jk1 == 1 ) THEN
+             zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad)
+             zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
+                                               bsp(jid,jj,1),   csp(jid,jj,1), &
+                                               dsp(jid,jj,1)) * zdeps
+             zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
+             EXIT
+           ENDIF
+           zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
+           zpwed = zpwed +                                        &
+                  integ_spline(zdeps,              zdept(jid,jj,jk1), &
+                         asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
+                         csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
+           jk1 = jk1 - 1
+         END DO
+         ! update the momentum trends in u direction
+         zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
+         IF( .NOT.ln_linssh ) THEN
+           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
+              &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) )
+          ELSE
+           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
+         !!!!!     for v equation
+         IF( jk <= mbkv(ji,jj) ) THEN
+            IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
+               jjs = jj + 1; jjd = jj
+            ELSE
+               jjs = jj    ; jjd = jj + 1
+            ENDIF
+            ! integrate the pressure on the shallow side
+            jk1 = jk
+            DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
+               IF( jk1 == mbkv(ji,jj) ) THEN
+                  zvijk = -zdept(ji,jjs,jk1)
+                  EXIT
+               ENDIF
+               zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
+               zpnss = zpnss +                                       &
+                  integ_spline(zdept(ji,jjs,jk1), zdeps,             &
+                               asp(ji,jjs,jk1),   bsp(ji,jjs,jk1),   &
+                               csp(ji,jjs,jk1),   dsp(ji,jjs,jk1) )
+              jk1 = jk1 + 1
+            END DO
+            ! integrate the pressure on the deep side
+            jk1 = jk
+            DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
+               IF( jk1 == 1 ) THEN
+                  zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad)
+                  zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
+                                                    bsp(ji,jjd,1)  , csp(ji,jjd,1), &
+                                                    dsp(ji,jjd,1) ) * zdeps
+                  zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
+                  EXIT
+               ENDIF
+               zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
+               zpnsd = zpnsd +                                        &
+                  integ_spline(zdeps,             zdept(ji,jjd,jk1),  &
+                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1),  &
+                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
+               jk1 = jk1 - 1
+            END DO
+            ! update the momentum trends in v direction
+            zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
+            IF( .NOT.ln_linssh ) THEN
+               zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
+                       ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) )
+            ELSE
+               zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
+            ENDIF
+            IF( ln_wd_il ) THEN
+               zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj)
+               zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj)
+            ENDIF
+            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk)
          ENDIF
-         IF( ln_wd_il ) THEN
-            zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj)
-            zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj)
-         ENDIF
-         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk)
-      ENDIF
-      !!!!!     for v equation
-      IF( jk <= mbkv(ji,jj) ) THEN
-         IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
-           jjs = jj + 1; jjd = jj
-         ELSE
-           jjs = jj    ; jjd = jj + 1
-         ENDIF
-         ! integrate the pressure on the shallow side
-         jk1 = jk
-         DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
-           IF( jk1 == mbkv(ji,jj) ) THEN
-             zvijk = -zdept(ji,jjs,jk1)
-             EXIT
-           ENDIF
-           zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
-           zpnss = zpnss +                                      &
-                  integ_spline(zdept(ji,jjs,jk1), zdeps,            &
-                         asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), &
-                         csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) )
-           jk1 = jk1 + 1
-         END DO
-         ! integrate the pressure on the deep side
-         jk1 = jk
-         DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
-           IF( jk1 == 1 ) THEN
-             zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad)
-             zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
-                                               bsp(ji,jjd,1),   csp(ji,jjd,1), &
-                                               dsp(ji,jjd,1) ) * zdeps
-             zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
-             EXIT
-           ENDIF
-           zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
-           zpnsd = zpnsd +                                        &
-                  integ_spline(zdeps,              zdept(ji,jjd,jk1), &
-                         asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), &
-                         csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
-           jk1 = jk1 - 1
-         END DO
-         ! update the momentum trends in v direction
-         zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
-         IF( .NOT.ln_linssh ) THEN
-            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
-                    ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) )
-         ELSE
-            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
-         ENDIF
-         IF( ln_wd_il ) THEN
-            zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj)
-            zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj)
-         ENDIF
-         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk)
-      ENDIF
+         !
       END_3D
 …
       !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   fsp, xsp           ! value and coordinate
       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function
       INTEGER                   , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   fsp, xsp           ! value and coordinate
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function
+      INTEGER                             , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear
+      !
       INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      INTEGER  ::   jpi, jpj, jpkm1
       REAL(wp) ::   zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp
       REAL(wp) ::   zdxtmp1, zdxtmp2, zalpha
+      REAL(wp) ::   zdf(size(fsp,3))
+      !!----------------------------------------------------------------------
+      !
+!!gm  WHAT !!!!!   THIS IS VERY DANGEROUS !!!!!
+      jpi   = size(fsp,1)
+      jpj   = size(fsp,2)
+      jpkm1 = MAX( 1, size(fsp,3) - 1 )
+      REAL(wp) ::   zdf(jpk)
+      !!----------------------------------------------------------------------
+      !
       IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+           !!Fritsch&Butland's method, 1984 (preferred, but more computation)
+           !    DO jk = 2, jpkm1-1
+           !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1)
+           !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+           !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1
+           !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2
+           !
+           !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp
+           !
+           !       IF(zdf1 * zdf2 <= 0._wp) THEN
+           !           zdf(jk) = 0._wp
+           !       ELSE
+           !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 )
+           !       ENDIF
+           !    END DO
+           !!Simply geometric average
+               DO jk = 2, jpkm1-1
+                  zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1))
+                  zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  ))
+                  IF(zdf1 * zdf2 <= 0._wp) THEN
+                     zdf(jk) = 0._wp
+                  ELSE
+                     zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2)
+                  ENDIF
+               END DO
+               zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / &
+                          &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2)
+               zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / &
+                          &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpkm1 - 1)
+               DO jk = 1, jpkm1 - 1
+                 zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+                 ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp
+                 ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp
+                 zddf1  = -2._wp * ztmp1 + ztmp2
+                 ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp
+                 zddf2  =  2._wp * ztmp1 - ztmp2
+                 dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp
+                 csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp
+                 bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - &
+                               & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - &
+                               & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - &
+                               &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk))
+                 asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + &
+                               &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + &
+                               &                 dsp(ji,jj,jk) * xsp(ji,jj,jk))))
+               END DO
+         DO_2D( 1, 1, 1, 1 )
+            !!Fritsch&Butland's method, 1984 (preferred, but more computation)
+            !    DO jk = 2, jpkm1-1
+            !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1)
+            !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+            !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1
+            !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2
+            !
+            !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp
+            !
+            !       IF(zdf1 * zdf2 <= 0._wp) THEN
+            !           zdf(jk) = 0._wp
+            !       ELSE
+            !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 )
+            !       ENDIF
+            !    END DO
+            !!Simply geometric average
+            DO jk = 2, jpk-2
+               zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1))
+               zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  ))
+               IF(zdf1 * zdf2 <= 0._wp) THEN
+                  zdf(jk) = 0._wp
+               ELSE
+                  zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2)
+               ENDIF
             END DO
+         END DO
+            zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / &
+                       &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2)
+            zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / &
+                       &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpk - 2)
+            DO jk = 1, jpk-2
+               zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+               ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp
+               ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp
+               zddf1  = -2._wp * ztmp1 + ztmp2
+               ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp
+               zddf2  =  2._wp * ztmp1 - ztmp2
+               dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp
+               csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp
+               bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - &
+                             & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - &
+                             & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - &
+                             &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk))
+               asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + &
+                             &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + &
+                             &                 dsp(ji,jj,jk) * xsp(ji,jj,jk))))
+            END DO
+         END_2D
       ELSEIF ( polynomial_type == 2 ) THEN     ! Linear
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+               DO jk = 1, jpkm1-1
+                  zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+                  ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk)
+                  dsp(ji,jj,jk) = 0._wp
+                  csp(ji,jj,jk) = 0._wp
+                  bsp(ji,jj,jk) = ztmp1 / zdxtmp
+                  asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         DO_3D( 1, 1, 1, 1, 1, jpk-2 )
+            zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+            ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk)
+            dsp(ji,jj,jk) = 0._wp
+            csp(ji,jj,jk) = 0._wp
+            bsp(ji,jj,jk) = ztmp1 / zdxtmp
+            asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk)
+         END_3D
+         !
       ELSE

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynkeg.F90

-                      r13497
+                      r14958
       INTEGER  ::   ji, jj, jk             ! dummy loop indices
       REAL(wp) ::   zu, zv                   ! local scalars
       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zhke
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk)    ::   zhke
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv
       !!----------------------------------------------------------------------
 …
       IF( ln_timing )   CALL timing_start('dyn_keg')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
       ENDIF
 …
          END_3D
       CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D( 0, nn_hls-1, 0, nn_hls-1, 1, jpkm1 )
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
             zu = 8._wp * ( puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)    &
                &         + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) )  &
+               &   +     ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   &
+               &   +     ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )
+               &   +     ( ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   &
+               &   +       ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )   &
+               &         )                                                               ! bracket for halo 1 - halo 2 compatibility
+               !
             zv = 8._wp * ( pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)    &
                &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  &
+               &  +      ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )   &
+               &  +      ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )
+               &  +      ( ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )  &
+               &  +        ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )  &
+               &         )                                                               ! bracket for halo 1 - halo 2 compatibility
             zhke(ji,jj,jk) = r1_48 * ( zv + zu )
          END_3D
          CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp )
+         !
       END SELECT

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynldf_iso.F90

-                      r14433
+                      r14958
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
+#if defined key_loop_fusion
+   USE dynldf_iso_lf, ONLY: dyn_ldf_iso_lf   ! lateral mixing - loop fusion version (dyn_ldf_iso routine )
+#endif
    IMPLICIT NONE
 …
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akzu, akzv   !: vertical component of rotated lateral viscosity
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u   ! 2D workspace (dyn_ldf_iso)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v   !  -      -
    !! * Substitutions
 …
       !!                  ***  ROUTINE dyn_ldf_iso_alloc  ***
       !!----------------------------------------------------------------------
+      ALLOCATE( akzu(jpi,jpj,jpk) , zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     &
+         &      akzv(jpi,jpj,jpk) , zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc )
+         !
+      IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.')
+      dyn_ldf_iso_alloc = 0
+      IF( .NOT. ALLOCATED( akzu ) ) THEN
+         ALLOCATE( akzu(jpi,jpj,jpk), akzv(jpi,jpj,jpk), STAT=dyn_ldf_iso_alloc )
+            !
+         IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.')
+      ENDIF
    END FUNCTION dyn_ldf_iso_alloc
 …
       REAL(wp) ::   zabe2, zmskf, zmkf, zvav, zvwslpi, zvwslpj   !   -      -
       REAL(wp) ::   zcof0, zcof1, zcof2, zcof3, zcof4, zaht_0    !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   ziut, zivf, zdku, zdk1u  ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   zjuf, zjvt, zdkv, zdk1v  !  -      -
+      REAL(wp), DIMENSION(A2D(nn_hls))      ::   ziut, zivf, zdku, zdk1u  ! 2D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zjuf, zjvt, zdkv, zdk1v  !  -      -
+      REAL(wp), DIMENSION(A1Di(nn_hls),jpk) ::   zfuw, zdiu, zdju, zdj1u  !  -      -
+      REAL(wp), DIMENSION(A1Di(nn_hls),jpk) ::   zfvw, zdiv, zdjv, zdj1v  !  -      -
       !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator'
+         !                                      ! allocate dyn_ldf_bilap arrays
+         IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays')
+#if defined key_loop_fusion
+      CALL dyn_ldf_iso_lf( kt, Kbb, Kmm, puu, pvv, Krhs    )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or '
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator'
+            !                                      ! allocate dyn_ldf_iso arrays
+            IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays')
+         ENDIF
       ENDIF
 …
       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
+         !
          DO_3D( 0, 0, 0, 0, 1, jpk )      ! set the slopes of iso-level
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )      ! set the slopes of iso-level
             uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
             vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
 …
          END_3D
          ! Lateral boundary conditions on the slopes
          CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp )
+         IF (nn_hls == 1) CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp )
+         !
        ENDIF
+      ENDIF
       zaht_0 = 0.5_wp * rn_Ud * rn_Ld                  ! aht_0 from namtra_ldf = zaht_max
 …
          !                             zdkv(jk=1)=zdkv(jk=2)
+         zdk1u(:,:) = ( puu(:,:,jk,Kbb) -puu(:,:,jk+1,Kbb) ) * umask(:,:,jk+1)
+         zdk1v(:,:) = ( pvv(:,:,jk,Kbb) -pvv(:,:,jk+1,Kbb) ) * vmask(:,:,jk+1)
+         DO_2D( 1, 1, 1, 1 )
+            zdk1u(ji,jj) = ( puu(ji,jj,jk,Kbb) -puu(ji,jj,jk+1,Kbb) ) * umask(ji,jj,jk+1)
+            zdk1v(ji,jj) = ( pvv(ji,jj,jk,Kbb) -pvv(ji,jj,jk+1,Kbb) ) * vmask(ji,jj,jk+1)
+         END_2D
          IF( jk == 1 ) THEN
 …
             zdkv(:,:) = zdk1v(:,:)
          ELSE
+            zdku(:,:) = ( puu(:,:,jk-1,Kbb) - puu(:,:,jk,Kbb) ) * umask(:,:,jk)
+            zdkv(:,:) = ( pvv(:,:,jk-1,Kbb) - pvv(:,:,jk,Kbb) ) * vmask(:,:,jk)
+            DO_2D( 1, 1, 1, 1 )
+               zdku(ji,jj) = ( puu(ji,jj,jk-1,Kbb) - puu(ji,jj,jk,Kbb) ) * umask(ji,jj,jk)
+               zdkv(ji,jj) = ( pvv(ji,jj,jk-1,Kbb) - pvv(ji,jj,jk,Kbb) ) * vmask(ji,jj,jk)
+            END_2D
          ENDIF
 …
       !                                                ! ===============
       DO jj = 2, jpjm1                                 !  Vertical slab
+      DO jj = ntsj, ntej                               !  Vertical slab
          !                                             ! ===============
 …
          DO jk = 1, jpk
             DO ji = 2, jpi
+            DO ji = ntsi, ntei + nn_hls
                ! i-gradient of u at jj
                zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji-1,jj  ,jk,Kbb) )
 …
          END DO
          DO jk = 1, jpk
             DO ji = 1, jpim1
+            DO ji = ntsi - nn_hls, ntei
                ! i-gradient of v at jj
                zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) )
 …
          ! Surface and bottom vertical fluxes set to zero
          DO ji = 1, jpi
+         DO ji = ntsi - nn_hls, ntei + nn_hls
             zfuw(ji, 1 ) = 0.e0
             zfvw(ji, 1 ) = 0.e0
 …
          ! interior (2=<jk=<jpk-1) on U field
          DO jk = 2, jpkm1
             DO ji = 2, jpim1
+            DO ji = ntsi, ntei
                zcof0 = 0.5_wp * zaht_0 * umask(ji,jj,jk)
+               !
 …
          ! interior (2=<jk=<jpk-1) on V field
          DO jk = 2, jpkm1
             DO ji = 2, jpim1
+            DO ji = ntsi, ntei
                zcof0 = 0.5_wp * zaht_0 * vmask(ji,jj,jk)
+               !
 …
          ! -------------------------------------------------------------------
          DO jk = 1, jpkm1
             DO ji = 2, jpim1
+            DO ji = ntsi, ntei
                puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj)   &
                   &               / e3u(ji,jj,jk,Kmm)
 …
       END DO                                           !   End of slab
       !                                                ! ===============
+#endif
    END SUBROUTINE dyn_ldf_iso

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynldf_lap_blp.F90

-                      r14433
+                      r14958
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
+   USE domutl, ONLY : is_tile
    USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
    USE ldfslp         ! iso-neutral slopes
 …
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp
+#if defined key_loop_fusion
+   USE dynldf_lap_blp_lf
+#endif
    IMPLICIT NONE
    PRIVATE
 …
    SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass )
+      !!
+      INTEGER                   , INTENT(in   ) ::   kt               ! ocean time-step index
+      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm         ! ocean time level indices
+      INTEGER                   , INTENT(in   ) ::   kpass            ! =1/2 first or second passage
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pu, pv           ! before velocity  [m/s]
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2]
+      !!
+#if defined key_loop_fusion
+      CALL dyn_ldf_lap_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass )
+#else
+      CALL dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, is_tile(pu), pu_rhs, pv_rhs, is_tile(pu_rhs), kpass )
+#endif
+   END SUBROUTINE dyn_ldf_lap
+   SUBROUTINE dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, ktuv, pu_rhs, pv_rhs, ktuv_rhs, kpass )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE dyn_ldf_lap  ***
 …
       !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/
       !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices
+      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2]
+      INTEGER                                 , INTENT(in   ) ::   kt               ! ocean time-step index
+      INTEGER                                 , INTENT(in   ) ::   Kbb, Kmm         ! ocean time level indices
+      INTEGER                                 , INTENT(in   ) ::   kpass            ! =1/2 first or second passage
+      INTEGER                                 , INTENT(in   ) ::   ktuv, ktuv_rhs
+      REAL(wp), DIMENSION(A2D_T(ktuv)    ,JPK), INTENT(in   ) ::   pu, pv           ! before velocity  [m/s]
+      REAL(wp), DIMENSION(A2D_T(ktuv_rhs),JPK), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2]
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   iij
       REAL(wp) ::   zsign        ! local scalars
       REAL(wp) ::   zua, zva     ! local scalars
 …
       !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass
+         WRITE(numout,*) '~~~~~~~ '
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 .AND. lwp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass
+            WRITE(numout,*) '~~~~~~~ '
+         ENDIF
+      ENDIF
+      !
+      ! Define pu_rhs/pv_rhs halo points for multi-point haloes in bilaplacian case
+      IF( nldf_dyn == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls
+      ELSE                                           ; iij = 1
       ENDIF
+      !
 …
       CASE ( np_typ_rot )       !==  Vorticity-Divergence operator  ==!
+         !
          ALLOCATE( zcur(jpi,jpj) , zdiv(jpi,jpj) )
+         ALLOCATE( zcur(A2D(nn_hls)) , zdiv(A2D(nn_hls)) )
+         !
          DO jk = 1, jpkm1                                 ! Horizontal slab
+            !
             DO_2D( 0, 1, 0, 1 )
+            DO_2D( iij-1, iij, iij-1, iij )
                !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
                zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask
 …
             END_2D
+            !
             DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div )
+            DO_2D( iij-1, iij-1, iij-1, iij-1 )   ! - curl( curl) + grad( div )
                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use
                   &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   &
 …
       CASE ( np_typ_sym )       !==  Symmetric operator  ==!
+         !
          ALLOCATE( zten(jpi,jpj) , zshe(jpi,jpj) )
+         ALLOCATE( zten(A2D(nn_hls)) , zshe(A2D(nn_hls)) )
+         !
          DO jk = 1, jpkm1                                 ! Horizontal slab
+            !
             DO_2D( 0, 1, 0, 1 )
+            DO_2D( iij-1, iij, iij-1, iij )
                !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask
                zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              &
 …
             END_2D
+            !
             DO_2D( 0, 0, 0, 0 )
+            DO_2D( iij-1, iij-1, iij-1, iij-1 )
                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               &
                   &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       &
 …
       END SELECT
+      !
    END SUBROUTINE dyn_ldf_lap
+   END SUBROUTINE dyn_ldf_lap_t
 …
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zulap, zvlap   ! laplacian at u- and v-point
+      !!----------------------------------------------------------------------
+      !
+#if defined key_loop_fusion
+      CALL dyn_ldf_blp_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 )  THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum '
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
       ENDIF
+      !
 …
       CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb)
+      !
       CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions
+      IF (nn_hls==1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions
+      !
       CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs))
+      !
+#endif
    END SUBROUTINE dyn_ldf_blp

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynspg_ts.F90

r14433	r14958
730	730	IF (ln_bt_fw) THEN
731	731	IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN
732		DO_2D( ~~1, 1, 1, 1~~ )
	732	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
733	733	zun_save = un_adv(ji,jj)
734	734	zvn_save = vn_adv(ji,jj)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynvor.F90

-                      r14433
+                      r14958
       INTEGER  ::   ji, jj, jk           ! dummy loop indices
       REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zwt   ! 2D workspace
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwz      ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_enT : vorticity term: t-point energy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      REAL(wp), DIMENSION(A2D(nn_hls))        ::   zwx, zwy, zwt   ! 2D workspace
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwz             ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:vor_enT : vorticity term: t-point energy conserving scheme'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ENDIF
       ENDIF
+      !
 …
+      !
       CASE ( np_RVO , np_CRV )                  !* relative vorticity at f-point is used
          ALLOCATE( zwz(jpi,jpj,jpk) )
+         ALLOCATE( zwz(A2D(nn_hls),jpk) )
          DO jk = 1, jpkm1                                ! Horizontal slab
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
                   &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
             END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity
                DO_2D( 1, 0, 1, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
                END_2D
             ENDIF
          END DO
          CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
+         !
       END SELECT
 …
+         !
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm)
+            DO_2D( 0, 1, 0, 1 )
+               zwt(ji,jj) = ff_t(ji,jj) * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+            END_2D
          CASE ( np_RVO )                           !* relative vorticity
             DO_2D( 0, 1, 0, 1 )
 …
       INTEGER  ::   ji, jj, jk           ! dummy loop indices
       REAL(wp) ::   zx1, zy1, zx2, zy2, ze3f, zmsk   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_ene : vorticity term: energy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zwx, zwy, zwz   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:vor_ene : vorticity term: energy conserving scheme'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ENDIF
       ENDIF
+      !
 …
          SELECT CASE( kvor )                 !==  vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff_f(:,:)
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ff_f(ji,jj)
+            END_2D
          CASE ( np_RVO )                           !* relative vorticity
             DO_2D( 1, 0, 1, 0 )
 …
 #endif
          !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+         DO_2D( 1, 1, 1, 1 )
+            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk)
+            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk)
+         END_2D
+         !
          !                                   !==  compute and add the vorticity term trend  =!
 …
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zuav, zvau, ze3f, zmsk   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_ens : vorticity term: enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zwx, zwy, zwz   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:vor_ens : vorticity term: enstrophy conserving scheme'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ENDIF
       ENDIF
       !                                                ! ===============
 …
          SELECT CASE( kvor )                 !==  vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff_f(:,:)
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj) = ff_f(ji,jj)
+            END_2D
          CASE ( np_RVO )                           !* relative vorticity
             DO_2D( 1, 0, 1, 0 )
 …
 #endif
          !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+         DO_2D( 1, 1, 1, 1 )
+            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk)
+            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk)
+         END_2D
+         !
          !                                   !==  compute and add the vorticity term trend  =!
 …
       REAL(wp) ::   zua, zva     ! local scalars
       REAL(wp) ::   zmsk, ze3f   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy , z1_e3f
+      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse
+      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      REAL(wp), DIMENSION(A2D(nn_hls))       ::   z1_e3f
+#if defined key_loop_fusion
+      REAL(wp) ::   ztne, ztnw, ztnw_ip1, ztse, ztse_jp1, ztsw_jp1, ztsw_ip1
+      REAL(wp) ::   zwx, zwx_im1, zwx_jp1, zwx_im1_jp1
+      REAL(wp) ::   zwy, zwy_ip1, zwy_jm1, zwy_ip1_jm1
+#else
+      REAL(wp), DIMENSION(A2D(nn_hls))       ::   zwx , zwy
+      REAL(wp), DIMENSION(A2D(nn_hls))       ::   ztnw, ztne, ztsw, ztse
+#endif
+      REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) ::   zwz   ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ENDIF
       ENDIF
+      !
 …
+         !
 #if defined key_qco   ||   defined key_linssh
          DO_2D( 1, 0, 1, 0 )                 ! == reciprocal of e3 at F-point (key_qco)
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                 ! == reciprocal of e3 at F-point (key_qco)
             z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk)
          END_2D
 …
          SELECT CASE( nn_e3f_typ )           ! == reciprocal of e3 at F-point
          CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+            DO_2D( 1, 0, 1, 0 )
+               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   &
+                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   &
+                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    &
+                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   &
+                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    &
+                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  )
                IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f
                ELSE                       ;   z1_e3f(ji,jj) = 0._wp
 …
             END_2D
          CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+            DO_2D( 1, 0, 1, 0 )
+               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   &
+                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   &
+                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    &
+                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   &
+                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    &
+                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  )
                zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
                   &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
 …
+         !
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj)
             END_2D
          CASE ( np_RVO )                           !* relative vorticity
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
                   &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)
             END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity
                DO_2D( 1, 0, 1, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
                END_2D
             ENDIF
          CASE ( np_MET )                           !* metric term
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
                   &              - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
             END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                              - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  )   &
+                  &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + ( ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                               )                                                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                             - ( e1u(ji  ,jj+1) * pu(ji,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk)      &
+                  &                               )                                                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                             ) * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
             END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity
                DO_2D( 1, 0, 1, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)
                END_2D
             ENDIF
          CASE ( np_CME )                           !* Coriolis + metric
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
                   &                            - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
 …
       !                                                ! ===============
+      !
+      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+      IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
+      !
+      !                                                ! ===============
+      !                                                ! Horizontal slab
+      !                                                ! ===============
+#if defined key_loop_fusion
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
          !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+         zwx         = e2u(ji  ,jj  ) * e3u(ji  ,jj  ,jk,Kmm) * pu(ji  ,jj  ,jk)
+         zwx_im1     = e2u(ji-1,jj  ) * e3u(ji-1,jj  ,jk,Kmm) * pu(ji-1,jj  ,jk)
+         zwx_jp1     = e2u(ji  ,jj+1) * e3u(ji  ,jj+1,jk,Kmm) * pu(ji  ,jj+1,jk)
+         zwx_im1_jp1 = e2u(ji-1,jj+1) * e3u(ji-1,jj+1,jk,Kmm) * pu(ji-1,jj+1,jk)
+         zwy         = e1v(ji  ,jj  ) * e3v(ji  ,jj  ,jk,Kmm) * pv(ji  ,jj  ,jk)
+         zwy_ip1     = e1v(ji+1,jj  ) * e3v(ji+1,jj  ,jk,Kmm) * pv(ji+1,jj  ,jk)
+         zwy_jm1     = e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * pv(ji  ,jj-1,jk)
+         zwy_ip1_jm1 = e1v(ji+1,jj-1) * e3v(ji+1,jj-1,jk,Kmm) * pv(ji+1,jj-1,jk)
+         !                                   !==  compute and add the vorticity term trend  =!
+         ztne     = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk)
+         ztnw     = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk)
+         ztnw_ip1 = zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji+1,jj  ,jk)
+         ztse     = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk)
+         ztse_jp1 = zwz(ji  ,jj+1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk)
+         ztsw_jp1 = zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk) + zwz(ji-1,jj+1,jk)
+         ztsw_ip1 = zwz(ji+1,jj-1,jk) + zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk)
+         !
+         zua = + r1_12 * r1_e1u(ji,jj) * (  ztne * zwy + ztnw_ip1 * zwy_ip1   &
+            &                             + ztse * zwy_jm1 + ztsw_ip1 * zwy_ip1_jm1 )
+         zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw_jp1 * zwx_im1_jp1 + ztse_jp1 * zwx_jp1   &
+            &                             + ztnw * zwx_im1 + ztne * zwx )
+         pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+         pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+      END_3D
+#else
+      DO jk = 1, jpkm1
+         !
+         !                                   !==  horizontal fluxes  ==!
+         DO_2D( 1, 1, 1, 1 )
+            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk)
+            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk)
+         END_2D
+         !
          !                                   !==  compute and add the vorticity term trend  =!
 …
             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
          END_2D
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      END DO
+#endif
+         !                                             ! ===============
+         !                                             !   End of slab
       !                                                ! ===============
    END SUBROUTINE vor_een
 …
       REAL(wp) ::   zua, zva       ! local scalars
       REAL(wp) ::   zmsk, z1_e3t   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy
+      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse
+      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      REAL(wp), DIMENSION(A2D(nn_hls))       ::   zwx , zwy
+      REAL(wp), DIMENSION(A2D(nn_hls))       ::   ztnw, ztne, ztsw, ztse
+      REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ENDIF
       ENDIF
+      !
 …
          SELECT CASE( kvor )                 !==  vorticity considered  ==!
          CASE ( np_COR )                           !* Coriolis (planetary vorticity)
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = ff_f(ji,jj)
             END_2D
          CASE ( np_RVO )                           !* relative vorticity
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zwz(ji,jj,jk) = (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    &
+                  &             - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) &
                   &          * r1_e1e2f(ji,jj)
             END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity
                DO_2D( 1, 0, 1, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
                END_2D
             ENDIF
          CASE ( np_MET )                           !* metric term
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
                   &          - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
             END_2D
          CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO_2D( 1, 0, 1, 0 )
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+                  &                         * r1_e1e2f(ji,jj)    )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    &
+                  &                              - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) &
+                  &                           * r1_e1e2f(ji,jj)    )
             END_2D
             IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity
                DO_2D( 1, 0, 1, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)
                END_2D
             ENDIF
          CASE ( np_CME )                           !* Coriolis + metric
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
                   &                        - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
 …
       !                                                ! ===============
+      !
       CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
+      IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )
+      !
       !                                                ! ===============
 …
+         !
          !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+         DO_2D( 1, 1, 1, 1 )
+            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk)
+            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk)
+         END_2D
+         !
          !                                   !==  compute and add the vorticity term trend  =!

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynzad.F90

-                      r14072
+                      r14958
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zua, zva     ! local scalars
       REAL(wp), DIMENSION(jpi,jpj)     ::   zww
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwuw, zwvw
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zww
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwuw, zwvw
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv
       !!----------------------------------------------------------------------
 …
       IF( ln_timing )   CALL timing_start('dyn_zad')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zad : 2nd order vertical advection scheme'
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_zad : 2nd order vertical advection scheme'
+         ENDIF
       ENDIF
 …
       DO jk = 2, jpkm1                ! Vertical momentum advection at level w and u- and v- vertical
+         DO_2D( 0, 1, 0, 1 )              ! vertical fluxes
+          IF( ln_vortex_force ) THEN
+            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) )
+          ELSE
+            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+          ENDIF
+         END_2D
+         IF( ln_vortex_force ) THEN       ! vertical fluxes
+            DO_2D( 0, 1, 0, 1 )
+               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) )
+            END_2D
+         ELSE
+            DO_2D( 0, 1, 0, 1 )
+               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
+            END_2D
+         ENDIF
          DO_2D( 0, 0, 0, 0 )              ! vertical momentum advection at w-point
             zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/dynzdf.F90

-                      r13497
+                      r14958
    USE zdfdrg         ! vertical physics: top/bottom drag coef.
    USE dynadv    ,ONLY: ln_dynadv_vec    ! dynamics: advection form
+#if defined key_loop_fusion
+   USE dynldf_iso_lf,ONLY: akzu, akzv       ! dynamics: vertical component of rotated lateral mixing
+#else
    USE dynldf_iso,ONLY: akzu, akzv       ! dynamics: vertical component of rotated lateral mixing
+#endif
    USE ldfdyn         ! lateral diffusion: eddy viscosity coef. and type of operator
    USE trd_oce        ! trends: ocean variables
 …
       REAL(wp) ::   zWui, zWvi         !   -      -
       REAL(wp) ::   zWus, zWvs         !   -      -
       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::  zwi, zwd, zws   ! 3D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk)        ::  zwi, zwd, zws   ! 3D workspace
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv   !  -      -
       !!---------------------------------------------------------------------
 …
       IF( ln_timing )   CALL timing_start('dyn_zdf')
+      !
+      IF( kt == nit000 ) THEN       !* initialization
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator
+         ELSE                   ;    r_vvl = 1._wp
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN       !* initialization
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+            !
+            If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator
+            ELSE                   ;    r_vvl = 1._wp
+            ENDIF
          ENDIF
       ENDIF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/sshwzv.F90

-                      r14205
+                      r14958
       REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) ::   pssh           ! sea-surface height
+      !
       INTEGER  ::   jk      ! dummy loop index
+      INTEGER  ::   ji, jj, jk      ! dummy loop index
       REAL(wp) ::   zcoef   ! local scalar
       REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv   ! 2D workspace
 …
+      !
       zhdiv(:,:) = 0._wp
       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
         zhdiv(:,:) = zhdiv(:,:) + e3t(:,:,jk,Kmm) * hdiv(:,:,jk)
       END DO
+      DO_3D( 1, nn_hls, 1, nn_hls, 1, jpkm1 )                                 ! Horizontal divergence of barotropic transports
+        zhdiv(ji,jj) = zhdiv(ji,jj) + e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk)
+      END_3D
       !                                                ! Sea surface elevation time stepping
       ! In time-split case we need a first guess of the ssh after (using the baroclinic timestep) in order to
       ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations.
+      !
+      pssh(:,:,Kaa) = (  pssh(:,:,Kbb) - rDt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
+      DO_2D_OVR( 1, nn_hls, 1, nn_hls )                ! Loop bounds limited by hdiv definition in div_hor
+         pssh(ji,jj,Kaa) = (  pssh(ji,jj,Kbb) - rDt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) )  ) * ssmask(ji,jj)
+      END_2D
+      ! pssh must be defined everywhere (true for dyn_spg_ts, not for dyn_spg_exp)
+      IF ( .NOT. ln_dynspg_ts .AND. nn_hls == 2 ) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )
+      !
 #if defined key_agrif
 …
       IF ( .NOT.ln_dynspg_ts ) THEN
          IF( ln_bdy ) THEN
             CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary
+            IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary
             CALL bdy_ssh( pssh(:,:,Kaa) )             ! Duplicate sea level across open boundaries
          ENDIF
 …
             ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t)
             ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way)
             DO_2D( 0, 0, 0, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
             END_2D
          END DO
          CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions"
+         IF (nn_hls==1) CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions"
          !                             ! Is it problematic to have a wrong vertical velocity in boundary cells?
          !                             ! Same question holds for hdiv. Perhaps just for security
          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
+         DO_3DS( 1, 1, 1, 1, jpkm1, 1, -1 )         ! integrate from the bottom the hor. divergence
             ! computation of w
             pww(:,:,jk) = pww(:,:,jk+1) - (   e3t(:,:,jk,Kmm) * hdiv(:,:,jk)   &
                &                            +                  zhdiv(:,:,jk)   &
                &                            + r1_Dt * (  e3t(:,:,jk,Kaa)       &
                &                                       - e3t(:,:,jk,Kbb) )   ) * tmask(:,:,jk)
          END DO
+            pww(ji,jj,jk) = pww(ji,jj,jk+1) - (   e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk)   &
+               &                                  +                  zhdiv(ji,jj,jk)   &
+               &                                  + r1_Dt * (  e3t(ji,jj,jk,Kaa)       &
+               &                                             - e3t(ji,jj,jk,Kbb) )   ) * tmask(ji,jj,jk)
+         END_3D
          !          IF( ln_vvl_layer ) pww(:,:,:) = 0.e0
          DEALLOCATE( zhdiv )
 …
       ELSEIF( ln_linssh )   THEN                      !==  linear free surface cases  ==!
          !                                            !=================================!
          DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence
             pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)  ) * tmask(:,:,jk)
          END DO
+         DO_3DS( 1, 1, 1, 1, jpkm1, 1, -1 )                 ! integrate from the bottom the hor. divergence
+            pww(ji,jj,jk) = pww(ji,jj,jk+1) - (  e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk)  ) * tmask(ji,jj,jk)
+         END_3D
          !                                            !==========================================!
       ELSE                                            !==  Quasi-Eulerian vertical coordinate  ==!   ('key_qco')
          !                                            !==========================================!
          DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence
             pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)                 &
                &                            + r1_Dt * (  e3t(:,:,jk,Kaa)        &
                &                                       - e3t(:,:,jk,Kbb)  )   ) * tmask(:,:,jk)
          END DO
+         DO_3DS( 1, 1, 1, 1, jpkm1, 1, -1 )                 ! integrate from the bottom the hor. divergence
+            pww(ji,jj,jk) = pww(ji,jj,jk+1) - (  e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk)    &
+               &                                 + r1_Dt * (  e3t(ji,jj,jk,Kaa)        &
+               &                                            - e3t(ji,jj,jk,Kbb)  )   ) * tmask(ji,jj,jk)
+         END_3D
       ENDIF
 …
       zdt = 2._wp * rn_Dt                            ! 2*rn_Dt and not rDt (for restartability)
       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
             Cu_adv(ji,jj,jk) =   zdt *                                                         &
 …
          END_3D
       ELSE
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
             Cu_adv(ji,jj,jk) =   zdt *                                                      &
 …
          END_3D
       ENDIF
       CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp )
+      IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp )
+      !
       CALL iom_put("Courant",Cu_adv)
+      !
       IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN       ! Quick check if any breaches anywhere
          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )             ! or scan Courant criterion and partition ! w where necessary
+         DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 )             ! or scan Courant criterion and partition ! w where necessary
+            !
             zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/DYN/wet_dry.F90

r14433	r14958
117	117	IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error')
118	118	ENDIF
	119
	120	IF( ln_tile .AND. ln_wd_il ) CALL ctl_warn('Tiling has not been tested with ln_wd_il = T')
119	121	!
120	122	END SUBROUTINE wad_init

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ICB/icbdia.F90

-                      r14400
+                      r14958
    SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat_hcflux, pheat_latent, pmass_scale,     &
       &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
       &                    pdMv, pz1_dt_e1e2 )
+      &                    pdMv, pz1_dt_e1e2, pz1_e1e2 )
       !!----------------------------------------------------------------------
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in) ::   ki, kj
       REAL(wp), INTENT(in) ::   pmnew, pheat_hcflux, pheat_latent, pmass_scale
       REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
+      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2, pz1_e1e2
       !!----------------------------------------------------------------------
+      !
 …
+      !
       berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
       berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_dt_e1e2   ! J/m2/s
       berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_dt_e1e2   ! J/m2/s
+      berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_e1e2   ! W/m2
+      berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_e1e2   ! W/m2
       bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
       bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ICB/icbthm.F90

r14030	r14958
241	241	CALL icb_dia_melt( ii, ij, zMnew, zheat_hcflux, zheat_latent, this%mass_scaling, &
242	242	& zdM, zdMbitsE, zdMbitsM, zdMb, zdMe, &
243		& zdMv, z1_dt_e1e2 )
	243	& zdMv, z1_dt_e1e2, z1_e1e2 )
244	244	ELSE
245	245	WRITE(numout,*) 'icb_thm: berg ',this%number(:),' appears to have grounded at ',narea,ii,ij

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/IOM/iom.F90

-                      r14553
+                      r14958
       IF( iom_use(cdname) ) THEN
 #if defined key_xios
+         CALL xios_send_field( cdname, pfield2d )
+         IF( is_tile(pfield2d) == 1 ) THEN
+            CALL xios_send_field( cdname, pfield2d, ntile - 1 )
+         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
+            CALL xios_send_field( cdname, pfield2d )
+         ENDIF
 #else
          WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
 …
       IF( iom_use(cdname) ) THEN
 #if defined key_xios
+         CALL xios_send_field( cdname, pfield2d )
+         IF( is_tile(pfield2d) == 1 ) THEN
+            CALL xios_send_field( cdname, pfield2d, ntile - 1 )
+         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
+            CALL xios_send_field( cdname, pfield2d )
+         ENDIF
 #else
          WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
 …
       IF( iom_use(cdname) ) THEN
 #if defined key_xios
+         CALL xios_send_field( cdname, pfield3d )
+         IF( is_tile(pfield3d) == 1 ) THEN
+            CALL xios_send_field( cdname, pfield3d, ntile - 1 )
+         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
+            CALL xios_send_field( cdname, pfield3d )
+         ENDIF
 #else
          WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
 …
       IF( iom_use(cdname) ) THEN
 #if defined key_xios
+         CALL xios_send_field( cdname, pfield3d )
+         IF( is_tile(pfield3d) == 1 ) THEN
+            CALL xios_send_field( cdname, pfield3d, ntile - 1 )
+         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
+            CALL xios_send_field( cdname, pfield3d )
+         ENDIF
 #else
          WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
 …
       IF( iom_use(cdname) ) THEN
 #if defined key_xios
+         CALL xios_send_field (cdname, pfield4d )
+         IF( is_tile(pfield4d) == 1 ) THEN
+            CALL xios_send_field( cdname, pfield4d, ntile - 1 )
+         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
+            CALL xios_send_field( cdname, pfield4d )
+         ENDIF
 #else
          WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
 …
       IF( iom_use(cdname) ) THEN
 #if defined key_xios
+         CALL xios_send_field (cdname, pfield4d )
+         IF( is_tile(pfield4d) == 1 ) THEN
+            CALL xios_send_field( cdname, pfield4d, ntile - 1 )
+         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
+            CALL xios_send_field( cdname, pfield4d )
+         ENDIF
 #else
          WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
 …
    SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj,                                               &
       &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
+      &                                  ntiles, tile_ibegin, tile_jbegin, tile_ni, tile_nj,                                   &
+      &                                  tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj,                       &
       &                                    nvertex, bounds_lon, bounds_lat, area )
       !!----------------------------------------------------------------------
 …
       CHARACTER(LEN=*)                  , INTENT(in) ::   cdid
       INTEGER                 , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
+      INTEGER,  DIMENSION(:)  , OPTIONAL, INTENT(in) ::   tile_ibegin, tile_jbegin, tile_ni, tile_nj
+      INTEGER,  DIMENSION(:)  , OPTIONAL, INTENT(in) ::   tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj
       INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
       INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex
+      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex, ntiles
       REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
       REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
 …
          CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    ntiles=ntiles, tile_ibegin=tile_ibegin, tile_jbegin=tile_jbegin, tile_ni=tile_ni, tile_nj=tile_nj,        &
+            &    tile_data_ibegin=tile_data_ibegin, tile_data_jbegin=tile_data_jbegin,                                     &
+            &    tile_data_ni=tile_data_ni, tile_data_nj=tile_data_nj,                                                     &
             &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
             &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
 …
          CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    ntiles=ntiles, tile_ibegin=tile_ibegin, tile_jbegin=tile_jbegin, tile_ni=tile_ni, tile_nj=tile_nj,        &
+            &    tile_data_ibegin=tile_data_ibegin, tile_data_jbegin=tile_data_jbegin,                                     &
+            &    tile_data_ni=tile_data_ni, tile_data_nj=tile_data_nj,                                                     &
             &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
             &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
 …
+      !
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
+      INTEGER :: jn
+      INTEGER, DIMENSION(nijtile) :: ini, inj, idb
       LOGICAL, INTENT(IN) :: ldxios, ldrxios
       !!----------------------------------------------------------------------
 …
       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0)
       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj)
+      IF( ln_tile ) THEN
+         DO jn = 1, nijtile
+            ini(jn) = ntei_a(jn) - ntsi_a(jn) + 1     ! Tile size in i and j
+            inj(jn) = ntej_a(jn) - ntsj_a(jn) + 1
+            idb(jn) = -nn_hls                         ! Tile data offset (halo size)
+         END DO
+         ! Tile_[ij]begin are defined with respect to the processor data domain, so data_[ij]begin is added
+         CALL iom_set_domain_attr("grid_"//cdgrd, ntiles=nijtile,                                     &
+            & tile_ibegin=ntsi_a(1:nijtile) + idb(:) - 1, tile_jbegin=ntsj_a(1:nijtile) + idb(:) - 1, &
+            & tile_ni=ini(:), tile_nj=inj(:),                                                         &
+            & tile_data_ibegin=idb(:), tile_data_jbegin=idb(:),                                       &
+            & tile_data_ni=ini(:) - 2 * idb(:), tile_data_nj=inj(:) - 2 * idb(:))
+      ENDIF
 !don't define lon and lat for restart reading context.
       IF ( .NOT.ldrxios ) &

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/IOM/restart.F90

r14239	r14958
410	410	ssh(:,:,Kbb) = -ssh_ref
411	411	!
412		DO_2D( ~~1, 1, 1, 1~~ )
	412	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
413	413	IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth
414	414	ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ISF/isfhdiv.F90

-                      r13295
+                      r14958
          IF ( ln_isfpar_mlt ) CALL isf_hdiv_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, phdiv)
+         !
          ! ice sheet coupling contribution
+         ! ice sheet coupling contribution
          IF ( ln_isfcpl .AND. kt /= 0 ) THEN
+            !
 …
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   ikt, ikb
       REAL(wp), DIMENSION(jpi,jpj) :: zhdiv
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zhdiv
       !!----------------------------------------------------------------------
+      !
 …
+      !
       ! compute integrated divergence correction
+      zhdiv(:,:) = 0.5_wp * ( pfwf(:,:) + pfwf_b(:,:) ) * r1_rho0 / phtbl(:,:)
+      DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )
+         zhdiv(ji,jj) = 0.5_wp * ( pfwf(ji,jj) + pfwf_b(ji,jj) ) * r1_rho0 / phtbl(ji,jj)
+      END_2D
+      !
       ! update divergence at each level affected by ice shelf top boundary layer
       DO_2D( 1, 1, 1, 1 )
+      DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls )
          ikt = ktop(ji,jj)
          ikb = kbot(ji,jj)
 …
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pqvol
       !!----------------------------------------------------------------------
       INTEGER :: jk
+      INTEGER :: ji, jj, jk
       !!----------------------------------------------------------------------
+      !
       DO jk=1,jpk
          phdiv(:,:,jk) =  phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:)   &
             &                             / e3t(:,:,jk,Kmm)
       END DO
+      DO_3D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpk )
+         phdiv(ji,jj,jk) =  phdiv(ji,jj,jk) + pqvol(ji,jj,jk) * r1_e1e2t(ji,jj)   &
+            &                             / e3t(ji,jj,jk,Kmm)
+      END_3D
+      !
    END SUBROUTINE isf_hdiv_cpl

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ISF/isftbl.F90

r14215	r14958
176	176	!
177	177	! get htbl
178		DO_2D( ~~1, 1, 1, 1~~ )
	178	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
179	179	!
180	180	! tbl top/bottom indices initialisation
…	…
193	193	!
194	194	! get pfrac
195		DO_2D( ~~1, 1, 1, 1~~ )
	195	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
196	196	!
197	197	! tbl top/bottom indices initialisation
…	…
227	227	!
228	228	! get ktbl
229		DO_2D( ~~1, 1, 1, 1~~ )
	229	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
230	230	!
231	231	! determine the deepest level influenced by the boundary layer
…	…
261	261	! test: this routine run with pdep = 0 should return 1
262	262	!
263		DO_2D( ~~1, 1, 1, 1~~ )
	263	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
264	264	! comput ktop
265	265	ikt = 2

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/LBC/lbc_lnk_neicoll_generic.h90

-                      r14433
+                      r14958
       INTEGER, DIMENSION(8)  ::   isizej, ishtSj, ishtRj, ishtPj
       INTEGER, DIMENSION(8)  ::   ifill, iszall
+      INTEGER, DIMENSION(8)  ::   jnf
       INTEGER, DIMENSION(:), ALLOCATABLE  ::   iScnt, iRcnt    ! number of elements to be sent/received
       INTEGER, DIMENSION(:), ALLOCATABLE  ::   iSdpl, iRdpl    ! displacement in halos arrays
 …
+      !
       idx = 1
+      ! MPI3 bug fix when domain decomposition has 2 columns/rows
+      IF (jpni .eq. 2) THEN
+         IF (jpnj .eq. 2) THEN
+            jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /)
+         ELSE
+            jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /)
+         ENDIF
+      ELSE
+         IF (jpnj .eq. 2) THEN
+            jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /)
+         ELSE
+            jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /)
+         ENDIF
+      ENDIF
       DO jn = 1, 8
          ishti = ishtRi(jn)
          ishtj = ishtRj(jn)
          SELECT CASE ( ifill(jn) )
+         ishti = ishtRi(jnf(jn))
+         ishtj = ishtRj(jnf(jn))
+         SELECT CASE ( ifill(jnf(jn)) )
          CASE ( jpfillnothing )               ! no filling
          CASE ( jpfillmpi   )                 ! fill with data received by MPI
             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx)
                idx = idx + 1
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillperio )                 ! use periodicity
             ishti2 = ishtPi(jn)
             ishtj2 = ishtPj(jn)
             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+            ishti2 = ishtPi(jnf(jn))
+            ishtj2 = ishtPj(jnf(jn))
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillcopy  )                 ! filling with inner domain values
             ishti2 = ishtSi(jn)
             ishtj2 = ishtSj(jn)
             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+            ishti2 = ishtSi(jnf(jn))
+            ishtj2 = ishtSj(jnf(jn))
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillcst   )                 ! filling with constant value
             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/LBC/mppini.F90

-                      r14619
+                      r14958
       klci(1:iresti      ,:) = kimax
       klci(iresti+1:knbi ,:) = kimax-1
       IF( MINVAL(klci) < 2*i2hls ) THEN
          WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls
+      IF( MINVAL(klci) < 3*khls ) THEN
+         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 3*khls
          WRITE(ctmp2,*) '   We have ', MINVAL(klci)
         CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
+         CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
       ENDIF
       IF( l_NFold ) THEN
 …
       ENDIF
       klcj(:,1:irestj) = kjmax
       IF( MINVAL(klcj) < 2*i2hls ) THEN
          WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls
+      IF( MINVAL(klcj) < 3*khls ) THEN
+         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 3*khls
          WRITE(ctmp2,*) '   We have ', MINVAL(klcj)
          CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
 …
       iszjref = jpiglo*jpjglo+1
+      !
       iszimin = 4*nn_hls          ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain
       iszjmin = 4*nn_hls
+      iszimin = 3*nn_hls          ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain
+      iszjmin = 3*nn_hls
       IF( c_NFtype == 'T' )   iszjmin = MAX(iszjmin, 2+3*nn_hls)   ! V and F folding must be outside of southern halos
       IF( c_NFtype == 'F' )   iszjmin = MAX(iszjmin, 1+3*nn_hls)   ! V and F folding must be outside of southern halos
 …
          ENDIF
       END DO
+      IF( inbimax == 0 ) THEN
+         WRITE(ctmp1,'(a,i2,a,i2)') '   mpp_ini bestpartition: Ni0glo (', Ni0glo, ') is too small to be used with nn_hls = ', nn_hls
+         CALL ctl_stop( 'STOP', ctmp1 )
+      ENDIF
+      IF( inbjmax == 0 ) THEN
+         WRITE(ctmp1,'(a,i2,a,i2)') '   mpp_ini bestpartition: Nj0glo (', Nj0glo, ') is too small to be used with nn_hls = ', nn_hls
+         CALL ctl_stop( 'STOP', ctmp1 )
+      ENDIF
       ! combine these 2 lists to get all possible knbi*knbj <  inbijmax

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/LDF/ldfc1d_c2d.F90

r14433	r14958
135	135	!
136	136	CASE( 'DYN' ) ! T- and F-points
137		DO_2D( ~~1, 1, 1, 1~~ )
	137	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
138	138	pah1(ji,jj,1) = pUfac * MAX( e1t(ji,jj) , e2t(ji,jj) )**knn
139	139	pah2(ji,jj,1) = pUfac * MAX( e1f(ji,jj) , e2f(ji,jj) )**knn

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/LDF/ldfslp.F90

-                      r14433
+                      r14958
+         !
          ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln)
          DO_3D( 1, 0, 1, 0, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set
+         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set
             zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! i-gradient of T & S at u-point
             zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) )
 …
+         !
          IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                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
 …
       DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )      ! done each pair of triad ! NB: not masked ==>  a minimum value is set
             IF( jk+kp > 1 ) THEN              ! k-gradient of T & S a jk+kp
                zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) )
 …
       END DO
+      !
       DO_2D( 1, 1, 1, 1 )                     !==  Reciprocal depth of the w-point below ML base  ==!
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                   !== Reciprocal depth of the w-point below ML base  ==!
          jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
          z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm)
 …
       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_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                ip = jl   ;   jp = jl
+               !
 …
                ! 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_2D( 1, 0, 1, 0 )
+               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+                  !
                   ! Calculate slope relative to geopotentials used for GM skew fluxes

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/LDF/ldftra.F90

-                      r14433
+                      r14958
       INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index
       INTEGER                         , INTENT(in   ) ::   Kmm            ! ocean time level indices
       REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s]
+      REAL(wp)                        , INTENT(in   ) ::   paei0          ! max value            [m2/s]
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s]
+      !
       INTEGER  ::   ji, jj, jk    ! dummy loop indices
       REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei    ! local scalars
+      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zzaei    ! local scalars
       REAL(wp), DIMENSION(jpi,jpj) ::   zn, zah, zhw, zRo, zaeiw   ! 2D workspace
       !!----------------------------------------------------------------------
 …
       !                       ! Compute lateral diffusive coefficient at T-point
       IF( ln_traldf_triad ) THEN
          DO_3D( 0, 0, 0, 0, 1, jpk )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
             ! Take the max of N^2 and zero then take the vertical sum
             ! of the square root of the resulting N^2 ( required to compute
 …
          END_3D
       ELSE
          DO_3D( 0, 0, 0, 0, 1, jpk )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
             ! Take the max of N^2 and zero then take the vertical sum
             ! of the square root of the resulting N^2 ( required to compute
 …
       ENDIF
       DO_2D( 0, 0, 0, 0 )
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
          ! Rossby radius at w-point taken betwenn 2 km and  40km
 …
       !                                         !==  Bound on eiv coeff.  ==!
       z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  )
       DO_2D( 0, 0, 0, 0 )
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)     ! tropical decrease
          zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0
 …
       CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition
+      !
       DO_2D( 0, 0, 0, 0 )                       !== aei at u- and v-points  ==!
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1)
          paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1)
 …
       INTEGER                     , INTENT(in   ) ::   Kmm, Krhs ! ocean time level indices
       CHARACTER(len=3)            , INTENT(in   ) ::   cdtype    ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pu        ! in : 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pv        ! out: 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pw        ! increased by the eiv                [m3/s]
+      ! TEMP: [tiling] Can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu        ! in : 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv        ! out: 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw        ! increased by the eiv                [m3/s]
       !!
       INTEGER  ::   ji, jj, jk                 ! dummy loop indices
 …
       !!----------------------------------------------------------------------
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
 …
       zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp
+      !
       DO_3D( 1, 0, 1, 0, 2, jpkm1 )
+      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 )
          zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   &
             &                                    * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * wumask(ji,jj,jk)
 …
       END_3D
+      !
       DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+      DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
          pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
          pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
       END_3D
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
          pw(ji,jj,jk) = pw(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   &
             &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )
+            &                           + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )
       END_3D
+      !
 …
       !!
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s]
       INTEGER                     , INTENT(in   ) ::   Kmm   ! ocean time level indices
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in) ::   psi_uw, psi_vw   ! streamfunction   [m3/s]
+      INTEGER                             , INTENT(in) ::   Kmm              ! ocean time level indices
+      !
       INTEGER  ::   ji, jj, jk    ! dummy loop indices

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/OBS/diaobs.F90

r14056	r14958
687	687	& nit000, idaystp, jvar, &
688	688	& zprofvar(:,:,:,jvar), &
689		& gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm), &
	689	& gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm), &
690	690	& zprofmask(:,:,:,jvar), &
691	691	& zglam(:,:,jvar), zgphi(:,:,jvar), &

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/SBC/sbcblk.F90

-                      r14433
+                      r14958
       REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable
       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! net long wave radiative heat flux
+      !!---------------------------------------------------------------------
+      !
+      ! local scalars ( place there for vector optimisation purposes)
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
+      !!---------------------------------------------------------------------
+      !
+      ! Heat content per unit mass (J/kg)
+      zcptrain(:,:) = (      ptair        - rt0 ) * rcp  * tmask(:,:,1)
+      zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1)
+      zcptn   (:,:) =        ptsk                 * rcp  * tmask(:,:,1)
+      !
       ! ----------------------------------------------------------------------------- !
       !     III    Net longwave radiative FLUX                                        !
 …
       ! ----------------------------------------------------------------------------- !
+      !
+      emp (:,:) = (  pevp(:,:)                                       &   ! mass flux (evap. - precip.)
+         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1)
+      !
+      qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:)                   &   ! Downward Non Solar
+         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip
+         &     - pevp(:,:) * ptsk(:,:) * rcp                         &   ! remove evap heat content at SST
+         &     + ( pprec(:,:) - psnow(:,:) ) * rn_pfac               &   ! add liquid precip heat content at Tair
+         &     * ( ptair(:,:) - rt0 ) * rcp                          &
+         &     + psnow(:,:) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
+         &     * ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi
+      emp (:,:) = ( pevp(:,:) - pprec(:,:) * rn_pfac ) * tmask(:,:,1)      ! mass flux (evap. - precip.)
+      !
+      qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:)                     &   ! Downward Non Solar
+         &     - psnow(:,:) * rn_pfac * rLfus                          &   ! remove latent melting heat for solid precip
+         &     - pevp(:,:) * zcptn(:,:)                                &   ! remove evap heat content at SST
+         &     + ( pprec(:,:) - psnow(:,:) ) * rn_pfac * zcptrain(:,:) &   ! add liquid precip heat content at Tair
+         &     + psnow(:,:) * rn_pfac * zcptsnw(:,:)                       ! add solid  precip heat content at min(Tair,Tsnow)
       qns(:,:) = qns(:,:) * tmask(:,:,1)
+      !
 …
       ! C-grid ice dynamics :   U & V-points (same as ocean)
       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
       wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) )
+         wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) )
       END_2D
+      !
 …
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice
       REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3)
-      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2
       REAL(wp), DIMENSION(jpi,jpj)     ::   ztri
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
       !!---------------------------------------------------------------------
+      !
 …
       dqla_ice(:,:,:) = 0._wp
+      ! Heat content per unit mass (J/kg)
+      zcptrain(:,:) = (      ptair        - rt0 ) * rcp  * tmask(:,:,1)
+      zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1)
+      zcptn   (:,:) =        sst_m                * rcp  * tmask(:,:,1)
+      !
       !                                     ! ========================== !
       DO jl = 1, jpl                        !  Loop over ice categories  !
 …
       ! --- heat flux associated with emp --- !
+      qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( ptair(:,:) - rt0 ) * rcp               & ! liquid precip at Tair
+         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+      qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * zcptn(:,:)         & ! evap at sst
+         &          + ( tprecip(:,:) - sprecip(:,:) )   *   zcptrain(:,:)         & ! liquid precip at Tair
+         &          +   sprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip at min(Tair,Tsnow)
+      qemp_ice(:,:) =   sprecip(:,:) *           zsnw   * ( zcptsnw (:,:) - rLfus ) ! solid precip (only)
       ! --- total solar and non solar fluxes --- !
 …
       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
       qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+      qprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
       ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
 …
+      !
       IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN
+         ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) )
+         IF( iom_use('evap_ao_cea'  ) )  CALL iom_put( 'evap_ao_cea'  , ztmp(:,:) * tmask(:,:,1) )   ! ice-free oce evap (cell average)
+         IF( iom_use('hflx_evap_cea') )  CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) )   ! heat flux from evap (cell average)
+      ENDIF
+      IF( iom_use('hflx_rain_cea') ) THEN
+         ztmp(:,:) = rcp * ( SUM( (ptsu-rt0) * a_i_b, dim=3 ) + sst_m(:,:) * ( 1._wp - at_i_b(:,:) ) )
+         IF( iom_use('hflx_rain_cea') )  CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) )   ! heat flux from rain (cell average)
+      ENDIF
+      IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea')  )  THEN
+         WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 )
+            ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )
+         ELSEWHERE
+            ztmp(:,:) = rcp * sst_m(:,:)
+         ENDWHERE
+         ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus )
+         IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , ztmp2(:,:) ) ! heat flux from snow (cell average)
+         IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean)
+         IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) *           zsnw(:,:)   ) ! heat flux from snow (over ice)
+         CALL iom_put( 'evap_ao_cea'  , zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1)              )   ! ice-free oce evap (cell average)
+         CALL iom_put( 'hflx_evap_cea', zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1) * zcptn(:,:) )   ! heat flux from evap (cell average)
+      ENDIF
+      IF( iom_use('rain') .OR. iom_use('rain_ao_cea') .OR. iom_use('hflx_rain_cea') ) THEN
+         CALL iom_put( 'rain'         ,   tprecip(:,:) - sprecip(:,:)                             )          ! liquid precipitation
+         CALL iom_put( 'rain_ao_cea'  , ( tprecip(:,:) - sprecip(:,:) ) * ( 1._wp - at_i_b(:,:) ) )          ! liquid precipitation over ocean (cell average)
+         CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )                    ! heat flux from rain (cell average)
+      ENDIF
+      IF(  iom_use('snow_ao_cea')   .OR. iom_use('snow_ai_cea')      .OR. &
+         & iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea')  )  THEN
+         CALL iom_put( 'snow_ao_cea'     , sprecip(:,:)                            * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean  (cell average)
+         CALL iom_put( 'snow_ai_cea'     , sprecip(:,:)                            *           zsnw(:,:)   ) ! Snow over sea-ice         (cell average)
+         CALL iom_put( 'hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) )                         ! heat flux from snow (cell average)
+         CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean)
+         CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) *           zsnw(:,:)   ) ! heat flux from snow (over ice)
+      ENDIF
+      IF( iom_use('hflx_prec_cea') ) THEN                                                                    ! heat flux from precip (cell average)
+         CALL iom_put('hflx_prec_cea' ,    sprecip(:,:)                  * ( zcptsnw (:,:) - rLfus )  &
+            &                          + ( tprecip(:,:) - sprecip(:,:) ) *   zcptrain(:,:) )
+      ENDIF
+      IF( iom_use('subl_ai_cea') .OR. iom_use('hflx_subl_cea') ) THEN
+         CALL iom_put( 'subl_ai_cea'  , SUM( a_i_b(:,:,:) *  evap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)
+         CALL iom_put( 'hflx_subl_cea', SUM( a_i_b(:,:,:) * qevap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Heat flux from sublimation (cell average)
       ENDIF
+      !

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/SBC/sbccpl.F90

-                      r14595
+                      r14958
          IF( llnewtau ) THEN
             zcoef = 1. / ( zrhoa * zcdrag )
             DO_2D( 1, 1, 1, 1 )
+            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
             END_2D
 …
       IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
       IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
       IF( iom_use('rain_ao_cea') )   CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
       IF( iom_use('subl_ai_cea') )   CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )     ! Sublimation over sea-ice (cell average)
+      IF( iom_use('rain_ao_cea') )   CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * ziceld(:,:)         )  ! liquid precipitation over ocean (cell average)
+      IF( iom_use('subl_ai_cea') )   CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * picefr(:,:) * tmask(:,:,1)     )  ! Sublimation over sea-ice (cell average)
       IF( iom_use('evap_ao_cea') )   CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
          &                                                         - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
+         &                                                         - zevap_ice_total(:,:) * picefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average)
       ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
 !!      IF( srcv(jpr_rnf)%laction )   CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1)                                 )  ! runoff
 …
       IF (        iom_use('hflx_snow_ai_cea') ) &                                                    ! heat flux from snow (over ice)
          &   CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) *  zsnw(:,:) )
+      IF(         iom_use('hflx_subl_cea') )    &                                                    ! heat flux from sublimation
+         &   CALL iom_put('hflx_subl_cea' ,   SUM( qevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) * tmask(:,:,1) )
       ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
+      !

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/SBC/sbcfwb.F90

-                      r14130
+                      r14958
             emp(:,:) = emp(:,:) - z_fwfprv(1)        * tmask(:,:,1)
             qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+            ! outputs
+            IF( iom_use('hflx_fwb_cea') )  CALL iom_put( 'hflx_fwb_cea', zcoef * sst_m(:,:) * tmask(:,:,1) )
+            IF( iom_use('vflx_fwb_cea') )  CALL iom_put( 'vflx_fwb_cea', z_fwfprv(1)        * tmask(:,:,1) )
          ENDIF
+         !
 …
             emp(:,:) = emp(:,:) + a_fwb              * tmask(:,:,1)
             qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+            ! outputs
+            IF( iom_use('hflx_fwb_cea') )  CALL iom_put( 'hflx_fwb_cea', -zcoef * sst_m(:,:) * tmask(:,:,1) )
+            IF( iom_use('vflx_fwb_cea') )  CALL iom_put( 'vflx_fwb_cea', -a_fwb              * tmask(:,:,1) )
          ENDIF
          ! Output restart information
 …
             qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction
             erp(:,:) = erp(:,:) + zerp_cor(:,:)
+            ! outputs
+            IF( iom_use('hflx_fwb_cea') )  CALL iom_put( 'hflx_fwb_cea', -zerp_cor(:,:) * rcp * sst_m(:,:) )
+            IF( iom_use('vflx_fwb_cea') )  CALL iom_put( 'vflx_fwb_cea', -zerp_cor(:,:) )
+            !
             IF( lwp ) THEN                   ! control print

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/SBC/sbcmod.F90

-                      r14229
+                      r14958
       END SELECT
+      IF( ln_icebergs    )   THEN
+                                     CALL icb_stp( kt, Kmm )           ! compute icebergs
+         ! Icebergs do not melt over the haloes.
+         ! So emp values over the haloes are no more consistent with the inner domain values.
+         ! A lbc_lnk is therefore needed to ensure reproducibility and restartability.
+         ! see ticket #2113 for discussion about this lbc_lnk.
+         IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) ! ensure restartability with icebergs
+      IF( ln_icebergs    )   CALL icb_stp( kt, Kmm )              ! compute icebergs
+      ! Icebergs do not melt over the haloes.
+      ! So emp values over the haloes are no more consistent with the inner domain values.
+      ! A lbc_lnk is therefore needed to ensure reproducibility and restartability.
+      ! see ticket #2113 for discussion about this lbc_lnk.
+      ! The lbc_lnk is also needed for SI3 with nn_hls > 1 as emp is not yet defined for these points in iceupdate.F90
+      IF( (ln_icebergs .AND. .NOT. ln_passive_mode) .OR. (nn_ice == 2 .AND. nn_hls == 2) ) THEN
+         CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp )
       ENDIF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/SBC/sbcrnf.F90

-                      r14072
+                      r14958
              IF( ln_rnf_icb ) THEN
                 fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1)  ! updated runoff value at time step kt
+                CALL iom_put( 'iceberg_cea'  , fwficb(:,:)  )         ! output iceberg flux
+                CALL iom_put( 'hflx_icb_cea' , fwficb(:,:) * rLfus )   ! output Heat Flux into Sea Water due to Iceberg Thermodynamics -->
+                rnf(:,:) = rnf(:,:) + fwficb(:,:)
+                qns(:,:) = qns(:,:) - fwficb(:,:) * rLfus
+                !!qns_tot(:,:) = qns_tot(:,:) - fwficb(:,:) * rLfus
+                !!qns_oce(:,:) = qns_oce(:,:) - fwficb(:,:) * rLfus
+                CALL iom_put( 'iceberg_cea'  ,  fwficb(:,:)  )          ! output iceberg flux
+                CALL iom_put( 'hflx_icb_cea' , -fwficb(:,:) * rLfus )   ! output Heat Flux into Sea Water due to Iceberg Thermodynamics -->
              ENDIF
          ENDIF
 …
                                          CALL iom_put( 'runoffs'     , rnf(:,:)                         )   ! output runoff mass flux
          IF( iom_use('hflx_rnf_cea') )   CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rho0 * rcp )   ! output runoff sensible heat (W/m2)
+         IF( iom_use('sflx_rnf_cea') )   CALL iom_put( 'sflx_rnf_cea', rnf_tsc(:,:,jp_sal) * rho0       )   ! output runoff salt flux (g/m2/s)
       ENDIF
+      !
 …
       IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
          IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow
             DO_2D( 1, 1, 1, 1 )
+            DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls )
                DO jk = 1, nk_rnf(ji,jj)
                   phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj)
 …
             END_2D
          ELSE                    !* variable volume case
             DO_2D( 1, 1, 1, 1 )              ! update the depth over which runoffs are distributed
+            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )         ! update the depth over which runoffs are distributed
                h_rnf(ji,jj) = 0._wp
                DO jk = 1, nk_rnf(ji,jj)                             ! recalculates h_rnf to be the depth in metres
 …
          ENDIF
       ELSE                       !==   runoff put only at the surface   ==!
+         h_rnf (:,:)   = e3t (:,:,1,Kmm)        ! update h_rnf to be depth of top box
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rho0 / e3t(:,:,1,Kmm)
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+            h_rnf (ji,jj)   = e3t (ji,jj,1,Kmm)        ! update h_rnf to be depth of top box
+            phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / e3t(ji,jj,1,Kmm)
+         END_2D
       ENDIF
+      !
 …
+         !
          nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             IF( h_rnf(ji,jj) > 0._wp ) THEN
                jk = 2
 …
             ENDIF
          END_2D
          DO_2D( 1, 1, 1, 1 )                           ! set the associated depth
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                           ! set the associated depth
             h_rnf(ji,jj) = 0._wp
             DO jk = 1, nk_rnf(ji,jj)
 …
          WHERE( zrnfcl(:,:,1) > 0._wp )  h_rnf(:,:) = zacoef * zrnfcl(:,:,1)   ! compute depth for all runoffs
+         !
          DO_2D( 1, 1, 1, 1 )                ! take in account min depth of ocean rn_hmin
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                ! take in account min depth of ocean rn_hmin
             IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
                jk = mbkt(ji,jj)
 …
+         !
          nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
                jk = 2
 …
          END_2D
+         !
          DO_2D( 1, 1, 1, 1 )                          ! set the associated depth
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                          ! set the associated depth
             h_rnf(ji,jj) = 0._wp
             DO jk = 1, nk_rnf(ji,jj)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/SBC/sbcssr.F90

-                      r13295
+                      r14958
             !                                      ! ========================= !
+            !
+            qrp(:,:) = 0._wp ! necessary init
+            erp(:,:) = 0._wp
+            !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
                DO_2D( 1, 1, 1, 1 )
+               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                   zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
                   qns(ji,jj) = qns(ji,jj) + zqrp
 …
               ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1
               ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1
                DO_2D( 1, 1, 1, 1 )
+               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                   SELECT CASE ( nn_sssr_ice )
                     CASE ( 0 )    ;  coefice(ji,jj) = 1._wp - fr_i(ji,jj)              ! no/reduced damping under ice
 …
             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
                DO_2D( 1, 1, 1, 1 )
+               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                   zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
                      &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
 …
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
                zerp_bnd = rn_sssr_bnd / rday                          !       -              -
                DO_2D( 1, 1, 1, 1 )
+               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                   zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
                      &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
 …
                   qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
                   erp(ji,jj) = zerp
+                  qrp(ji,jj) = qrp(ji,jj) - zerp * rcp * sst_m(ji,jj)
                END_2D
             ENDIF
+            ! outputs
+            CALL iom_put( 'hflx_ssr_cea', qrp(:,:) )
+            IF( nn_sssr == 1 )   CALL iom_put( 'sflx_ssr_cea',  erp(:,:) * sss_m(:,:) )
+            IF( nn_sssr == 2 )   CALL iom_put( 'vflx_ssr_cea', -erp(:,:) )
+            !
          ENDIF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/eosbn2.F90

-                      r14131
+                      r14958
    SUBROUTINE eos_insitu_pot_2d( pts, prhop )
+      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      !                                                     ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !!
+      CALL eos_insitu_pot_2d_t( pts, is_tile(pts), prhop, is_tile(prhop) )
+   END SUBROUTINE eos_insitu_pot_2d
+   SUBROUTINE eos_insitu_pot_2d_t( pts, ktts, prhop, ktrhop )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE eos_insitu_pot  ***
 …
       !!
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      INTEGER                              , INTENT(in   ) ::   ktts, ktrhop
+      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
       !                                                                ! 2 : salinity               [psu]
       REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      REAL(wp), DIMENSION(A2D_T(ktrhop)   ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !
       INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
 …
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
             DO_2D( 1, 1, 1, 1 )
+               !
                zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
                zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
                ztm = tmask(ji,jj,1)                                         ! tmask
+               !
                zn0 = (((((EOS060*zt   &
                   &   + EOS150*zs+EOS050)*zt   &
                   &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
                   &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
                   &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
                   &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
                   &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                  !
+               !
                prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface
+               !
             END_2D
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
+            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            ztm = tmask(ji,jj,1)                                         ! tmask
+            !
+            zn0 = (((((EOS060*zt   &
+               &   + EOS150*zs+EOS050)*zt   &
+               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+               !
+            !
+            prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface
+            !
+         END_2D
       CASE( np_seos )                !==  simplified EOS  ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             zt  = pts  (ji,jj,jp_tem) - 10._wp
             zs  = pts  (ji,jj,jp_sal) - 35._wp
 …
       IF( ln_timing )   CALL timing_stop('eos-pot')
+      !
    END SUBROUTINE eos_insitu_pot_2d
+   END SUBROUTINE eos_insitu_pot_2d_t

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traadv.F90

-                      r14433
+                      r14958
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
    ! TEMP: [tiling] This change not necessary after extended haloes development
+   ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
    USE domtile
    USE domvvl         ! variable vertical scale factors
 …
    USE traadv_cen     ! centered scheme            (tra_adv_cen  routine)
    USE traadv_fct     ! FCT      scheme            (tra_adv_fct  routine)
-   USE traadv_fct_lf  ! FCT      scheme            (tra_adv_fct  routine - loop fusion version)
    USE traadv_mus     ! MUSCL    scheme            (tra_adv_mus  routine)
-   USE traadv_mus_lf  ! MUSCL    scheme            (tra_adv_mus  routine - loop fusion version)
    USE traadv_ubs     ! UBS      scheme            (tra_adv_ubs  routine)
    USE traadv_qck     ! QUICKEST scheme            (tra_adv_qck  routine)
 …
    LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag
    INTEGER ::   nadv             ! choice of the type of advection scheme
+   INTEGER, PUBLIC ::   nadv             ! choice of the type of advection scheme
    !                             ! associated indices:
    INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
    INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
    INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
    INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme
    INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme
    INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER, PUBLIC ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_MUS     = 3   ! MUSCL scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_QCK     = 5   ! QUICK scheme
    !! * Substitutions
 …
+      !
       INTEGER ::   ji, jj, jk   ! dummy loop index
       ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww   ! 3D workspace
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds
       ! TEMP: [tiling] This change not necessary after extra haloes development
+      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       LOGICAL :: lskip
       !!----------------------------------------------------------------------
 …
       lskip = .FALSE.
       ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) )
       ENDIF
+      ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia)
+      IF( nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4) .OR. ln_ldfeiv_dia )  THEN
+         IF( ln_tile ) THEN
+            IF( ntile == 1 ) THEN
+               CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
+            ELSE
+               lskip = .TRUE.
+            ENDIF
+      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( ln_tile .AND. nadv == np_FCT )  THEN
+         IF( ntile == 1 ) THEN
+            CALL dom_tile_stop( ldhold=.TRUE. )
+         ELSE
+            lskip = .TRUE.
          ENDIF
       ENDIF
 …
          !                                         !==  effective transport  ==!
          IF( ln_wave .AND. ln_sdw )  THEN
             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
                zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) )
                zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) )
 …
             END_3D
          ELSE
             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
                zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)               ! eulerian transport only
                zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm)
 …
+         !
          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
                zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk)
                zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk)
 …
          ENDIF
+         !
          DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
             zuu(ji,jj,jpk) = 0._wp                                                      ! no transport trough the bottom
             zvv(ji,jj,jpk) = 0._wp
 …
          END_2D
+         !
-         ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
          IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
+            &              CALL ldf_eiv_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), &
+            &                                'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary)
+         !
+         IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), &
+            &                                'TRA', Kmm       )   ! add the mle transport (if necessary)
+         !
+         ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)
+         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+            &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary)
+         !
+         IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm       )   ! add the mle transport (if necessary)
+         !
+         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
             CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport
             CALL iom_put( "vocetr_eff", zvv )
 …
          ENDIF
+         !
    !!gm ???
          ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)
+!!gm ???
+         ! TEMP: [tiling] This copy-in not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
          CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) )                                    ! diagnose the effective MSF
    !!gm ???
+!!gm ???
+         !
 …
+         !
          CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
-            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. )
             CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
          CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order
-            IF (nn_hls.EQ.2) THEN
-               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.)
-               CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.)
-#if defined key_loop_fusion
-               CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
-#else
                CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
-#endif
-            ELSE
-               CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
-            END IF
          CASE ( np_MUS )                                 ! MUSCL
-            IF (nn_hls.EQ.2) THEN
-                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)
-#if defined key_loop_fusion
-                CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
-#else
                 CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
-#endif
-            ELSE
-                CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
-            END IF
          CASE ( np_UBS )                                 ! UBS
-            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)
             CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   )
          CASE ( np_QCK )                                 ! QUICKEST
-            IF (nn_hls.EQ.2) THEN
-               CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)
-               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)
-            END IF
             CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
+         !
 …
          ENDIF
+         ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia)
+         IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )
+         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+         IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE. )
       ENDIF
       !                                              ! print mean trends (used for debugging)
 …
          &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)
       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
+      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only for the full domain
          DEALLOCATE( zuu, zvv, zww )
       ENDIF
 …
         CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
       ENDIF
+      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( ln_traadv_fct .AND. ln_tile ) THEN
+         CALL ctl_warn( 'tra_adv_init: FCT scheme does not yet work with tiling' )
+      ENDIF
       IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
         CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traadv_cen.F90

-                      r14433
+                      r14958
    USE trc_oce        ! share passive tracers/Ocean variables
    USE lib_mpp        ! MPP library
+#if defined key_loop_fusion
+   USE traadv_cen_lf  ! centered scheme            (tra_adv_cen  routine - loop fusion version)
+#endif
    IMPLICIT NONE
 …
       INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
       INTEGER                                  , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
 …
       !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_cen_lf    ( kt, nit000, cdtype, pU, pV, pW, Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
 …
                ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
             END_3D
             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond.
+            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond.
+            !
             DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes
 …
                zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v
             END_3D
             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. )
+            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. )
+            !
          CASE DEFAULT
 …
       END DO
+      !
+#endif
    END SUBROUTINE tra_adv_cen

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traadv_fct.F90

-                      r14433
+                      r14958
    PUBLIC   tra_adv_fct        ! called by traadv.F90
    PUBLIC   interp_4th_cpt     ! called by traadv_cen.F90
-   PUBLIC   tridia_solver      ! called by traadv_fct_lf.F90
-   PUBLIC   nonosc             ! called by traadv_fct_lf.F90 - key_agrif
    LOGICAL  ::   l_trd   ! flag to compute trends
 …
       INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
 …
       !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_fct_lf ( kt, nit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
 …
       ! If adaptive vertical advection, check if it is needed on this PE at this time
       IF( ln_zad_Aimp ) THEN
          IF( MAXVAL( ABS( wi(A2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE.
+         IF( MAXVAL( ABS( wi(A2D(1),:) ) ) > 0._wp ) ll_zAimp = .TRUE.
       END IF
       ! If active adaptive vertical advection, build tridiagonal matrix
 …
             zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji  ,jj+1,jk,jn,Kbb) )
          END_3D
+         !                               !* upstream tracer flux in the k direction *!
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
+            zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
+            zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
+            zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk)
+         END_3D
+         IF( ln_linssh ) THEN               ! top ocean value (only in linear free surface as zwz has been w-masked)
+            IF( ln_isfcav ) THEN                        ! top of the ice-shelf cavities and at the ocean surface
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface
+               END_2D
+            ELSE                                        ! no cavities: only at the ocean surface
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb)
+               END_2D
+            ENDIF
+         ENDIF
+         !
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme
+            !                               ! total intermediate advective trends
+            ztra = - (  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) ) * r1_e1e2t(ji,jj)
+            !                               ! update and guess with monotonic sheme
+            pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   &
+               &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk)
+            zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) &
+               &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+         END_3D
+         IF ( ll_zAimp ) THEN
+            CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 )
+            !
+            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               ztw(ji,jj,jk) =  0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes
+            END_3D
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
+                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
+            !
+         END IF
+         !
+         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)
+         !
+         !        !==  anti-diffusive flux : high order minus low order  ==!
+         !
+         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
+               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk)
+            END_3D
+            !
+         CASE(  4  )                   !- 4th order centered
+            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
+            zltv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                 ! Laplacian
+               DO_2D( 1, 0, 1, 0 )                 ! 1st derivative (gradient)
+                  ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+                  ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+               END_2D
+               DO_2D( 0, 0, 0, 0 )                 ! 2nd derivative * 1/ 6
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+               END_2D
+            END DO
+            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility
+            CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                        ! C4 minus upstream advective fluxes
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu(ji,jj,jk) - zltu(ji+1,jj,jk)   &
+                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility
+                             &                          ) - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv(ji,jj,jk) - zltv(ji,jj+1,jk)   &
+                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility
+                             &                          ) - zwy(ji,jj,jk)
+            END_3D
+            !
+         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
+            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient)
+               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+            END_3D
+            IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2)
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                  ! C4 interpolation of T at u- & v-points (x2)
+               zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
+               zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+               !                                                  ! C4 minus upstream advective fluxes
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
+            END_3D
+            IF (nn_hls==2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+            !
+         END SELECT
+         !
+         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values)
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
+                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
+            END_3D
+            !
+         CASE(  4  )                   !- 4th order COMPACT
+            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
+            END_3D
+            !
+         END SELECT
+         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0
+            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked
+         ENDIF
+         !
+         IF (nn_hls==1) THEN
+            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp )
+         ELSE
+            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
+         END IF
+         !
+         IF ( ll_zAimp ) THEN
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !* trend and after field with monotonic scheme
+               !                                                ! total intermediate advective trends
+               ztra = - (  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) ) * r1_e1e2t(ji,jj)
+               ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+            END_3D
+            !
+            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
+            !
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+            END_3D
+         END IF
+         !
+         !        !==  monotonicity algorithm  ==!
+         !
+         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt )
+         !
+         !        !==  final trend with corrected fluxes  ==!
+         !
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            ztra = - (  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) ) * r1_e1e2t(ji,jj)
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm)
+            zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+         END_3D
+         !
+         IF ( ll_zAimp ) THEN
+            !
+            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               ztw(ji,jj,jk) = - 0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic
+            END_3D
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
+                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
+         END IF
+         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  !
+            !
+            IF( l_trd ) THEN              ! trend diagnostics
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) )
+            ENDIF
+            !                             ! heat/salt transport
+            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) )
+            !
+         ENDIF
+         IF( l_ptr ) THEN              ! "Poleward" transports
+            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes
+            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
+         ENDIF
+         !
+      END DO                     ! end of tracer loop
+      !
+      IF ( ll_zAimp ) THEN
+         DEALLOCATE( zwdia, zwinf, zwsup )
+      ENDIF
+      IF( l_trd .OR. l_hst ) THEN
+         DEALLOCATE( ztrdx, ztrdy, ztrdz )
+      ENDIF
+      IF( l_ptr ) THEN
+         DEALLOCATE( zptry )
+      ENDIF
+      !
+#endif
+   END SUBROUTINE tra_adv_fct
+   SUBROUTINE nonosc( Kmm, 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
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   Kmm             ! time level index
+      REAL(wp)                        , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pbef            ! before field
+      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(in   ) ::   paft            ! after field
+      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(dp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
+      REAL(dp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      zbig  = 1.e+40_dp
+      zrtrn = 1.e-15_dp
+      zbetup(:,:,:) = 0._dp   ;   zbetdo(:,:,:) = 0._dp
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+         zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
+            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) )  )
+         zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
+            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) )  )
+      END_3D
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! 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 = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
+            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_2D
+      END DO
+      IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp, ld4only= .TRUE. )   ! lateral boundary cond. (unchanged sign)
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+         zcu =       ( 0.5  + SIGN( 0.5_wp , paa(ji,jj,jk) ) )
+         paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+         zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+         zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+         zcv =       ( 0.5  + SIGN( 0.5_wp , pbb(ji,jj,jk) ) )
+         pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - 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_wp , pcc(ji,jj,jk+1) ) )
+         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
+      END_3D
+      !
+   END SUBROUTINE nonosc
+   SUBROUTINE interp_4th_cpt_org( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt_org  ***
+      !!
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
+      !
+      INTEGER :: ji, jj, jk   ! dummy loop integers
+      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )       !==  build the three diagonal matrix  ==!
+         zwd (ji,jj,jk) = 4._wp
+         zwi (ji,jj,jk) = 1._wp
+         zws (ji,jj,jk) = 1._wp
+         zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         !
+         IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
+            zwd (ji,jj,jk) = 1._wp
+            zwi (ji,jj,jk) = 0._wp
+            zws (ji,jj,jk) = 0._wp
+            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         ENDIF
+      END_3D
+      !
+      jk = 2                                    ! Switch to second order centered at top
+      DO_2D( 1, 1, 1, 1 )
+         zwd (ji,jj,jk) = 1._wp
+         zwi (ji,jj,jk) = 0._wp
+         zws (ji,jj,jk) = 0._wp
+         zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+      END_2D
+      !
+      !                       !==  tridiagonal solve  ==!
+      DO_2D( 1, 1, 1, 1 )           ! first recurrence
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( 1, 1, 1, 1 )           ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+      DO_2D( 1, 1, 1, 1 )           ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( 1, 1, 1, 1, jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE interp_4th_cpt_org
+   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt  ***
+      !!
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point
+      REAL(wp),DIMENSION(A2D(nn_hls)    ,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   ikt, ikb     ! local integers
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      !
+      !                      !==  build the three diagonal matrix & the RHS  ==!
+      !
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )    ! interior (from jk=3 to jpk-1)
+         zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal
+         zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal
+         zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal
+         zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS
+            &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) )
+      END_3D
+      !
+!!gm
+!      SELECT CASE( kbc )               !* boundary condition
+!      CASE( np_NH   )   ! Neumann homogeneous at top & bottom
+!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom
+!      END SELECT
+!!gm
+      !
+      IF ( ln_isfcav ) THEN            ! set level two values which may not be set in ISF case
+         zwd(:,:,2) = 1._wp  ;  zwi(:,:,2) = 0._wp  ;  zws(:,:,2) = 0._wp  ;  zwrm(:,:,2) = 0._wp
+      END IF
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! 2nd order centered at top & bottom
+         ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point
+         ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point
+         !
+         zwd (ji,jj,ikt) = 1._wp          ! top
+         zwi (ji,jj,ikt) = 0._wp
+         zws (ji,jj,ikt) = 0._wp
+         zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) )
+         !
+         zwd (ji,jj,ikb) = 1._wp          ! bottom
+         zwi (ji,jj,ikb) = 0._wp
+         zws (ji,jj,ikb) = 0._wp
+         zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )
+      END_2D
+      !
+      !                       !==  tridiagonal solver  ==!
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE interp_4th_cpt
+   SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tridia_solver  ***
+      !!
+      !! **  Purpose :   solve a symmetric 3diagonal system
+      !!
+      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk )
+      !!
+      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 )
+      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 )
+      !!             (  0  L_3 D_3 U_3  0  )( t_3 ) = ( RHS_3 )
+      !!             (        ...          )( ... )   ( ...  )
+      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k )
+      !!
+      !!        M is decomposed in the product of an upper and lower triangular matrix.
+      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL
+      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal).
+      !!        The solution is pta.
+      !!        The 3d array zwt is used as a work space array.
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pD, pU, PL    ! 3-diagonal matrix
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pRHS          ! Right-Hand-Side
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(  out) ::   pt_out        !!gm field at level=F(klev)
+      INTEGER                    , INTENT(in   ) ::   klev          ! =1 pt_out at w-level
+      !                                                             ! =0 pt at t-level
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   kstart       ! local indices
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk) ::   zwt   ! 3D work array
+      !!----------------------------------------------------------------------
+      !
+      kstart =  1  + klev
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         zwt(ji,jj,kstart) = pD(ji,jj,kstart)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
+         zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
+         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, kstart, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE tridia_solver
+#if defined key_loop_fusion
+#define tracer_flux_i(out,zfp,zfm,ji,jj,jk) \
+        zfp = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ; \
+        zfm = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) ; \
+        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji+1,jj,jk,jn,Kbb) )
+#define tracer_flux_j(out,zfp,zfm,ji,jj,jk) \
+        zfp = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) ; \
+        zfm = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) ) ; \
+        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji,jj+1,jk,jn,Kbb) )
+   SUBROUTINE tra_adv_fct_lf( kt, kit000, cdtype, p2dt, pU, pV, pW,       &
+      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct  ***
+      !!
+      !! **  Purpose :   Compute the now trend due to total advection of tracers
+      !!               and add it to the general trend of tracer equations
+      !!
+      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction
+      !!               (choice through the value of kn_fct)
+      !!               - on the vertical the 4th order is a compact scheme
+      !!               - corrected flux (monotonic correction)
+      !!
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T)
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      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
+      INTEGER                                  , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
+      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
+      !
+      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices
+      REAL(wp) ::   ztra                                     ! local scalar
+      REAL(wp) ::   zwx_im1, zfp_ui, zfp_ui_m1, zfp_vj, zfp_vj_m1, zfp_wk, zC2t_u, zC4t_u   !   -      -
+      REAL(wp) ::   zwy_jm1, zfm_ui, zfm_ui_m1, zfm_vj, zfm_vj_m1, zfm_wk, zC2t_v, zC4t_v   !   -      -
+      REAL(wp) ::   ztu, ztv, ztu_im1, ztu_ip1, ztv_jm1, ztv_jp1
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx_3d, zwy_3d, zwz, ztw, zltu_3d, zltv_3d
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup
+      LOGICAL  ::   ll_zAimp                                 ! flag to apply adaptive implicit vertical advection
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct_lf : FCT advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !! -- init to 0
+      zwx_3d(:,:,:) = 0._wp
+      zwy_3d(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      zwi(:,:,:) = 0._wp
+      !
+      l_trd = .FALSE.            ! set local switches
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      ll_zAimp = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  &
+         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
+      !
+      IF( l_trd .OR. l_hst )  THEN
+         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) )
+         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      IF( l_ptr ) THEN
+         ALLOCATE( zptry(jpi,jpj,jpk) )
+         zptry(:,:,:) = 0._wp
+      ENDIF
+      !
+      ! If adaptive vertical advection, check if it is needed on this PE at this time
+      IF( ln_zad_Aimp ) THEN
+         IF( MAXVAL( ABS( wi(:,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE.
+      END IF
+      ! If active adaptive vertical advection, build tridiagonal matrix
+      IF( ll_zAimp ) THEN
+         ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk))
+         DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   &
+            &                               / e3t(ji,jj,jk,Krhs)
+            zwinf(ji,jj,jk) =  p2dt * MIN( wi(ji,jj,jk  ) , 0._wp ) / e3t(ji,jj,jk,Krhs)
+            zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t(ji,jj,jk,Krhs)
+         END_3D
+      END IF
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
          !                               !* upstream tracer flux in the k direction *!
          DO_3D( 1, 1, 1, 1, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
 …
          ENDIF
+         !
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme
+            !                               ! total intermediate advective trends
+            ztra = - (  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) ) * r1_e1e2t(ji,jj)
+            !                               ! update and guess with monotonic sheme
+            pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   &
+               &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk)
+            zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) &
+               &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+         END_3D
+         !                    !* upstream tracer flux in the i and j direction
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj-1
+               tracer_flux_i(zwx_3d(1,jj,jk),zfp_ui,zfm_ui,1,jj,jk)
+               tracer_flux_j(zwy_3d(1,jj,jk),zfp_vj,zfm_vj,1,jj,jk)
+            END DO
+            DO ji = 1, jpi-1
+               tracer_flux_i(zwx_3d(ji,1,jk),zfp_ui,zfm_ui,ji,1,jk)
+               tracer_flux_j(zwy_3d(ji,1,jk),zfp_vj,zfm_vj,ji,1,jk)
+            END DO
+            DO_2D( 1, 1, 1, 1 )
+               tracer_flux_i(zwx_3d(ji,jj,jk),zfp_ui,zfm_ui,ji,jj,jk)
+               tracer_flux_i(zwx_im1,zfp_ui_m1,zfm_ui_m1,ji-1,jj,jk)
+               tracer_flux_j(zwy_3d(ji,jj,jk),zfp_vj,zfm_vj,ji,jj,jk)
+               tracer_flux_j(zwy_jm1,zfp_vj_m1,zfm_vj_m1,ji,jj-1,jk)
+               ztra = - ( zwx_3d(ji,jj,jk) - zwx_im1 + zwy_3d(ji,jj,jk) - zwy_jm1 + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) * r1_e1e2t(ji,jj)
+               !                               ! update and guess with monotonic sheme
+               pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   &
+                  &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk)
+               zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) &
+                  &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+            END_2D
+         END DO
          IF ( ll_zAimp ) THEN
 …
+            !
             ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
                zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
                zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
 …
+         !
          IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes)
             ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
+            ztrdx(:,:,:) = zwx_3d(:,:,:)   ;   ztrdy(:,:,:) = zwy_3d(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
          END IF
          !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
          IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)
+         IF( l_ptr )   zptry(:,:,:) = zwy_3d(:,:,:)
+         !
          !        !==  anti-diffusive flux : high order minus low order  ==!
 …
+         !
          CASE(  2  )                   !- 2nd order centered
             DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
                zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk)
                zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk)
+            DO_3D( 2, 1, 2, 1, 1, jpkm1 )
+               zwx_3d(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx_3d(ji,jj,jk)
+               zwy_3d(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy_3d(ji,jj,jk)
             END_3D
+            !
          CASE(  4  )                   !- 4th order centered
+            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
+            zltv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                 ! Laplacian
+               DO_2D( 1, 0, 1, 0 )                 ! 1st derivative (gradient)
+                  ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+                  ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+               END_2D
+               DO_2D( 0, 0, 0, 0 )                 ! 2nd derivative * 1/ 6
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+            zltu_3d(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
+            zltv_3d(:,:,jpk) = 0._wp
+            !                          ! Laplacian
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )                 ! 2nd derivative * 1/ 6
+                  !             ! 1st derivative (gradient)
+                  ztu = ( pt(ji+1,jj,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+                  ztu_im1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk)
+                  ztv = ( pt(ji,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+                  ztv_jm1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk)
+                  !             ! 2nd derivative * 1/ 6
+                  zltu_3d(ji,jj,jk) = (  ztu + ztu_im1  ) * r1_6
+                  zltv_3d(ji,jj,jk) = (  ztv + ztv_jm1  ) * r1_6
                END_2D
             END DO
+            CALL lbc_lnk( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility
+            CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', -1.0_wp , zltv_3d, 'T', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO_3D( 2, 1, 2, 1, 1, jpkm1 )
                zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points
                zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
                !                                                        ! C4 minus upstream advective fluxes
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)
+            END_3D
+            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu_3d(ji,jj,jk) - zltu_3d(ji+1,jj,jk)   &
+                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility
+                             &                             ) - zwx_3d(ji,jj,jk)
+               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv_3d(ji,jj,jk) - zltv_3d(ji,jj+1,jk)   &
+                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility
+                             &                             ) - zwy_3d(ji,jj,jk)
+            END_3D
+            !
          CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
-            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
-            ztv(:,:,jpk) = 0._wp
-            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient)
-               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
-               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
-            END_3D
-            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+            !
             DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes
+               ztu_im1 = ( pt(ji  ,jj  ,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk)
+               ztu_ip1 = ( pt(ji+2,jj  ,jk,jn,Kmm) - pt(ji+1,jj,jk,jn,Kmm) ) * umask(ji+1,jj,jk)
+               ztv_jm1 = ( pt(ji,jj  ,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk)
+               ztv_jp1 = ( pt(ji,jj+2,jk,jn,Kmm) - pt(ji,jj+1,jk,jn,Kmm) ) * vmask(ji,jj+1,jk)
                zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2)
                zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
                !                                                  ! C4 interpolation of T at u- & v-points (x2)
                zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
                zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+               zC4t_u =  zC2t_u + r1_6 * ( ztu_im1 - ztu_ip1 )
+               zC4t_v =  zC2t_v + r1_6 * ( ztv_jm1 - ztv_jp1 )
                !                                                  ! C4 minus upstream advective fluxes
                zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
                zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
             END_3D
             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx_3d(ji,jj,jk)
+               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy_3d(ji,jj,jk)
+            END_3D
+            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+            !
          END SELECT
 …
+         !
          CASE(  2  )                   !- 2nd order centered
             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
                zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
                   &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
 …
          CASE(  4  )                   !- 4th order COMPACT
             CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point
             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
                zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
             END_3D
 …
          ENDIF
+         !
+         IF (nn_hls.EQ.1) THEN
+            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp )
+         ELSE
+            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
+         END IF
+         CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
+         !
          IF ( ll_zAimp ) THEN
             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !* trend and after field with monotonic scheme
+            DO_3D( 1, 1, 1, 1, 1, jpkm1 )    !* trend and after field with monotonic scheme
                !                                                ! total intermediate advective trends
                ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
                   &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+               ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   &
+                  &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   &
                   &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
                ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
 …
             CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
+            !
             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
                zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
                zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
 …
          !        !==  monotonicity algorithm  ==!
+         !
          CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt )
+         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt )
+         !
          !        !==  final trend with corrected fluxes  ==!
+         !
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
             ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
                &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+            ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   &
+               &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   &
                &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
             pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm)
 …
             END_3D
          END IF
+         ! NOT TESTED - NEED l_trd OR l_hst TRUE
          IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport
             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes
             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx_3d(:,:,:)  ! <<< add anti-diffusive fluxes
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy_3d(:,:,:)  !     to upstream fluxes
             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  !
+            !
 …
+            !
          ENDIF
+         ! NOT TESTED - NEED l_ptr TRUE
          IF( l_ptr ) THEN              ! "Poleward" transports
             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes
+            zptry(:,:,:) = zptry(:,:,:) + zwy_3d(:,:,:)  ! <<< add anti-diffusive fluxes
             CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
          ENDIF
 …
       ENDIF
+      !
+   END SUBROUTINE tra_adv_fct
+   SUBROUTINE nonosc( Kmm, 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
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   Kmm             ! time level index
+      REAL(wp)                        , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pbef            ! before field
+      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(in   ) ::   paft            ! after field
+      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(dp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
+      REAL(dp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      zbig  = 1.e+40_dp
+      zrtrn = 1.e-15_dp
+      zbetup(:,:,:) = 0._dp   ;   zbetdo(:,:,:) = 0._dp
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+         zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
+            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) )  )
+         zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
+            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) )  )
+      END_3D
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! 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 = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
+            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_2D
+      END DO
+      IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign)
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+         zcu =       ( 0.5  + SIGN( 0.5_wp , paa(ji,jj,jk) ) )
+         paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+         zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+         zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+         zcv =       ( 0.5  + SIGN( 0.5_wp , pbb(ji,jj,jk) ) )
+         pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - 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_wp , pcc(ji,jj,jk+1) ) )
+         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
+      END_3D
+      !
+   END SUBROUTINE nonosc
+   SUBROUTINE interp_4th_cpt_org( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt_org  ***
+      !!
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
+      !
+      INTEGER :: ji, jj, jk   ! dummy loop integers
+      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )       !==  build the three diagonal matrix  ==!
+         zwd (ji,jj,jk) = 4._wp
+         zwi (ji,jj,jk) = 1._wp
+         zws (ji,jj,jk) = 1._wp
+         zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         !
+         IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
+            zwd (ji,jj,jk) = 1._wp
+            zwi (ji,jj,jk) = 0._wp
+            zws (ji,jj,jk) = 0._wp
+            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         ENDIF
+      END_3D
+      !
+      jk = 2                                    ! Switch to second order centered at top
+      DO_2D( 1, 1, 1, 1 )
+         zwd (ji,jj,jk) = 1._wp
+         zwi (ji,jj,jk) = 0._wp
+         zws (ji,jj,jk) = 0._wp
+         zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+      END_2D
+      !
+      !                       !==  tridiagonal solve  ==!
+      DO_2D( 1, 1, 1, 1 )           ! first recurrence
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( 1, 1, 1, 1 )           ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+      DO_2D( 1, 1, 1, 1 )           ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( 1, 1, 1, 1, jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE interp_4th_cpt_org
+   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt  ***
+      !!
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point
+      REAL(wp),DIMENSION(A2D(nn_hls)    ,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   ikt, ikb     ! local integers
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      !
+      !                      !==  build the three diagonal matrix & the RHS  ==!
+      !
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )    ! interior (from jk=3 to jpk-1)
+         zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal
+         zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal
+         zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal
+         zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS
+            &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) )
+      END_3D
+      !
+!!gm
+!      SELECT CASE( kbc )               !* boundary condition
+!      CASE( np_NH   )   ! Neumann homogeneous at top & bottom
+!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom
+!      END SELECT
+!!gm
+      !
+      IF ( ln_isfcav ) THEN            ! set level two values which may not be set in ISF case
+         zwd(:,:,2) = 1._wp  ;  zwi(:,:,2) = 0._wp  ;  zws(:,:,2) = 0._wp  ;  zwrm(:,:,2) = 0._wp
+      END IF
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! 2nd order centered at top & bottom
+         ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point
+         ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point
+         !
+         zwd (ji,jj,ikt) = 1._wp          ! top
+         zwi (ji,jj,ikt) = 0._wp
+         zws (ji,jj,ikt) = 0._wp
+         zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) )
+         !
+         zwd (ji,jj,ikb) = 1._wp          ! bottom
+         zwi (ji,jj,ikb) = 0._wp
+         zws (ji,jj,ikb) = 0._wp
+         zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )
+      END_2D
+      !
+      !                       !==  tridiagonal solver  ==!
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE interp_4th_cpt
+   SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tridia_solver  ***
+      !!
+      !! **  Purpose :   solve a symmetric 3diagonal system
+      !!
+      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk )
+      !!
+      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 )
+      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 )
+      !!             (  0  L_3 D_3 U_3  0  )( t_3 ) = ( RHS_3 )
+      !!             (        ...          )( ... )   ( ...  )
+      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k )
+      !!
+      !!        M is decomposed in the product of an upper and lower triangular matrix.
+      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL
+      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal).
+      !!        The solution is pta.
+      !!        The 3d array zwt is used as a work space array.
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pD, pU, PL    ! 3-diagonal matrix
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pRHS          ! Right-Hand-Side
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(  out) ::   pt_out        !!gm field at level=F(klev)
+      INTEGER                    , INTENT(in   ) ::   klev          ! =1 pt_out at w-level
+      !                                                             ! =0 pt at t-level
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   kstart       ! local indices
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk) ::   zwt   ! 3D work array
+      !!----------------------------------------------------------------------
+      !
+      kstart =  1  + klev
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         zwt(ji,jj,kstart) = pD(ji,jj,kstart)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
+         zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
+         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, kstart, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE tridia_solver
+   END SUBROUTINE tra_adv_fct_lf
+#endif
    !!======================================================================
 END MODULE traadv_fct

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traadv_mus.F90

-                      r14433
+                      r14958
       LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
 …
       !!----------------------------------------------------------------------
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
 …
             zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
          END_3D
-         ! lateral boundary conditions   (changed sign)
-         IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )
          !                                !-- Slopes of tracer
          zslpx(:,:,jpk) = 0._wp                 ! bottom values
          zslpy(:,:,jpk) = 0._wp
          DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
                &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
 …
          END_3D
+         !
          DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )    !-- Slopes limitation
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !-- Slopes limitation
             zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
                &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   &
 …
                &                                                     2.*ABS( zwy  (ji,jj  ,jk) ) )
          END_3D
+         !
+         DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes
+         ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility
+         IF ( nn_hls==1 ) CALL lbc_lnk( 'traadv_mus', zslpx, 'T', -1.0_wp , zslpy, 'T', -1.0_wp )   ! lateral boundary conditions   (changed sign)
+         !
+         DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes
             ! MUSCL fluxes
             z0u = SIGN( 0.5_wp, pU(ji,jj,jk) )
 …
             zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
          END_3D
-         IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign)
+         !
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traadv_qck.F90

-                      r14433
+                      r14958
    USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_loop_fusion
+   USE traadv_qck_lf   ! QCK    scheme            (tra_adv_qck  routine - loop fusion version)
+#endif
    IMPLICIT NONE
 …
       INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
       !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_qck_lf ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
 …
       CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
+      !
+#endif
    END SUBROUTINE tra_adv_qck
 …
       INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
 …
             zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer
          END_3D
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions
+         !
 …
          END_3D
          !--- Lateral boundary conditions
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp )
          !--- QUICKEST scheme
 …
             zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
          END_3D
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )      ! Lateral boundary conditions
+         !
 …
       INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
 …
          zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0
+         !
+         DO jk = 1, jpkm1
+            !
+            !--- Computation of the ustream and downstream value of the tracer and the mask
+            DO_2D( 0, 0, nn_hls-1, nn_hls-1 )
+               ! Upstream in the x-direction for the tracer
+               zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb)
+               ! Downstream in the x-direction for the tracer
+               zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb)
+            END_2D
+         END DO
+         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions
+         !--- Computation of the ustream and downstream value of the tracer and the mask
+         DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 )
+            ! Upstream in the x-direction for the tracer
+            zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb)
+            ! Downstream in the x-direction for the tracer
+            zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb)
+         END_3D
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions
+         !
 …
          !--- Lateral boundary conditions
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp )
          !--- QUICKEST scheme
 …
             zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
          END_3D
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )    !--- Lateral boundary conditions
+         !
          ! Tracer flux on the x-direction
 …
       CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
       INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
 …
       !----------------------------------------------------------------------
+      !
       DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+      DO_3D( 1, 0, 1, 0, 1, jpkm1 )
          zc     = puc(ji,jj,jk)                         ! Courant number
          zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traadv_ubs.F90

-                      r14433
+                      r14958
    USE lbclnk         ! ocean lateral boundary condition (or mpp link)
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_loop_fusion
+   USE traadv_ubs_lf  ! UBS      scheme            (tra_adv_ubs  routine - loop fusion version)
+#endif
    IMPLICIT NONE
 …
       INTEGER                                  , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
 …
       !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_ubs_lf    ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
 …
+            !
          END DO
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn)
+         !
          DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS)
 …
          END_3D
+         !
          DO_3D( 1, 1, 1, 1, 1, jpk )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
             zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)      ! store the initial trends before its update
          END_3D
 …
          END DO
+         !
          DO_3D( 1, 1, 1, 1, 1, jpk )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
             zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk)  ! Horizontal advective trend used in vertical 2nd order FCT case
          END_3D                                                     ! and/or in trend diagnostic (l_trd=T)
 …
+            !
             !                               !*  upstream advection with initial mass fluxes & intermediate update  ==!
             DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
                zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
 …
             IF( ln_linssh ) THEN                ! top ocean value (only in linear free surface as ztw has been w-masked)
                IF( ln_isfcav ) THEN                   ! top of the ice-shelf cavities and at the ocean surface
                   DO_2D( 1, 1, 1, 1 )
+                  DO_2D( 0, 0, 0, 0 )
                      ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface
                   END_2D
                ELSE                                   ! no cavities: only at the ocean surface
                   DO_2D( 1, 1, 1, 1 )
+                  DO_2D( 0, 0, 0, 0 )
                      ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb)
                   END_2D
 …
+            !
             !                          !*  anti-diffusive flux : high order minus low order
             DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
                   &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
 …
             END_3D
             IF( ln_linssh ) THEN
                DO_2D( 1, 1, 1, 1 )
+               DO_2D( 0, 0, 0, 0 )
                   ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work
                END_2D
 …
       END DO
+      !
+#endif
    END SUBROUTINE tra_adv_ubs

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/trabbc.F90

r14072	r14958
102	102	ENDIF
103	103	!
104		IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain
105		CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
106		ENDIF
	104	CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
	105
107	106	IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' )
108	107	!

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/trabbl.F90

-                      r14433
+                      r14958
          CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
             &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+            CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef
+            CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
+         ENDIF
+         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef
+         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
+         !
       ENDIF
 …
          CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask, &
             &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+            ! lateral boundary conditions ; just need for outputs
+            CALL lbc_lnk( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp )
+            CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport
+            CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
+         ENDIF
+         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport
+         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
+         !
       ENDIF
 …
+   ! NOTE: [tiling] tiling changes the results, but only the order of floating point operations is different
    SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm )
       !!----------------------------------------------------------------------
 …
       INTEGER  ::   iis , iid , ijs , ijd    ! local integers
       INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
-      INTEGER  ::   isi, isj                 !   -       -
       REAL(wp) ::   zbtr, ztra               ! local scalars
       REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
       !!----------------------------------------------------------------------
+      !
-      IF( ntsi == Nis0 ) THEN ; isi = 1 ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-      IF( ntsj == Njs0 ) THEN ; isj = 1 ; ELSE ; isj = 0 ; ENDIF
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
          DO_2D( isi, 0, isj, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+         DO_2D_OVR( 1, 0, 1, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west
             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)
 …
       !!----------------------------------------------------------------------
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp)  WRITE(numout,*)
 …
       IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
          !                                !-------------------!
          DO_2D( 1, 0, 1, 0 )                   ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
+         DO_2D_OVR( 1, 0, 1, 0 )                   ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
             !                                                   ! i-direction
             za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point
 …
+         !
          CASE( 1 )                                   != use of upper velocity
             DO_2D( 1, 0, 1, 0 )                              ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
+            DO_2D_OVR( 1, 0, 1, 0 )                              ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
                !                                                  ! i-direction
                za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
 …
          CASE( 2 )                                 != bbl velocity = F( delta rho )
             zgbbl = grav * rn_gambbl
             DO_2D( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down
+            DO_2D_OVR( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down
                !                                                  ! i-direction
                ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/tradmp.F90

-                      r14072
+                      r14958
       IF( ln_timing )   CALL timing_start('tra_dmp')
+      !
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
+      IF( l_trdtra .OR. iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN   !* Save ta and sa trends
          ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )
          ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs)
 …
+         !
       END SELECT
+      !
+      ! outputs (clem trunk)
+      IF( iom_use('hflx_dmp_cea') )       &
+         &   CALL iom_put('hflx_dmp_cea', &
+         &   SUM( ( pts(:,:,:,jp_tem,Krhs) - ztrdts(:,:,:,jp_tem) ) * e3t(:,:,:,Kmm), dim=3 ) * rcp * rho0 ) ! W/m2
+      IF( iom_use('sflx_dmp_cea') )       &
+         &   CALL iom_put('sflx_dmp_cea', &
+         &   SUM( ( pts(:,:,:,jp_sal,Krhs) - ztrdts(:,:,:,jp_sal) ) * e3t(:,:,:,Kmm), dim=3 ) * rho0 )       ! g/m2/s
+      !
       IF( l_trdtra )   THEN       ! trend diagnostic

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traisf.F90

-                      r14072
+                      r14958
       IF( ln_timing )   CALL timing_start('tra_isf')
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
 …
+      !
       IF ( ln_isfdebug ) THEN
          IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only for the full domain
+         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only for the full domain
             CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs))
             CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs))

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traldf.F90

-                      r14189
+                      r14958
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
-   ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
-   USE domtile
    USE phycst         ! physical constants
    USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
 …
       !!
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
-      ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
-      LOGICAL :: lskip
       !!----------------------------------------------------------------------
+      !
       IF( ln_timing )   CALL timing_start('tra_ldf')
+      !
-      lskip = .FALSE.
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
 …
          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
       ENDIF
+      ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
+      IF( nldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it )  THEN
+         IF( ln_tile ) THEN
+            IF( ntile == 1 ) THEN
+               CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
+            ELSE
+               lskip = .TRUE.
+            ENDIF
+         ENDIF
+      ENDIF
+      IF( .NOT. lskip ) THEN
+         !
+         SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend
+         CASE ( np_lap   )                                  ! laplacian: iso-level operator
+            CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 )
+         CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
+            CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 )
+         CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
+            CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 )
+         CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
+            IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.)
+            CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra )
+         END SELECT
+         !
+         IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
+            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+            ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt )
+            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds )
+            DEALLOCATE( ztrdt, ztrds )
+         ENDIF
+         ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
+         IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )
+      !
+      SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend
+      CASE ( np_lap   )                                  ! laplacian: iso-level operator
+         CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 )
+      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 )
+      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 )
+      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
+         CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra )
+      END SELECT
+      !
+      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds )
+         DEALLOCATE( ztrdt, ztrds )
       ENDIF
       !                                        !* print mean trends (used for debugging)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traldf_iso.F90

-                      r14072
+                      r14958
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::  ikt
       INTEGER  ::  ierr             ! local integer
+      INTEGER  ::  ierr, iij        ! local integer
       REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
       REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      -
 …
+      !
       IF( kpass == 1 .AND. kt == kit000 )  THEN
          IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
 …
          ENDIF
+         !
          DO_3D( 0, 0, 0, 0, 1, jpk )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
             akz     (ji,jj,jk) = 0._wp
             ah_wslp2(ji,jj,jk) = 0._wp
 …
       ENDIF
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                           ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                           ! Do only on the first tile
          l_hst = .FALSE.
          l_ptr = .FALSE.
 …
       ENDIF
+      !
+      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case
+      IF( nldf_tra == np_blp_i .AND. kpass == 1 ) THEN ; iij = nn_hls
+      ELSE                                             ; iij = 1
+      ENDIF
+      !
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
 …
       IF( kpass == 1 ) THEN                  !==  first pass only  ==!
+         !
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+            !
             zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
 …
                &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+               !
+            zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+               &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+            zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+               &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            zahu_w = ( (  pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)                    &
+               &       )                                                           & ! bracket for halo 1 - halo 2 compatibility
+               &       + ( pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)                   &
+               &         )                                                         & ! bracket for halo 1 - halo 2 compatibility
+               &     ) * zmsku
+            zahv_w = ( (  pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)                    &
+               &       )                                                           & ! bracket for halo 1 - halo 2 compatibility
+               &       + ( pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)                   &
+               &         )                                                         & ! bracket for halo 1 - halo 2 compatibility
+               &     ) * zmskv
+               !
             ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
 …
+         !
          IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
                akz(ji,jj,jk) = 0.25_wp * (                                                                     &
                   &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
+                  &            ( ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
                   &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
+                  &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
+                  &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
+                  &            )                                                                               & ! bracket for halo 1 - halo 2 compatibility
+                  &            + ( ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) ) &
+                  &              + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) &
+                  &              )                                                                             & ! bracket for halo 1 - halo 2 compatibility
+                  &                      )
             END_3D
+            !
             IF( ln_traldf_blp ) THEN                ! bilaplacian operator
                DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   akz(ji,jj,jk) = 16._wp   &
                      &   * ah_wslp2   (ji,jj,jk)   &
 …
                END_3D
             ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
                DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
                   zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
 …
+           !
          ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
             DO_3D( 0, 0, 0, 0, 1, jpk )
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
                akz(ji,jj,jk) = ah_wslp2(ji,jj,jk)
             END_3D
 …
          !!   I - masked horizontal derivative
          !!----------------------------------------------------------------------
+!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (ntsi-nn_hls,:,:) = 0._wp     ;     zdit (ntei+nn_hls,:,:) = 0._wp
+         zdjt (ntsi-nn_hls,:,:) = 0._wp     ;     zdjt (ntei+nn_hls,:,:) = 0._wp
+         !!end
+         zdit(:,:,:) = 0._wp
+         zdjt(:,:,:) = 0._wp
          ! Horizontal tracer gradient
          DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )
             zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk)
             zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
          END_3D
          IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient
             DO_2D( 1, 0, 1, 0 )           ! bottom correction (partial bottom cell)
+            DO_2D( iij, iij-1, iij, iij-1 )            ! bottom correction (partial bottom cell)
                zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
                zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
             END_2D
             IF( ln_isfcav ) THEN      ! first wet level beneath a cavity
                DO_2D( 1, 0, 1, 0 )
+               DO_2D( iij, iij-1, iij, iij-1 )
                   IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)
                   IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)
 …
          DO jk = 1, jpkm1                                 ! Horizontal slab
+            !
             DO_2D( 1, 1, 1, 1 )
+            DO_2D( iij, iij, iij, iij )
                !                             !== Vertical tracer gradient
                zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1
 …
             END_2D
+            !
             DO_2D( 1, 0, 1, 0 )           !==  Horizontal fluxes
+            DO_2D( iij, iij-1, iij, iij-1 )           !==  Horizontal fluxes
                zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)
                zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
 …
                zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+               !
+               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(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(ji,jj,jk)
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)                       &
+                  &               + zcof1 * ( ( zdkt (ji+1,jj) + zdk1t(ji,jj)    &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         + ( zdk1t(ji+1,jj) + zdkt (ji,jj)    &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         ) ) * umask(ji,jj,jk)
+               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)                        &
+                  &              + zcof2 * ( ( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         + ( zdk1t(ji,jj+1) + zdkt (ji,jj)    &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         ) ) * vmask(ji,jj,jk)
             END_2D
+            !
+            DO_2D( 0, 0, 0, 0 )           !== horizontal divergence and add to pta
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    &
+                  &       + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
+                  &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            DO_2D( iij-1, iij-1, iij-1, iij-1 )           !== horizontal divergence and add to pta
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                         &
+                  &       + zsign * ( ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk)        &
+                  &                   )                                          & ! bracket for halo 1 - halo 2 compatibility
+                  &                 + ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk)        &
+                  &                   )                                          & ! bracket for halo 1 - halo 2 compatibility
+                  &                 ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
             END_2D
          END DO                                        !   End of slab
 …
          ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior (2=<jk=<jpk-1)
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )    ! interior (2=<jk=<jpk-1)
+            !
             zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
 …
             zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+            !
+            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)  )
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            ztfw(ji,jj,jk) = zcoef3 * ( ( zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   + ( zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   )                                                &
+                  &        + zcoef4 * ( ( zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   + ( zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   )
          END_3D
          !                                !==  add the vertical 33 flux  ==!
          IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
             DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   &
                   &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               &
 …
             SELECT CASE( kpass )
             CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
                DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                   ztfw(ji,jj,jk) =   &
                      &  ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   &
 …
          ENDIF
+         !
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==!
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==!
             pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * r1_e1e2t(ji,jj)   &
                &                                             / e3t(ji,jj,jk,Kmm)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traldf_lap_blp.F90

-                      r14215
+                      r14958
+      !
       INTEGER  ::   ji, jj, jk, jn      ! dummy loop indices
       INTEGER  ::   isi, iei, isj, iej  ! local integers
+      INTEGER  ::   iij
       REAL(wp) ::   zsign               ! local scalars
       REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   ztu, ztv, zaheeu, zaheev
       !!----------------------------------------------------------------------
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 .AND. lwp )  THEN
             WRITE(numout,*)
 …
       ENDIF
+      !
+      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case
+      IF( nldf_tra == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls
+      ELSE                                           ; iij = 1
+      ENDIF
       !                                !==  Initialization of metric arrays used for all tracers  ==!
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
 …
       ENDIF
+      IF( ntsi == Nis0 ) THEN ; isi = nn_hls - 1 ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
+      IF( ntsj == Njs0 ) THEN ; isj = nn_hls - 1 ; ELSE ; isj = 0 ; ENDIF
+      IF( ntei == Nie0 ) THEN ; iei = nn_hls - 1 ; ELSE ; iei = 0 ; ENDIF
+      IF( ntej == Nje0 ) THEN ; iej = nn_hls - 1 ; ELSE ; iej = 0 ; ENDIF
+      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
+      DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
          zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)   !!gm   * umask(ji,jj,jk) pah masked!
          zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)   !!gm   * vmask(ji,jj,jk)
 …
          !                          ! =========== !
+         !
          DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
+         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
             ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) )
             ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) )
          END_3D
          IF( ln_zps ) THEN                             ! set gradient at bottom/top ocean level
             DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                              ! bottom
+            DO_2D( iij, iij-1, iij, iij-1 )                              ! bottom
                ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
                ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
             END_2D
             IF( ln_isfcav ) THEN                             ! top in ocean cavities only
                DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+               DO_2D( iij, iij-1, iij, iij-1 )
                   IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)
                   IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)
 …
          ENDIF
+         !
+         DO_3D( isi, iei, isj, iej, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==!
+            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
+               &                                      +    ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
+               &                                      / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) )
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==!
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk)    &
+               &                                          )                                    & ! bracket for halo 1 - halo 2 compatibility
+               &                                      +   ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk)    &
+               &                                          )                                    & ! bracket for halo 1 - halo 2 compatibility
+               &                                        ) / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) )
          END_3D
+         !
 …
       !!---------------------------------------------------------------------
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 .AND. lwp )  THEN
             WRITE(numout,*)
 …
       END SELECT
+      !
       CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign)
+      IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign)
       !                                               ! Partial top/bottom cell: GRADh( zlap )
       IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traldf_triad.F90

-                      r14215
+                      r14958
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
-   ! TEMP: [tiling] This change not necessary if XIOS has subdomain support
-   USE domtile
    USE domutl, ONLY : is_tile
    USE phycst         ! physical constants
 …
       REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::  ip,jp,kp         ! dummy loop indices
+      INTEGER  ::  ierr            ! local integer
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3    ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4    !   -      -
+      INTEGER  ::  ji, jj, jk, jn, kp, iij   ! dummy loop indices
       REAL(wp) ::  zcoef0, ze3w_2, zsign          !   -      -
+      !
+      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
+      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt
+      REAL(wp) ::   zah, zah_slp, zaei_slp
+      REAL(wp), DIMENSION(A2D(nn_hls),0:1)     ::   zdkt3d                         ! vertical tracer gradient at 2 levels
+      REAL(wp), DIMENSION(A2D(nn_hls)        ) ::   z2d                            ! 2D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk) ::   zdit, zdjt, zftu, zftv, ztfw   ! 3D     -
+      ! TEMP: [tiling] This can be A2D(nn_hls) if XIOS has subdomain support
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw
+      REAL(wp) ::   zslope2, zbu, zbv, zbu1, zbv1, zslope21, zah, zah1, zah_ip1, zah_jp1, zbu_ip1, zbv_jp1
+      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt, zdyt_jp1, ze3wr_jp1, zdzt_jp1, zah_slp1, zah_slp_jp1, zaei_slp_jp1
+      REAL(wp) ::   zah_slp, zaei_slp, zdxt_ip1, ze3wr_ip1, zdzt_ip1, zah_slp_ip1, zaei_slp_ip1, zaei_slp1
+      REAL(wp), DIMENSION(A2D(nn_hls),0:1) ::   zdkt3d                                           ! vertical tracer gradient at 2 levels
+      REAL(wp), DIMENSION(A2D(nn_hls)    ) ::   z2d                                              ! 2D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     -
       !!----------------------------------------------------------------------
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kpass == 1 .AND. kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
 …
       ENDIF
+      !
+      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case
+      IF( nldf_tra == np_blp_it .AND. kpass == 1 ) THEN ; iij = nn_hls
+      ELSE                                              ; iij = 1
+      ENDIF
+      !
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
       ELSE                    ;   zsign = -1._wp
 …
       IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==!
+         !
          DO_3D( 0, 0, 0, 0, 1, jpk )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
             akz     (ji,jj,jk) = 0._wp
             ah_wslp2(ji,jj,jk) = 0._wp
          END_3D
+         !
+         DO ip = 0, 1                            ! i-k triads
+            DO kp = 0, 1
+               DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+                  ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                  zbu   = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm)
+                  zah   = 0.25_wp * pahu(ji-ip,jj,jk)
+                  zslope_skew = triadi_g(ji,jj,jk,1-ip,kp)
+                  ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
+                  zslope2 = zslope_skew + ( gdept(ji-ip+1,jj,jk,Kmm) - gdept(ji-ip,jj,jk,Kmm) ) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp)
+                  zslope2 = zslope2 *zslope2
+                  ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2
+                  akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e1u(ji-ip,jj)       &
+                     &                                                      * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp)
+                     !
+               END_3D
+            END DO
+         DO kp = 0, 1                            ! i-k triads
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+               ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+               zbu   = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+               zbu1  = e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)
+               zah   = 0.25_wp * pahu(ji,jj,jk)
+               zah1  = 0.25_wp * pahu(ji-1,jj,jk)
+               ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
+               zslope2 = triadi_g(ji,jj,jk,1,kp) + ( gdept(ji+1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+               zslope2 = zslope2 *zslope2
+               zslope21 = triadi_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji-1,jj,jk,Kmm) ) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp)
+               zslope21 = zslope21 *zslope21
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               ah_wslp2(ji,jj,jk+kp) =  ah_wslp2(ji,jj,jk+kp) + ( zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2                    &
+                        &                                       + zah1 * zbu1 * ze3wr * r1_e1e2t(ji,jj) * zslope21                 &
+                        &                                       )                                                                  ! bracket for halo 1 - halo 2 compatibility
+               akz     (ji,jj,jk+kp) =  akz     (ji,jj,jk+kp) + ( zah * r1_e1u(ji,jj) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)         &
+                                                                + zah1 * r1_e1u(ji-1,jj) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp)  &
+                        &                                       )                                                                  ! bracket for halo 1 - halo 2 compatibility
+            END_3D
          END DO
+         !
+         DO jp = 0, 1                            ! j-k triads
+            DO kp = 0, 1
+               DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+                  ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm)
+                  zbv   = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm)
+                  zah   = 0.25_wp * pahv(ji,jj-jp,jk)
+                  zslope_skew = triadj_g(ji,jj,jk,1-jp,kp)
+                  ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+                  !    (do this by *adding* gradient of depth)
+                  zslope2 = zslope_skew + ( gdept(ji,jj-jp+1,jk,Kmm) - gdept(ji,jj-jp,jk,Kmm) ) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp)
+                  zslope2 = zslope2 * zslope2
+                  ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2
+                  akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e2v(ji,jj-jp)     &
+                     &                                                      * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp)
+                  !
+               END_3D
+            END DO
+         DO kp = 0, 1                            ! j-k triads
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+               ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm)
+               zbv   = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+               zbv1   = e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)
+               zah   = 0.25_wp * pahv(ji,jj,jk)
+               zah1   = 0.25_wp * pahv(ji,jj-1,jk)
+               ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+               !    (do this by *adding* gradient of depth)
+               zslope2 = triadj_g(ji,jj,jk,1,kp) + ( gdept(ji,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+               zslope2 = zslope2 * zslope2
+               zslope21 = triadj_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji,jj-1,jk,Kmm) ) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp)
+               zslope21 = zslope21 * zslope21
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + ( zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2                     &
+                        &                                      + zah1 * zbv1 * ze3wr * r1_e1e2t(ji,jj) * zslope21                  &
+                        &                                      )                                                                   ! bracket for halo 1 - halo 2 compatibility
+               akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + ( zah * r1_e2v(ji,jj) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)          &
+                        &                                      + zah1 * r1_e2v(ji,jj-1) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp)   &
+                        &                                      )                                                                   ! bracket for halo 1 - halo 2 compatibility
+            END_3D
          END DO
+         !
 …
+            !
             IF( ln_traldf_blp ) THEN                ! bilaplacian operator
                DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   akz(ji,jj,jk) = 16._wp           &
                      &   * ah_wslp2   (ji,jj,jk)   &
 …
                END_3D
             ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
                DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
                   zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
 …
+           !
          ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
             DO_3D( 0, 0, 0, 0, 1, jpk )
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
                akz(ji,jj,jk) = ah_wslp2(ji,jj,jk)
             END_3D
          ENDIF
+         !
+         ! TEMP: [tiling] These changes not necessary if XIOS has subdomain support
+         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
+            IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN
+               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
+               zpsi_uw(:,:,:) = 0._wp
+               zpsi_vw(:,:,:) = 0._wp
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+                        zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) &
+                           & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp)
+                        zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) &
+                           & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp)
+                     END_3D
+                  END DO
+               END DO
+               CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
+               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )
+            ENDIF
+         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN
+            zpsi_uw(:,:,:) = 0._wp
+            zpsi_vw(:,:,:) = 0._wp
+            DO kp = 0, 1
+               DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+                  ! round brackets added to fix the order of floating point operations
+                  ! needed to ensure halo 1 - halo 2 compatibility
+                  zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)                                     &
+                     & + ( 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji,jj,jk,1,kp)        &
+                     &   + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+1,jj,jk,0,kp)      &
+                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility
+                  zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)                                     &
+                     & + ( 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj,jk,1,kp)        &
+                     &   + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+1,jk,0,kp)      &
+                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility
+               END_3D
+            END DO
+            CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
          ENDIF
+         !
 …
          zftu(:,:,:) = 0._wp
          zftv(:,:,:) = 0._wp
+         !
+         DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==!
+         zdit(:,:,:) = 0._wp
+         zdjt(:,:,:) = 0._wp
+         !
+         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==!
             zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk)
             zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
          END_3D
          IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level
             DO_2D( 1, 0, 1, 0 )                    ! bottom level
+            DO_2D( iij, iij-1, iij, iij-1 )                    ! bottom level
                zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
                zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
             END_2D
             IF( ln_isfcav ) THEN                   ! top level (ocean cavities only)
                DO_2D( 1, 0, 1, 0 )
+               DO_2D( iij, iij-1, iij, iij-1 )
                   IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn)
                   IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn)
 …
          DO jk = 1, jpkm1
             !                    !==  Vertical tracer gradient at level jk and jk+1
             DO_2D( 1, 1, 1, 1 )
+            DO_2D( iij, iij, iij, iij )
                zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1)
             END_2D
 …
             IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
             ELSE
                DO_2D( 1, 1, 1, 1 )
+               DO_2D( iij, iij, iij, iij )
                   zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                END_2D
 …
+            !
             zaei_slp = 0._wp
+            zaei_slp_ip1 = 0._wp
+            zaei_slp_jp1 = 0._wp
+            zaei_slp1 = 0._wp
+            !
             IF( ln_botmix_triad ) THEN
+               DO ip = 0, 1              !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO_2D( 1, 0, 1, 0 )
+                        ze1ur = r1_e1u(ji,jj)
+                        zdxt  = zdit(ji,jj,jk) * ze1ur
+                        ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp)
+                        !
+                        zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                        zah = pahu(ji,jj,jk)
+                        zah_slp  = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew
+                        zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                        ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr
+                     END_2D
+                  END DO
+               DO kp = 0, 1              !==  Horizontal & vertical fluxes
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze1ur = r1_e1u(ji,jj)
+                     zdxt  = zdit(ji,jj,jk) * ze1ur
+                     zdxt_ip1  = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_ip1  = zdkt3d(ji+1,jj,kp) * ze3wr_ip1
+                     !
+                     zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                     zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm)
+                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                     zah = pahu(ji,jj,jk)
+                     zah_ip1 = pahu(ji+1,jj,jk)
+                     zah_slp  = zah * triadi(ji,jj,jk,1,kp)
+                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp)
+                     zah_slp1  = zah * triadi(ji+1,jj,jk,0,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp)
+                        zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp)
+                        zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftu(ji   ,jj,jk  ) =  zftu(ji   ,jj,jk )                                                               &
+                                         &    - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur               &
+                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              &
+                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
+               !
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO_2D( 1, 0, 1, 0 )
+                        ze2vr = r1_e2v(ji,jj)
+                        zdyt  = zdjt(ji,jj,jk) * ze2vr
+                        ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                        zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked...
+                        zah = pahv(ji,jj,jk)
+                        zah_slp = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew
+                        zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                        ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr
+                     END_2D
+                  END DO
+               DO kp = 0, 1
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze2vr = r1_e2v(ji,jj)
+                     zdyt  = zdjt(ji,jj,jk) * ze2vr
+                     zdyt_jp1  = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_jp1  = zdkt3d(ji,jj+1,kp) * ze3wr_jp1
+                     zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                     zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm)
+                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                     zah = pahv(ji,jj,jk)          ! pahv(ji,jj+jp,jk)  ????
+                     zah_jp1 = pahv(ji,jj+1,jk)
+                     zah_slp = zah * triadj(ji,jj,jk,1,kp)
+                     zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp)
+                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp)
+                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp)
+                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftv(ji,jj  ,jk   ) =  zftv(ji,jj  ,jk   )                                                              &
+                                         &    - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr               &
+                                         &      + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji,jj+1,jk+kp) =  ztfw(ji,jj+1,jk+kp)                                                              &
+                                         &    - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1             &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
+               !
             ELSE
+               !
+               DO ip = 0, 1               !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO_2D( 1, 0, 1, 0 )
+                        ze1ur = r1_e1u(ji,jj)
+                        zdxt  = zdit(ji,jj,jk) * ze1ur
+                        ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
+                        !
+                        zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .F. mask zah for bottom half cells
+                        zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
+                        zah_slp  = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew
+                        zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                        ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                     END_2D
+                  END DO
+               DO kp = 0, 1               !==  Horizontal & vertical fluxes
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze1ur = r1_e1u(ji,jj)
+                     zdxt  = zdit(ji,jj,jk) * ze1ur
+                     zdxt_ip1  = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_ip1  = zdkt3d(ji+1,jj,kp) * ze3wr_ip1
+                     !
+                     zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                     zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm)
+                     ! ln_botmix_triad is .F. mask zah for bottom half cells
+                     zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
+                     zah_ip1 = pahu(ji+1,jj,jk) * umask(ji+1,jj,jk+kp)
+                     zah_slp  = zah * triadi(ji,jj,jk,1,kp)
+                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp)
+                     zah_slp1  = zah * triadi(ji+1,jj,jk,0,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp)
+                        zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp)
+                        zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftu(ji   ,jj,jk  ) =  zftu(ji   ,jj,jk )                                                               &
+                                         &    - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur               &
+                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              &
+                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
+               !
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO_2D( 1, 0, 1, 0 )
+                        ze2vr = r1_e2v(ji,jj)
+                        zdyt  = zdjt(ji,jj,jk) * ze2vr
+                        ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm)
+                        zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                        zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                        ! ln_botmix_triad is .F. mask zah for bottom half cells
+                        zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
+                        zah_slp = zah * zslope_iso
+                        IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew
+                        zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                        ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                     END_2D
+                  END DO
+               DO kp = 0, 1
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze2vr = r1_e2v(ji,jj)
+                     zdyt  = zdjt(ji,jj,jk) * ze2vr
+                     zdyt_jp1  = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_jp1  = zdkt3d(ji,jj+1,kp) * ze3wr_jp1
+                     zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                     zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm)
+                     ! ln_botmix_triad is .F. mask zah for bottom half cells
+                     zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
+                     zah_jp1 = pahv(ji,jj+1,jk) * vmask(ji,jj+1,jk+kp)
+                     zah_slp = zah * triadj(ji,jj,jk,1,kp)
+                     zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp)
+                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp)
+                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp)
+                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftv(ji,jj  ,jk   ) =  zftv(ji,jj  ,jk   )                                                              &
+                                         &    - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr               &
+                                         &      + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji,jj+1,jk+kp) =  ztfw(ji,jj+1,jk+kp)                                                              &
+                                         &    - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1             &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
             ENDIF
             !                             !==  horizontal divergence and add to the general trend  ==!
+            DO_2D( 0, 0, 0, 0 )
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    &
+                  &                       + zsign * (  zftu(ji-1,jj  ,jk) - zftu(ji,jj,jk)       &
+                  &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   &
+                  &                                        / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  )
+            DO_2D( iij-1, iij-1, iij-1, iij-1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                                                &
+                  &                       + zsign * ( ( zftu(ji-1,jj  ,jk) - zftu(ji,jj,jk)             &
+                  &                                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+                  &                                 + ( zftv(ji,jj-1,jk) - zftv(ji,jj,jk)               &
+                  &                                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+                  &                                 ) / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  )
             END_2D
+            !
 …
          !                                !==  add the vertical 33 flux  ==!
          IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
             DO_3D( 0, 0, 1, 0, 2, jpkm1 )
+            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   &
                   &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
 …
             SELECT CASE( kpass )
             CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
                DO_3D( 0, 0, 1, 0, 2, jpkm1 )
+               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                   ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             &
                      &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) )
                END_3D
             CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp.
                DO_3D( 0, 0, 1, 0, 2, jpkm1 )
+               DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                   ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      &
                      &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   &
 …
          ENDIF
+         !
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==!
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==!
             pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    &
             &                                  + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/tramle.F90

-                      r14433
+                      r14958
       INTEGER                     , INTENT(in   ) ::   Kmm        ! ocean time level index
       CHARACTER(len=3)            , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pv         ! out: same 3  transport components
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport
+      ! TEMP: [tiling] Can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv         ! out: same 3  transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport
+      !
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
 …
       REAL(wp) ::   zcvw, zmvw          !   -      -
       INTEGER , DIMENSION(A2D(nn_hls))     :: inml_mle
       REAL(wp), DIMENSION(A2D(nn_hls))     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_MH
+      REAL(wp), DIMENSION(A2D(nn_hls))     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH
       REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw
-      ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
-      REAL(wp), DIMENSION(:,:),   ALLOCATABLE, SAVE :: zLf_NH
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zpsiu_mle, zpsiv_mle
       !!----------------------------------------------------------------------
+      !
 …
          SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
          CASE ( 0 )                                               != min of the 2 neighbour MLDs
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) )
                zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) )
             END_2D
          CASE ( 1 )                                               != average of the 2 neighbour MLDs
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
                zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
             END_2D
          CASE ( 2 )                                               != max of the 2 neighbour MLDs
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
                zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
 …
          END SELECT
          IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            &
                     &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   &
 …
+            !
          ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               &
                     &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )
 …
          !                                      !==  MLD used for MLE  ==!
          !                                                ! compute from the 10m density to deal with the diurnal cycle
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1)
          END_2D
          IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m
            DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m)
+           DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m)
               IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer
            END_3D
 …
          zbm (:,:) = 0._wp
          zn2 (:,:) = 0._wp
          DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer
             zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
             zmld(ji,jj) = zmld(ji,jj) + zc
 …
          SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
          CASE ( 0 )                                               != min of the 2 neighbour MLDs
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) )
                zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) )
             END_2D
          CASE ( 1 )                                               != average of the 2 neighbour MLDs
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp
                zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp
             END_2D
          CASE ( 2 )                                               != max of the 2 neighbour MLDs
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) )
                zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) )
 …
          END SELECT
          !                                                ! convert density into buoyancy
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) )
          END_2D
 …
+         !
          IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            &
                     &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   &
 …
+            !
          ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               &
                     &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )
 …
+         !
          IF( nn_conv == 1 ) THEN              ! No MLE in case of convection
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp
                IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp
 …
       ENDIF  ! end of ln_osm_mle conditional
     !                                      !==  structure function value at uw- and vw-points  ==!
     DO_2D( 1, 0, 1, 0 )
+    DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
        zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu
        zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall)
 …
     zpsi_vw(:,:,:) = 0._wp
+    !
+      DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0
+      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax )                ! start from 2 : surface value = 0
          zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj)
          zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj)
 …
       !                                      !==  transport increased by the MLE induced transport ==!
       DO jk = 1, ikmax
          DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1
+         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
             pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
             pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
          END_2D
          DO_2D( 0, 0, 0, 0 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   &
                &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1)
 …
       END DO
-      ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
       IF( cdtype == 'TRA') THEN              !==  outputs  ==!
-         IF( ntile == 0 .OR. ntile == 1 ) THEN                             ! Do only on the first tile
-            ALLOCATE( zLf_NH(jpi,jpj), zpsiu_mle(jpi,jpj,jpk), zpsiv_mle(jpi,jpj,jpk) )
-            zpsiu_mle(:,:,:) = 0._wp ; zpsiv_mle(:,:,:) = 0._wp
-         ENDIF
+         !
          IF (ln_osm_mle.and.ln_zdfosm) THEN
 …
          ENDIF
+         !
+         CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f
+         !
          ! divide by cross distance to give streamfunction with dimensions m^2/s
          DO_3D( 0, 0, 0, 0, 1, ikmax+1 )
             zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj)
             zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj)
+            zpsi_uw(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj)
+            zpsi_vw(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj)
          END_3D
+         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+            CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f
+            CALL iom_put( "psiu_mle", zpsiu_mle )    ! i-mle streamfunction
+            CALL iom_put( "psiv_mle", zpsiv_mle )    ! j-mle streamfunction
+            DEALLOCATE( zLf_NH, zpsiu_mle, zpsiv_mle )
+         ENDIF
+         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction
+         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction
       ENDIF
+      !

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/tranpc.F90

-                      r14215
+                      r14958
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
-   ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed)
-   USE domtile
    USE phycst         ! physical constants
    USE zdf_oce        ! ocean vertical physics
 …
       LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
       INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1"
-      INTEGER :: isi, isj, iei, iej
       LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu"
       !!----------------------------------------------------------------------
 …
          CALL bn2    ( pts(:,:,:,:,Kaa), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points)
+         !
+         IF( ntile == 0 .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile
+         !
+         IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
+         IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF
+         IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF
+         IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF
+         !
+         DO_2D( isi, iei, isj, iej )                        ! interior column only
+         IF( .NOT. l_istiled .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile
+         !
+         DO_2D_OVR( 0, 0, 0, 0 )                        ! interior column only
+            !
             IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points
 …
          ENDIF
+         !
          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
+         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only for the full domain
             IF( lwp .AND. l_LB_debug ) THEN
                WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', nnpcc

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/traqsr.F90

-                      r14215
+                      r14958
+      !
       INTEGER  ::   ji, jj, jk               ! dummy loop indices
       INTEGER  ::   irgb, isi, iei, isj, iej ! local integers
+      INTEGER  ::   irgb                     ! local integers
       REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
       REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
 …
       IF( ln_timing )   CALL timing_start('tra_qsr')
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
 …
       !                         !  before qsr induced heat content  !
       !                         !-----------------------------------!
-      IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-      IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF
-      IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF
-      IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF
       IF( kt == nit000 ) THEN          !==  1st time step  ==!
          IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN    ! read in restart
             z1_2 = 0.5_wp
             IF( ntile == 0 .OR. ntile == 1 )  THEN                        ! Do only on the first tile
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                        ! Do only on the first tile
                IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
                CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
 …
          ELSE                                           ! No restart or Euler forward at 1st time step
             z1_2 = 1._wp
             DO_3D( isi, iei, isj, iej, 1, jpk )
+            DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
                qsr_hc_b(ji,jj,jk) = 0._wp
             END_3D
 …
       ELSE                             !==  Swap of qsr heat content  ==!
          z1_2 = 0.5_wp
          DO_3D( isi, iei, isj, iej, 1, jpk )
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
             qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk)
          END_3D
 …
       CASE( np_BIO )                   !==  bio-model fluxes  ==!
+         !
          DO_3D( isi, iei, isj, iej, 1, nksr )
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )
             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) )
          END_3D
 …
+         !
          IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
             IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
+               IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. )             ! Use full domain
                CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )            ! Revert to tile domain
+               IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. )            ! Revert to tile domain
             ENDIF
+            !
 …
             ! most expensive calculations)
+            !
             DO_2D( isi, iei, isj, iej )
+            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
                        ! zlogc = log(zchl)
                zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) )
 …
+!
             DO_3D( isi, iei, isj, iej, 1, nksr + 1 )
+            DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr + 1 )
                ! zchl    = ALOG( ze0(ji,jj) )
                zlogc = ze0(ji,jj)
 …
+         !
          zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
          DO_2D( isi, iei, isj, iej )
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
             ze0(ji,jj) = rn_abs * qsr(ji,jj)
             ze1(ji,jj) = zcoef  * qsr(ji,jj)
 …
+         !
          !                                    !* interior equi-partition in R-G-B depending on vertical profile of Chl
          DO_3D( isi, iei, isj, iej, 2, nksr + 1 )
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr + 1 )
             ze3t = e3t(ji,jj,jk-1,Kmm)
             irgb = NINT( ztmp3d(ji,jj,jk) )
 …
          END_3D
+         !
          DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )          !* now qsr induced heat content
             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) )
          END_3D
 …
          zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands
          zz1 = ( 1. - rn_abs ) * r1_rho0_rcp
          DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )          !* now qsr induced heat content
             zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r )
             zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r )
 …
+      !
       ! sea-ice: store the 1st ocean level attenuation coefficient
       DO_2D( isi, iei, isj, iej )
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
          IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) )
          ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
 …
       END_2D
+      !
+      ! TEMP: [tiling] This change not necessary and working array can use A2D(nn_hls) if using XIOS (subdomain support)
+      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
+         IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
+            ALLOCATE( zetot(jpi,jpj,jpk) )
+            zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
+            DO jk = nksr, 1, -1
+               zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp
+            END DO
+            CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
+            DEALLOCATE( zetot )
+         ENDIF
+      ENDIF
+      !
+      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
+         ALLOCATE( zetot(A2D(nn_hls),jpk) )
+         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
+         DO_3DS(0, 0, 0, 0, nksr, 1, -1)
+            zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) * rho0_rcp
+         END_3D
+         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
+         DEALLOCATE( zetot )
+      ENDIF
+      !
+      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
          IF( lrst_oce ) THEN     ! write in the ocean restart file
             CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/trasbc.F90

-                      r14215
+                      r14958
+      !
       INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices
       INTEGER  ::   ikt, ikb, isi, iei, isj, iej ! local integers
+      INTEGER  ::   ikt, ikb                     ! local integers
       REAL(wp) ::   zfact, z1_e3t, zdep, ztim    ! local scalar
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds
 …
       IF( ln_timing )   CALL timing_start('tra_sbc')
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
 …
       ENDIF
+      !
-      IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-      IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF
-      IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF
-      IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF
 !!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
       IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
          DO_2D( isi, iei, isj, iej )
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
             qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns
             qsr(ji,jj) = 0._wp                        ! qsr set to zero
 …
          IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN      ! Restart: read in restart file
             zfact = 0.5_wp
             IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
                IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
                sbc_tsc(:,:,:) = 0._wp
 …
          ELSE                                             ! No restart or restart not found: Euler forward time stepping
             zfact = 1._wp
             DO_2D( isi, iei, isj, iej )
+            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
                sbc_tsc(ji,jj,:) = 0._wp
                sbc_tsc_b(ji,jj,:) = 0._wp
 …
       ELSE                                !* other time-steps: swap of forcing fields
          zfact = 0.5_wp
          DO_2D( isi, iei, isj, iej )
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
             sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:)
          END_2D
       ENDIF
       !                             !==  Now sbc tracer content fields  ==!
       DO_2D( isi, iei, isj, iej )
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
          sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux
          sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting
       END_2D
       IF( ln_linssh ) THEN                !* linear free surface
          DO_2D( isi, iei, isj, iej )                    !==>> add concentration/dilution effect due to constant volume cell
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )                    !==>> add concentration/dilution effect due to constant volume cell
             sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
             sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
          END_2D                                 !==>> output c./d. term
+         IF( ntile == 0 .OR. ntile == nijtile )  THEN             ! Do only on the last tile
+            IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
+            IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
+         ENDIF
+         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
+         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
       ENDIF
+      !
 …
       END DO
+      !
       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
          IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
             CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
 …
       ENDIF
+      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+         IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
+         IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
+      ENDIF
+      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
+      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
 #if defined key_asminc

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/trazdf.F90

r14433	r14958
64	64	!
65	65	IF( kt == nit000 ) THEN
66		IF( ~~ntile == 0~~ .OR. ntile == 1 ) THEN ! Do only on the first tile
	66	IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
67	67	IF(lwp)WRITE(numout,*)
68	68	IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S'

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRA/zpshde.F90

-                      r14433
+                      r14958
       INTEGER                     , INTENT(in   )           ::  Kmm         ! ocean time level index
       INTEGER                     , INTENT(in   )           ::  kjpt        ! number of tracers
       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta         ! 4D tracers fields
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta         ! 4D tracers fields
       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts
       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
       REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
+      !
 …
       INTEGER                                , INTENT(in   )           ::  kjpt        ! number of tracers
       INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktrd, ktgr
       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta         ! 4D tracers fields
+      REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta         ! 4D tracers fields
       REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts
       REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
       REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
+      !
 …
+      !
       IF( ln_timing )   CALL timing_start( 'zps_hde')
-      IF (nn_hls.EQ.2) THEN
-         CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp)
-         IF(PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp)
-      END IF
+      !
       pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp
 …
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! Gradient of density at the last level
+         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )              ! Gradient of density at the last level
             iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
             ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
 …
       END DO
+      !
       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
+      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
+      !
       IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
 …
             ENDIF
          END_2D
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
+         !
       END IF
 …
       INTEGER                     , INTENT(in   )           ::  Kmm          ! ocean time level index
       INTEGER                     , INTENT(in   )           ::  kjpt         ! number of tracers
       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta          ! 4D tracers fields
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta          ! 4D tracers fields
       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts
       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields
       REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom)
       REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
 …
       INTEGER                                , INTENT(in   )           ::  kjpt         ! number of tracers
       INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktgti, ktrd, ktgr, ktgri
       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta          ! 4D tracers fields
+      REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta          ! 4D tracers fields
       REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts
       REAL(wp), DIMENSION(A2D_T(ktgti)   ,KJPT), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
       REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields
+      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields
       REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom)
       REAL(wp), DIMENSION(A2D_T(ktgri)        ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
 …
       IF( ln_timing )   CALL timing_start( 'zps_hde_isf')
+      !
-      IF (nn_hls.EQ.2) THEN
-         CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp)
-         IF (PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp)
-      END IF
       pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp
       pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp
 …
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
             iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
 …
       END DO
+      !
       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
+      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
       ! horizontal derivative of density anomalies (rd)
 …
          END_2D
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
+         !
       END IF
 …
+      !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
             iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1
             ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
 …
+         !
       END DO
       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
+      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
       IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
 …
          END_2D
          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions
+         !
       END IF

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/TRD/trdini.F90

r14090	r14958
93	93	CALL ctl_warn('Tiling is not yet implemented for the trends diagnostics; ln_tile is forced to FALSE')
94	94	ln_tile = .FALSE.
95		CALL dom_tile~~( ntsi, ntsj, ntei, ntej )~~
	95	CALL dom_tile_init
96	96	ENDIF
97	97

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/USR/usrdef_istate.F90

r14053	r14958
61	61	pv (:,:,:) = 0._wp
62	62	!
63		DO_3D( ~~1, 1, 1, 1~~, 1, jpk ) ! horizontally uniform T & S profiles
	63	DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) ! horizontally uniform T & S profiles
64	64	pts(ji,jj,jk,jp_tem) = ( ( 16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) ) &
65	65	& * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2. &

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfddm.F90

-                      r14053
+                      r14958
       REAL(dp) ::          zavfs    !   -      -
       REAL(wp) ::   zavdt, zavds    !   -      -
       REAL(wp), DIMENSION(jpi,jpj) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
       !!----------------------------------------------------------------------
+      !
 …
 !!gm                            and many acces in memory
          DO_2D( 1, 1, 1, 1 )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==!
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==!
             zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   &
 !!gm please, use e3w at Kmm below
 …
          END_2D
          DO_2D( 1, 1, 1, 1 )           !==  indicators  ==!
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !==  indicators  ==!
             ! stability indicator: msks=1 if rn2>0; 0 elsewhere
             IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp
             ELSE                                       ;   zmsks(ji,jj) = 1._wp
+            ELSE                                       ;   zmsks(ji,jj) = 1._wp * wmask(ji,jj,jk)   ! mask so avt and avs masked
             ENDIF
             ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere
 …
             ENDIF
          END_2D
-         ! mask zmsk in order to have avt and avs masked
-         zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk)
          ! Update avt and avs
          ! ------------------
          ! Constant eddy coefficient: reset to the background value
          DO_2D( 1, 1, 1, 1 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             zinr = 1._wp / zrau(ji,jj)
             ! salt fingering

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfdrg.F90

-                      r13558
+                      r14958
+      !
       IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U|
          DO_2D( 0, 0, 0, 0 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             imk = k_mk(ji,jj)          ! ocean bottom level at t-points
             zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point
 …
          END_2D
       ELSE                                            !==  standard Cd  ==!
          DO_2D( 0, 0, 0, 0 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             imk = k_mk(ji,jj)    ! ocean bottom level at t-points
             zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point
 …
             l_log_not_linssh = .FALSE.    !- don't update Cd at each time step
+            !
             DO_2D( 1, 1, 1, 1 )              ! pCd0 = mask (and boosted) logarithmic drag coef.
+            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )              ! pCd0 = mask (and boosted) logarithmic drag coef.
                zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj))
                zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfevd.F90

-                      r13295
+                      r14958
+      !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zavt_evd, zavm_evd
+      ! NOTE: [tiling] use a SAVE array to store diagnostics, then send after all tiles are finished. This is necessary because p_avt/p_avm are modified on adjacent tiles when using nn_hls > 1. zavt_evd/zavm_evd are then zero on some points when subsequently calculated for these tiles.
+      REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd
       !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         IF(lwp) WRITE(numout,*)
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)'
+            IF(lwp) WRITE(numout,*) '~~~~~~~ '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+         ALLOCATE( zavt_evd(jpi,jpj,jpk) )
+         IF( nn_evdm == 1 ) ALLOCATE( zavm_evd(jpi,jpj,jpk) )
       ENDIF
+      !
+      !
+      zavt_evd(:,:,:) = p_avt(:,:,:)         ! set avt prior to evd application
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+         zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk)         ! set avt prior to evd application
+      END_3D
+      !
       SELECT CASE ( nn_evdm )
 …
       CASE ( 1 )           !==  enhance tracer & momentum Kz  ==!   (if rn2<-1.e-12)
+         !
+         zavm_evd(:,:,:) = p_avm(:,:,:)      ! set avm prior to evd application
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+            zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk)      ! set avm prior to evd application
+         END_3D
+         !
 !! change last digits results
 …
 !         END WHERE
+         !
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
                p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
 …
          END_3D
+         !
+         zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd
+         CALL iom_put( "avm_evd", zavm_evd )                ! output this change
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+            zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk) - zavm_evd(ji,jj,jk)   ! change in avm due to evd
+         END_3D
+         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+            CALL iom_put( "avm_evd", zavm_evd )                ! output this change
+            DEALLOCATE( zavm_evd )
+         ENDIF
+         !
       CASE DEFAULT         !==  enhance tracer Kz  ==!   (if rn2<-1.e-12)
 …
 !         END WHERE
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
                p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
 …
       END SELECT
+      !
+      zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd
+      CALL iom_put( "avt_evd", zavt_evd )              ! output this change
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+         zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk) - zavt_evd(ji,jj,jk)   ! change in avt due to evd
+      END_3D
+      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+         CALL iom_put( "avt_evd", zavt_evd )              ! output this change
+         DEALLOCATE( zavt_evd )
+      ENDIF
       IF( l_trdtra ) CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_evd, zavt_evd )
+      !

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfgls.F90

-                      r14156
+                      r14958
       USE zdf_oce , ONLY : en, avtb, avmb   ! ocean vertical physics
       !!
       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step
       INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
+      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time step
+      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term
+      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
+      !
       INTEGER  ::   ji, jj, jk    ! dummy loop arguments
 …
       REAL(wp) ::   gh, gm, shr, dif, zsqen, zavt, zavm !   -      -
       REAL(wp) ::   zmsku, zmskv                        !   -      -
       REAL(wp), DIMENSION(jpi,jpj)     ::   zdep
       REAL(wp), DIMENSION(jpi,jpj)     ::   zkar
       REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves
       REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro       ! Surface roughness (surface waves)
       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra    ! Tapering of wave breaking under sea ice
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eb          ! tke at time before
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hmxl_b      ! mixing length at time before
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eps         ! dissipation rate
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi)
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   psi         ! psi at time now
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zd_lw, zd_up, zdiag   ! lower, upper  and diagonal of the matrix
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zstt, zstm  ! stability function on tracer and momentum
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zdep
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zkar
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zflxs                 ! Turbulence fluxed induced by internal waves
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zhsro                 ! Surface roughness (surface waves)
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zice_fra              ! Tapering of wave breaking under sea ice
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   eb                    ! tke at time before
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   hmxl_b                ! mixing length at time before
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   eps                   ! dissipation rate
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwall_psi             ! Wall function use in the wb case (ln_sigpsi)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   psi                   ! psi at time now
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zd_lw, zd_up, zdiag   ! lower, upper  and diagonal of the matrix
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zstt, zstm            ! stability function on tracer and momentum
       !!--------------------------------------------------------------------
+      !
       ! Preliminary computing
+      ustar2_surf(:,:) = 0._wp   ;         psi(:,:,:) = 0._wp
+      ustar2_top (:,:) = 0._wp   ;   zwall_psi(:,:,:) = 0._wp
+      ustar2_bot (:,:) = 0._wp
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         ustar2_surf(ji,jj) = 0._wp   ;   ustar2_top(ji,jj) = 0._wp   ;   ustar2_bot(ji,jj) = 0._wp
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+         psi(ji,jj,jk) = 0._wp   ;   zwall_psi(ji,jj,jk) = 0._wp
+      END_3D
       SELECT CASE ( nn_z0_ice )
       CASE( 0 )   ;   zice_fra(:,:) = 0._wp
       CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp )
       CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:)
       CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp )
+      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(A2D(nn_hls)) * 10._wp )
+      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(A2D(nn_hls))
+      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp )
       END SELECT
       ! Compute surface, top and bottom friction at T-points
       DO_2D( 0, 0, 0, 0 )          !==  surface ocean friction
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          !==  surface ocean friction
          ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1)   ! surface friction
       END_2D
 …
+      !
       IF( .NOT.ln_drg_OFF ) THEN     !== top/bottom friction   (explicit before friction)
          DO_2D( 0, 0, 0, 0 )         ! bottom friction (explicit before friction)
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          ! bottom friction (explicit before friction)
             zmsku = 0.5_wp * ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
             zmskv = 0.5_wp * ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0)
 …
          END_2D
          IF( ln_isfcav ) THEN
             DO_2D( 0, 0, 0, 0 )      ! top friction
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )      ! top friction
                zmsku = 0.5_wp * ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
                zmskv = 0.5_wp * ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0)
 …
          zhsro(:,:) = rn_hsro
       CASE ( 1 )             ! Standard Charnock formula
+         zhsro(:,:) = MAX( rsbc_zs1 * ustar2_surf(:,:) , rn_hsro )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            zhsro(ji,jj) = MAX( rsbc_zs1 * ustar2_surf(ji,jj) , rn_hsro )
+         END_2D
       CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008)
 !!gm faster coding : the 2 comment lines should be used
 !!gm         zcof = 2._wp * 0.6_wp / 28._wp
 !!gm         zdep(:,:)  = 30._wp * TANH(  zcof/ SQRT( MAX(ustar2_surf(:,:),rsmall) )  )       ! Wave age (eq. 10)
+         zdep (:,:) = 30.*TANH( 2.*0.3/(28.*SQRT(MAX(ustar2_surf(:,:),rsmall))) )         ! Wave age (eq. 10)
+         zhsro(:,:) = MAX(rsbc_zs2 * ustar2_surf(:,:) * zdep(:,:)**1.5, rn_hsro)          ! zhsro = rn_frac_hs * Hsw (eq. 11)
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            zcof = 30.*TANH( 2.*0.3/(28.*SQRT(MAX(ustar2_surf(ji,jj),rsmall))) )          ! Wave age (eq. 10)
+            zhsro(ji,jj) = MAX(rsbc_zs2 * ustar2_surf(ji,jj) * zcof**1.5, rn_hsro)        ! zhsro = rn_frac_hs * Hsw (eq. 11)
+         END_2D
       CASE ( 3 )             ! Roughness given by the wave model (coupled or read in file)
          zhsro(:,:) = MAX(rn_frac_hs * hsw(:,:), rn_hsro)   ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 )
+         zhsro(:,:) = MAX(rn_frac_hs * hsw(A2D(nn_hls)), rn_hsro)   ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 )
       END SELECT
+      !
       ! adapt roughness where there is sea ice
+      zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1)  + (1._wp - tmask(:,:,1))*rn_hsro
+      !
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )  !==  Compute dissipation rate  ==!
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * rn_hsri )*tmask(ji,jj,1)  + &
+            &           (1._wp - tmask(ji,jj,1))*rn_hsro
+      END_2D
+      !
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  !==  Compute dissipation rate  ==!
          eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk)
       END_3D
       ! Save tke at before time step
+      eb    (:,:,:) = en    (:,:,:)
+      hmxl_b(:,:,:) = hmxl_n(:,:,:)
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+         eb    (ji,jj,jk) = en    (ji,jj,jk)
+         hmxl_b(ji,jj,jk) = hmxl_n(ji,jj,jk)
+      END_3D
       IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             zup   = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)
             zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) )
 …
       ! Warning : after this step, en : right hand side of the matrix
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+         !
          buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction
 …
+      !
       CASE ( 0 )             ! Dirichlet boundary condition (set e at k=1 & 2)
+      ! First level
+      en   (:,:,1) = MAX(  rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3  )
+      zd_lw(:,:,1) = en(:,:,1)
+      zd_up(:,:,1) = 0._wp
+      zdiag(:,:,1) = 1._wp
+      !
+      ! One level below
+      en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm)) &
+         &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp) , rn_emin   )
+      zd_lw(:,:,2) = 0._wp
+      zd_up(:,:,2) = 0._wp
+      zdiag(:,:,2) = 1._wp
+      !
+      !
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! First level
+            en   (ji,jj,1) = MAX(  rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3  )
+            zd_lw(ji,jj,1) = en(ji,jj,1)
+            zd_up(ji,jj,1) = 0._wp
+            zdiag(ji,jj,1) = 1._wp
+            !
+            ! One level below
+            en   (ji,jj,2) =  MAX( rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1          &
+               &                             * ((zhsro(ji,jj)+gdepw(ji,jj,2,Kmm)) / zhsro(ji,jj) )**(1.5_wp*ra_sf)  )**r2_3 )
+            zd_lw(ji,jj,2) = 0._wp
+            zd_up(ji,jj,2) = 0._wp
+            zdiag(ji,jj,2) = 1._wp
+         END_2D
+         !
+         !
       CASE ( 1 )             ! Neumann boundary condition (set d(e)/dz)
+      !
+      ! Dirichlet conditions at k=1
+      en   (:,:,1) = MAX(  rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 , rn_emin  )
+      zd_lw(:,:,1) = en(:,:,1)
+      zd_up(:,:,1) = 0._wp
+      zdiag(:,:,1) = 1._wp
+      !
+      ! at k=2, set de/dz=Fw
+      !cbr
+      DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo
+         zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag
+         zd_lw(ji,jj,2) = 0._wp
+      END_2D
+      zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) ))
+      zflxs(:,:)   = rsbc_tke2 * (1._wp-zice_fra(:,:)) * ustar2_surf(:,:)**1.5_wp * zkar(:,:) &
+          &                    * (  ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:)  )**(1.5_wp*ra_sf)
+         !
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! Dirichlet conditions at k=1
+            en   (ji,jj,1) = MAX(  rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3  )
+            zd_lw(ji,jj,1) = en(ji,jj,1)
+            zd_up(ji,jj,1) = 0._wp
+            zdiag(ji,jj,1) = 1._wp
+            !
+            ! at k=2, set de/dz=Fw
+            !cbr
+            ! zdiag zd_lw not defined/used on the halo
+            zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag
+            zd_lw(ji,jj,2) = 0._wp
+            !
+            zkar (ji,jj)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(ji,jj,1,Kmm)/zhsro(ji,jj)) ))
+            zflxs(ji,jj)   = rsbc_tke2 * (1._wp-zice_fra(ji,jj)) * ustar2_surf(ji,jj)**1.5_wp * zkar(ji,jj) &
+                &                    * (  ( zhsro(ji,jj)+gdept(ji,jj,1,Kmm) ) / zhsro(ji,jj)  )**(1.5_wp*ra_sf)
 !!gm why not   :                        * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf)
+      en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm)
+      !
+      !
+            en(ji,jj,2) = en(ji,jj,2) + zflxs(ji,jj) / e3w(ji,jj,2,Kmm)
+         END_2D
+         !
+         !
       END SELECT
 …
          !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin
          !                      ! Balance between the production and the dissipation terms
          DO_2D( 0, 0, 0, 0 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
 !!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ????
 !!   With thick deep ocean level thickness, this may be quite large, no ???
 …
          END_2D
+         !
+         ! NOTE: ctl_stop with ln_isfcav when using GLS
          IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
             DO_2D( 0, 0, 0, 0 )
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                itop   = mikt(ji,jj)       ! k   top w-point
                itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
 …
       CASE ( 1 )             ! Neumman boundary condition
+         !
          DO_2D( 0, 0, 0, 0 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
             ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
 …
             en   (ji,jj,ibot) = z_en
          END_2D
+         ! NOTE: ctl_stop with ln_isfcav when using GLS
          IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
             DO_2D( 0, 0, 0, 0 )
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                itop   = mikt(ji,jj)       ! k   top w-point
                itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
 …
       ! ----------------------------------------------------------
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
          zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
       END_3D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
          zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
       END_3D
       DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+      DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
          en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
       END_3D
       !                                            ! set the minimum value of tke
+      en(:,:,:) = MAX( en(:,:,:), rn_emin )
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin )
+      END_3D
       !!----------------------------------------!!
 …
+      !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk)
          END_3D
+         !
       CASE( 1 )               ! k-eps
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             psi(ji,jj,jk)  = eps(ji,jj,jk)
          END_3D
+         !
       CASE( 2 )               ! k-w
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) )
          END_3D
+         !
       CASE( 3 )               ! generic
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn
          END_3D
 …
       ! Warning : after this step, en : right hand side of the matrix
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+         !
          ! psi / k
 …
       CASE ( 0 )             ! Dirichlet boundary conditions
+         !
+         ! Surface value
+         zdep    (:,:)   = zhsro(:,:) * rl_sf ! Cosmetic
+         psi     (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+         zd_lw(:,:,1) = psi(:,:,1)
+         zd_up(:,:,1) = 0._wp
+         zdiag(:,:,1) = 1._wp
+         !
+         ! One level below
+         zkar    (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(:,:,2,Kmm)/zhsro(:,:) )))
+         zdep    (:,:)   = (zhsro(:,:) + gdepw(:,:,2,Kmm)) * zkar(:,:)
+         psi     (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+         zd_lw(:,:,2) = 0._wp
+         zd_up(:,:,2) = 0._wp
+         zdiag(:,:,2) = 1._wp
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! Surface value
+            zdep    (ji,jj)   = zhsro(ji,jj) * rl_sf ! Cosmetic
+            psi     (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1)
+            zd_lw(ji,jj,1) = psi(ji,jj,1)
+            zd_up(ji,jj,1) = 0._wp
+            zdiag(ji,jj,1) = 1._wp
+            !
+            ! One level below
+            zkar    (ji,jj)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(ji,jj,2,Kmm)/zhsro(ji,jj) )))
+            zdep    (ji,jj)   = (zhsro(ji,jj) + gdepw(ji,jj,2,Kmm)) * zkar(ji,jj)
+            psi     (ji,jj,2) = rc0**rpp * en(ji,jj,2)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1)
+            zd_lw(ji,jj,2) = 0._wp
+            zd_up(ji,jj,2) = 0._wp
+            zdiag(ji,jj,2) = 1._wp
+         END_2D
+         !
       CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz
+         !
          ! Surface value: Dirichlet
          zdep    (:,:)   = zhsro(:,:) * rl_sf
          psi     (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
          zd_lw(:,:,1) = psi(:,:,1)
          zd_up(:,:,1) = 0._wp
          zdiag(:,:,1) = 1._wp
+         !
          ! Neumann condition at k=2
          DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! Surface value: Dirichlet
+            zdep    (ji,jj)   = zhsro(ji,jj) * rl_sf
+            psi     (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1)
+            zd_lw(ji,jj,1) = psi(ji,jj,1)
+            zd_up(ji,jj,1) = 0._wp
+            zdiag(ji,jj,1) = 1._wp
+            !
+            ! Neumann condition at k=2, zdiag zd_lw not defined/used on the halo
             zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag
             zd_lw(ji,jj,2) = 0._wp
+            !
+            ! Set psi vertical flux at the surface:
+            zkar (ji,jj)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(ji,jj,1,Kmm)/zhsro(ji,jj) )) ! Lengh scale slope
+            zdep (ji,jj)   = ((zhsro(ji,jj) + gdept(ji,jj,1,Kmm)) / zhsro(ji,jj))**(rmm*ra_sf)
+            zflxs(ji,jj)   = (rnn + (1._wp-zice_fra(ji,jj))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(ji,jj)) &
+               &           *(1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1*zdep(ji,jj))**(2._wp*rmm/3._wp-1_wp)
+            zdep (ji,jj)   = rsbc_psi1 * (zwall_psi(ji,jj,1)*p_avm(ji,jj,1)+zwall_psi(ji,jj,2)*p_avm(ji,jj,2)) * &
+               &           ustar2_surf(ji,jj)**rmm * zkar(ji,jj)**rnn * (zhsro(ji,jj) + gdept(ji,jj,1,Kmm))**(rnn-1.)
+            zflxs(ji,jj)   = zdep(ji,jj) * zflxs(ji,jj)
+            psi  (ji,jj,2) = psi(ji,jj,2) + zflxs(ji,jj) / e3w(ji,jj,2,Kmm)
          END_2D
+         !
-         ! Set psi vertical flux at the surface:
-         zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope
-         zdep (:,:)   = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf)
-         zflxs(:,:)   = (rnn + (1._wp-zice_fra(:,:))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:)) &
-            &           *(1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
-         zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * &
-            &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.)
-         zflxs(:,:)   = zdep(:,:) * zflxs(:,:)
-         psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm)
+         !
       END SELECT
 …
          !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot
          !                      ! Balance between the production and the dissipation terms
          DO_2D( 0, 0, 0, 0 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
             ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
 …
       CASE ( 1 )             ! Neumman boundary condition
+         !
          DO_2D( 0, 0, 0, 0 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
             ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
 …
       ! ----------------
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
          zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
       END_3D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
          zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
       END_3D
       DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
          psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
       END_3D
 …
+      !
       CASE( 0 )               ! k-kl  (Mellor-Yamada)
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin)
          END_3D
+         !
       CASE( 1 )               ! k-eps
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             eps(ji,jj,jk) = psi(ji,jj,jk)
          END_3D
+         !
       CASE( 2 )               ! k-w
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk)
          END_3D
 …
          zex1  =      ( 1.5_wp + rmm/rnn )
          zex2  = -1._wp / rnn
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
          END_3D
 …
       ! Limit dissipation rate under stable stratification
       ! --------------------------------------------------
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time
          ! limitation
          eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
          hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
+         ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)
+         zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+         IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) )
+      END_3D
+      END_3D
+      IF( ln_length_lim ) THEN        ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+            zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+            hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) )
+         END_3D
+      ENDIF
+      !
 …
+      !
       CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             ! zcof =  l²/q²
             zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
 …
+         !
       CASE ( 2, 3 )               ! Canuto stability functions
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             ! zcof =  l²/q²
             zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
 …
       ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0)
       zstm(:,:,jpk) = 0.
       DO_2D( 0, 0, 0, 0 )             ! update bottom with good values
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! update bottom with good values
          zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj))
       END_2D
       zstt(:,:,  1) = wmask(:,:,  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
       zstt(:,:,jpk) = wmask(:,:,jpk)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
+      zstt(:,:,  1) = wmask(A2D(nn_hls),  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
+      zstt(:,:,jpk) = wmask(A2D(nn_hls),jpk)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
 !!gm should be done for ISF (top boundary cond.)
 …
       !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk)
       !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0)
       DO_3D( 0, 0, 0, 0, 1, jpk )
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
          zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk)
          zavt  = zsqen * zstt(ji,jj,jk)
 …
          p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom
       END_3D
       p_avt(:,:,1) = 0._wp
+      p_avt(A2D(nn_hls),1) = 0._wp
+      !
       IF(sn_cfctl%l_prtctl) THEN

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfiwm.F90

-                      r13497
+                      r14958
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zztmp, ztmp1, ztmp2        ! scalar workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zfact       ! Used for vertical structure
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zhdep       ! Ocean depth
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwkb        ! WKB-stretched height above bottom
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zweight     ! Weight for high mode vertical distribution
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid)
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid)
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zReb        ! Turbulence intensity parameter
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg)
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T)
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_wave    ! Internal wave-induced diffusivity
+      REAL(wp), SAVE :: zztmp
+      REAL(wp)       :: ztmp1, ztmp2        ! scalar workspace
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zfact       ! Used for vertical structure
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zhdep       ! Ocean depth
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwkb        ! WKB-stretched height above bottom
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zweight     ! Weight for high mode vertical distribution
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zReb        ! Turbulence intensity parameter
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_wave    ! Internal wave-induced diffusivity
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   z3d  ! 3D workspace used for iom_put
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   z2d  ! 2D     -      -    -     -
 …
       ! Set to zero the 1st and last vertical levels of appropriate variables
       IF( iom_use("emix_iwm") ) THEN
+         DO_2D( 0, 0, 0, 0 )
+            zemx_iwm (ji,jj,1) = 0._wp   ;   zemx_iwm (ji,jj,jpk) = 0._wp
+         END_2D
+         zemx_iwm(:,:,:) = 0._wp
       ENDIF
       IF( iom_use("av_ratio") ) THEN
+         DO_2D( 0, 0, 0, 0 )
+            zav_ratio(ji,jj,1) = 0._wp   ;   zav_ratio(ji,jj,jpk) = 0._wp
+         END_2D
+         zav_ratio(:,:,:) = 0._wp
       ENDIF
       IF( iom_use("av_wave") .OR. sn_cfctl%l_prtctl ) THEN
+         DO_2D( 0, 0, 0, 0 )
+            zav_wave (ji,jj,1) = 0._wp   ;   zav_wave (ji,jj,jpk) = 0._wp
+         END_2D
+         zav_wave(:,:,:) = 0._wp
       ENDIF
+      !
 …
       !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth,
       !                                                 using an exponential decay from the seafloor.
       DO_2D( 0, 0, 0, 0 )             ! part independent of the level
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! part independent of the level
          zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
          zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  )
 …
       END_2D
 !!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm)
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! complete with the level-dependent part
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! complete with the level-dependent part
          IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization
             zemx_iwm(ji,jj,jk) = 0._wp
 …
       CASE ( 1 )               ! Dissipation scales as N (recommended)
+         !
          DO_2D( 0, 0, 0, 0 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             zfact(ji,jj) = 0._wp
          END_2D
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level
             zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk)
          END_3D
+         !
          DO_2D( 0, 0, 0, 0 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) )
          END_2D
+         !
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part
             zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk)
          END_3D
 …
       CASE ( 2 )               ! Dissipation scales as N^2
+         !
          DO_2D( 0, 0, 0, 0 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             zfact(ji,jj) = 0._wp
          END_2D
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level
             zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk)
          END_3D
+         !
          DO_2D( 0, 0, 0, 0 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) )
          END_2D
+         !
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk)
          END_3D
 …
       !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot)
+      !
       DO_2D( 0, 0, 0, 0 )
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          zwkb(ji,jj,1) = 0._wp
       END_2D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk)
       END_3D
       DO_2D( 0, 0, 0, 0 )
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          zfact(ji,jj) = zwkb(ji,jj,jpkm1)
       END_2D
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   &
             &                                     * wmask(ji,jj,jk) / zfact(ji,jj)
       END_3D
       DO_2D( 0, 0, 0, 0 )
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1)
       END_2D
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization: EXP coast a lot
             zweight(ji,jj,jk) = 0._wp
 …
       END_3D
+      !
       DO_2D( 0, 0, 0, 0 )
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          zfact(ji,jj) = 0._wp
       END_2D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level
          zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk)
       END_3D
+      !
       DO_2D( 0, 0, 0, 0 )
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) )
       END_2D
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part
          zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk)   &
             &                                                        / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) )
 …
 !!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s
       ! Calculate molecular kinematic viscosity
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
          znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm)   &
             &                                     + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)  &
             &                                     + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm)  ) * tmask(ji,jj,jk) * r1_rho0
       END_3D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk)
       END_3D
 …
+      !
       ! Calculate turbulence intensity parameter Reb
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) )
       END_3D
+      !
       ! Define internal wave-induced diffusivity
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6
       END_3D
+      !
       IF( ln_mevar ) THEN                ! Variable mixing efficiency case : modify zav_wave in the
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes
             IF( zReb(ji,jj,jk) > 480.00_wp ) THEN
                zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
 …
       ENDIF
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s
          zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk)
       END_3D
+      !
       IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave
          zztmp = 0._wp
+         IF( .NOT. l_istiled .OR. ntile == 1 ) zztmp = 0._wp                    ! Do only on the first tile
 !!gm used of glosum 3D....
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
 …
                &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
          END_3D
+         CALL mpp_sum( 'zdfiwm', zztmp )
+         zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing
+         !
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)'
+            WRITE(numout,*) '~~~~~~~ '
+            WRITE(numout,*)
+            WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW'
+         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+            CALL mpp_sum( 'zdfiwm', zztmp )
+            zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing
+            !
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)'
+               WRITE(numout,*) '~~~~~~~ '
+               WRITE(numout,*)
+               WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW'
+            ENDIF
          ENDIF
       ENDIF
 …
       IF( ln_tsdiff ) THEN                !* Option for differential mixing of salinity and temperature
          ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) )
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb
             ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6
             IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN
 …
          END_3D
          CALL iom_put( "av_ratio", zav_ratio )
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing
             p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk)
             p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk)
 …
+         !
       ELSE                                !* update momentum & tracer diffusivity with wave-driven mixing
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk)
             p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk)
 …
                                           !  vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm)
       IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN
          ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) )
+         ALLOCATE( z2d(A2D(nn_hls)) , z3d(A2D(nn_hls),jpk) )
          ! Initialisation for iom_put
+         DO_2D( 0, 0, 0, 0 )
+            z3d(ji,jj,1) = 0._wp   ;   z3d(ji,jj,jpk) = 0._wp
+         END_2D
+         z3d(           1:nn_hls,:,:) = 0._wp   ;   z3d(:,           1:nn_hls,:) = 0._wp
+         z3d(jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   z3d(:,jpj-nn_hls+1:   jpj,:) = 0._wp
+         z2d(           1:nn_hls,:  ) = 0._wp   ;   z2d(:,           1:nn_hls  ) = 0._wp
+         z2d(jpi-nn_hls+1:jpi   ,:  ) = 0._wp   ;   z2d(:,jpj-nn_hls+1:   jpj  ) = 0._wp
+         z2d(:,:) = 0._wp ; z3d(:,:,:) = 0._wp
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
             z3d(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk)
-         END_3D
-         DO_2D( 0, 0, 0, 0 )
-            z2d(ji,jj) = 0._wp
-         END_2D
-         DO_3D( 0, 0, 0, 0, 2, jpkm1 )
             z2d(ji,jj) = z2d(ji,jj) + e3w(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * wmask(ji,jj,jk)
          END_3D

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfmfc.F90

-                      r14433
+                      r14958
       INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation
       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztsp         ! T/S of the plume
       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztse         ! T/S at W point
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrwp          !
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrwp2         !
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zapp          !
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zedmf         !
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zepsT, zepsW  !
+      !
       REAL(wp), DIMENSION(jpi,jpj) :: zustar, zustar2   !
       REAL(wp), DIMENSION(jpi,jpj) :: zuws, zvws, zsws, zfnet          !
       REAL(wp), DIMENSION(jpi,jpj) :: zfbuo, zrautbm1, zrautb, zraupl
       REAL(wp), DIMENSION(jpi,jpj) :: zwpsurf            !
       REAL(wp), DIMENSION(jpi,jpj) :: zop0 , zsp0 !
       REAL(wp), DIMENSION(jpi,jpj) :: zrwp_0, zrwp2_0  !
       REAL(wp), DIMENSION(jpi,jpj) :: zapp0           !
       REAL(wp), DIMENSION(jpi,jpj) :: zphp, zph, zphpm1, zphm1, zNHydro
       REAL(wp), DIMENSION(jpi,jpj) :: zhcmo          !
+      !
       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zn2    ! N^2
       REAL(wp), DIMENSION(jpi,jpj,2  ) ::   zab, zabm1, zabp ! alpha and beta
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   ztsp         ! T/S of the plume
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   ztse         ! T/S at W point
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp          !
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp2         !
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zapp          !
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zedmf         !
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zepsT, zepsW  !
+      !
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zustar, zustar2   !
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zuws, zvws, zsws, zfnet          !
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zfbuo, zrautbm1, zrautb, zraupl
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zwpsurf            !
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zop0 , zsp0 !
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zrwp_0, zrwp2_0  !
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zapp0           !
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zphp, zph, zphpm1, zphm1, zNHydro
+      REAL(wp), DIMENSION(A2D(nn_hls)) :: zhcmo          !
+      !
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk)   ::   zn2    ! N^2
+      REAL(wp), DIMENSION(A2D(nn_hls),2  ) ::   zab, zabm1, zabp ! alpha and beta
       REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value
 …
       zcd          = 1._wp
+      !------------------------------------------------------------------
+      ! Surface boundary condition
+      !------------------------------------------------------------------
+      ! surface Stress
+      !--------------------
+      zuws(:,:) = utau(:,:) * r1_rho0
+      zvws(:,:) = vtau(:,:) * r1_rho0
+      zustar2(:,:) = SQRT(zuws(:,:)*zuws(:,:)+zvws(:,:)*zvws(:,:))
+      zustar(:,:)  = SQRT(zustar2(:,:))
+      ! Heat Flux
+      !--------------------
+      zfnet(:,:) = qns(:,:) + qsr(:,:)
+      zfnet(:,:) = zfnet(:,:) / (rho0 * rcp)
+      ! Water Flux
+      !---------------------
+      zsws(:,:) = emp(:,:)
+      !-------------------------------------------
+      ! Initialisation of prognostic variables
+      !-------------------------------------------
+      zrwp (:,:,:) =  0._wp ; zrwp2(:,:,:) =  0._wp ; zedmf(:,:,:) =  0._wp
+      zph  (:,:)   =  0._wp ; zphm1(:,:)   =  0._wp ; zphpm1(:,:)  =  0._wp
+      ztsp(:,:,:,:)=  0._wp
+      ! Tracers inside plume (ztsp) and environment (ztse)
+      ztsp(:,:,1,jp_tem) = pts(:,:,1,jp_tem,Kmm) * tmask(:,:,1)
+      ztsp(:,:,1,jp_sal) = pts(:,:,1,jp_sal,Kmm) * tmask(:,:,1)
+      ztse(:,:,1,jp_tem) = pts(:,:,1,jp_tem,Kmm) * tmask(:,:,1)
+      ztse(:,:,1,jp_sal) = pts(:,:,1,jp_sal,Kmm) * tmask(:,:,1)
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         !------------------------------------------------------------------
+         ! Surface boundary condition
+         !------------------------------------------------------------------
+         ! surface Stress
+         !--------------------
+         zuws(ji,jj) = utau(ji,jj) * r1_rho0
+         zvws(ji,jj) = vtau(ji,jj) * r1_rho0
+         zustar2(ji,jj) = SQRT(zuws(ji,jj)*zuws(ji,jj)+zvws(ji,jj)*zvws(ji,jj))
+         zustar(ji,jj)  = SQRT(zustar2(ji,jj))
+         ! Heat Flux
+         !--------------------
+         zfnet(ji,jj) = qns(ji,jj) + qsr(ji,jj)
+         zfnet(ji,jj) = zfnet(ji,jj) / (rho0 * rcp)
+         ! Water Flux
+         !---------------------
+         zsws(ji,jj) = emp(ji,jj)
+         !-------------------------------------------
+         ! Initialisation of prognostic variables
+         !-------------------------------------------
+         zrwp (ji,jj,:) =  0._wp ; zrwp2(ji,jj,:) =  0._wp ; zedmf(ji,jj,:) =  0._wp
+         zph  (ji,jj)   =  0._wp ; zphm1(ji,jj)   =  0._wp ; zphpm1(ji,jj)  =  0._wp
+         ztsp(ji,jj,:,:)=  0._wp
+         ! Tracers inside plume (ztsp) and environment (ztse)
+         ztsp(ji,jj,1,jp_tem) = pts(ji,jj,1,jp_tem,Kmm) * tmask(ji,jj,1)
+         ztsp(ji,jj,1,jp_sal) = pts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1)
+         ztse(ji,jj,1,jp_tem) = pts(ji,jj,1,jp_tem,Kmm) * tmask(ji,jj,1)
+         ztse(ji,jj,1,jp_sal) = pts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1)
+      END_2D
       CALL eos( ztse(:,:,1,:) ,  zrautb(:,:) )
 …
       ! Boundary Condition of Mass Flux (plume velo.; convective area, entrain/detrain)
       !-------------------------------------------
       zhcmo(:,:) = e3t(:,:,1,Kmm)
+      zhcmo(:,:) = e3t(A1Di(nn_hls),A1Dj(nn_hls),1,Kmm)
       zfbuo(:,:)   = 0._wp
       WHERE ( ABS(zrautb(:,:)) > 1.e-20 ) zfbuo(:,:)   =   &
+         &      grav * ( 2.e-4_wp *zfnet(:,:) - 7.6E-4_wp*pts(:,:,1,jp_sal,Kmm)*zsws(:,:)/zrautb(:,:)) * zhcmo(:,:)
+         &      grav * ( 2.e-4_wp *zfnet(:,:)              &
+         &      - 7.6E-4_wp*pts(A2D(nn_hls),1,jp_sal,Kmm)  &
+         &      * zsws(:,:)/zrautb(:,:)) * zhcmo(:,:)
       zedmf(:,:,1) = -0.065_wp*(ABS(zfbuo(:,:)))**(1._wp/3._wp)*SIGN(1.,zfbuo(:,:))
 …
          CALL eos( ztsp(:,:,jk-1,:    ) ,  zraupl(:,:)   )
+         zphm1(:,:)  = zphm1(:,:)  + grav * zrautbm1(:,:) * e3t(:,:,jk-1, Kmm)
+         zphpm1(:,:) = zphpm1(:,:) + grav * zraupl(:,:)   * e3t(:,:,jk-1, Kmm)
+         zph(:,:)    = zphm1(:,:)  + grav * zrautb(:,:)   * e3t(:,:,jk  , Kmm)
+         zph(:,:)    = MAX( zph(:,:), zepsilon)
+         DO_2D( 0, 0, 0, 0 )
+            zphm1(ji,jj)  = zphm1(ji,jj)  + grav * zrautbm1(ji,jj) * e3t(ji,jj,jk-1, Kmm)
+            zphpm1(ji,jj) = zphpm1(ji,jj) + grav * zraupl(ji,jj)   * e3t(ji,jj,jk-1, Kmm)
+            zph(ji,jj)    = zphm1(ji,jj)  + grav * zrautb(ji,jj)   * e3t(ji,jj,jk  , Kmm)
+            zph(ji,jj)    = MAX( zph(ji,jj), zepsilon)
+         END_2D
          WHERE(zrautbm1 .NE. 0.) zfbuo(:,:)  =  grav * (zraupl(:,:) - zrautbm1(:,:)) / zrautbm1(:,:)
 …
       ! Compute Mass Flux on T-point
+      DO jk=1,jpk-1
+         edmfm(:,:,jk) = (zedmf(:,:,jk+1)  + zedmf(:,:,jk) )*0.5_wp
+      END DO
+      edmfm(:,:,jpk) = zedmf(:,:,jpk)
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         edmfm(ji,jj,jk) = (zedmf(ji,jj,jk+1)  + zedmf(ji,jj,jk) )*0.5_wp
+      END_3D
+      DO_2D( 0, 0, 0, 0 )
+         edmfm(ji,jj,jpk) = zedmf(ji,jj,jpk)
+      END_2D
       ! Save variable (on T point)
 …
       !  Computation of a tridiagonal matrix and right hand side terms of the linear system
       !=================================================================================
+      edmfa(:,:,:)     = 0._wp
+      edmfb(:,:,:)     = 0._wp
+      edmfc(:,:,:)     = 0._wp
+      edmftra(:,:,:,:) = 0._wp
+      DO_3D( 0, 0, 0, 0, 1, jpk )
+         edmfa(ji,jj,jk)     = 0._wp
+         edmfb(ji,jj,jk)     = 0._wp
+         edmfc(ji,jj,jk)     = 0._wp
+         edmftra(ji,jj,jk,:) = 0._wp
+      END_3D
       !---------------------------------------------------------------
       ! Diagonal terms
       !---------------------------------------------------------------
+      DO jk=1,jpk-1
+         edmfa(:,:,jk) =  0._wp
+         edmfb(:,:,jk) = -edmfm(:,:,jk  ) / e3w(:,:,jk+1,Kmm)
+         edmfc(:,:,jk) =  edmfm(:,:,jk+1) / e3w(:,:,jk+1,Kmm)
+      END DO
+      edmfa(:,:,jpk)   = -edmfm(:,:,jpk-1) / e3w(:,:,jpk,Kmm)
+      edmfb(:,:,jpk)   =  edmfm(:,:,jpk  ) / e3w(:,:,jpk,Kmm)
+      edmfc(:,:,jpk)   =  0._wp
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         edmfa(ji,jj,jk) =  0._wp
+         edmfb(ji,jj,jk) = -edmfm(ji,jj,jk  ) / e3w(ji,jj,jk+1,Kmm)
+         edmfc(ji,jj,jk) =  edmfm(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
+      END_3D
+      DO_2D( 0, 0, 0, 0 )
+         edmfa(ji,jj,jpk)   = -edmfm(ji,jj,jpk-1) / e3w(ji,jj,jpk,Kmm)
+         edmfb(ji,jj,jpk)   =  edmfm(ji,jj,jpk  ) / e3w(ji,jj,jpk,Kmm)
+         edmfc(ji,jj,jpk)   =  0._wp
+      END_2D
       !---------------------------------------------------------------
       ! right hand side term for Temperature
       !---------------------------------------------------------------
+      DO jk=1,jpk-1
+        edmftra(:,:,jk,1) = - edmfm(:,:,jk  ) * ztsp(:,:,jk  ,jp_tem) / e3w(:,:,jk+1,Kmm) &
+                          & + edmfm(:,:,jk+1) * ztsp(:,:,jk+1,jp_tem) / e3w(:,:,jk+1,Kmm)
+      END DO
+      edmftra(:,:,jpk,1) = - edmfm(:,:,jpk-1) * ztsp(:,:,jpk-1,jp_tem) / e3w(:,:,jpk,Kmm) &
+                         & + edmfm(:,:,jpk  ) * ztsp(:,:,jpk  ,jp_tem) / e3w(:,:,jpk,Kmm)
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+        edmftra(ji,jj,jk,1) = - edmfm(ji,jj,jk  ) * ztsp(ji,jj,jk  ,jp_tem) / e3w(ji,jj,jk+1,Kmm) &
+                            & + edmfm(ji,jj,jk+1) * ztsp(ji,jj,jk+1,jp_tem) / e3w(ji,jj,jk+1,Kmm)
+      END_3D
+      DO_2D( 0, 0, 0, 0 )
+         edmftra(ji,jj,jpk,1) = - edmfm(ji,jj,jpk-1) * ztsp(ji,jj,jpk-1,jp_tem) / e3w(ji,jj,jpk,Kmm) &
+                              & + edmfm(ji,jj,jpk  ) * ztsp(ji,jj,jpk  ,jp_tem) / e3w(ji,jj,jpk,Kmm)
+      END_2D
       !---------------------------------------------------------------
       ! Right hand side term for Salinity
       !---------------------------------------------------------------
+      DO jk=1,jpk-1
+         edmftra(:,:,jk,2) =  - edmfm(:,:,jk  ) * ztsp(:,:,jk  ,jp_sal) / e3w(:,:,jk+1,Kmm) &
+                           &  + edmfm(:,:,jk+1) * ztsp(:,:,jk+1,jp_sal) / e3w(:,:,jk+1,Kmm)
+      END DO
+      edmftra(:,:,jpk,2) = - edmfm(:,:,jpk-1) * ztsp(:,:,jpk-1,jp_sal) / e3w(:,:,jpk,Kmm) &
+                         & + edmfm(:,:,jpk  ) * ztsp(:,:,jpk  ,jp_sal) / e3w(:,:,jpk,Kmm)
+      !
+      !
+      CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.)
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         edmftra(ji,jj,jk,2) =  - edmfm(ji,jj,jk  ) * ztsp(ji,jj,jk  ,jp_sal) / e3w(ji,jj,jk+1,Kmm) &
+                             &  + edmfm(ji,jj,jk+1) * ztsp(ji,jj,jk+1,jp_sal) / e3w(ji,jj,jk+1,Kmm)
+      END_3D
+      DO_2D( 0, 0, 0, 0 )
+         edmftra(ji,jj,jpk,2) = - edmfm(ji,jj,jpk-1) * ztsp(ji,jj,jpk-1,jp_sal) / e3w(ji,jj,jpk,Kmm) &
+                              & + edmfm(ji,jj,jpk  ) * ztsp(ji,jj,jpk  ,jp_sal) / e3w(ji,jj,jpk,Kmm)
+      END_2D
+      !
    END SUBROUTINE tra_mfc
 …
    SUBROUTINE diag_mfc( zdiagi, zdiagd, zdiags, p2dt, Kaa )
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms
       REAL(wp)                        , INTENT(in   ) ::   p2dt                   ! tracer time-step
       INTEGER                         , INTENT(in   ) ::   Kaa                    ! ocean time level indices
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms
+      REAL(wp)                            , INTENT(in   ) ::   p2dt                   ! tracer time-step
+      INTEGER                             , INTENT(in   ) ::   Kaa                    ! ocean time level indices
       INTEGER  ::   ji, jj, jk  ! dummy  loop arguments

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfmxl.F90

-                      r13497
+                      r14958
    PRIVATE
    PUBLIC   zdf_mxl   ! called by zdfphy.F90
+   PUBLIC   zdf_mxl, zdf_mxl_turb   ! called by zdfphy.F90
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by LDF, ZDF, TRD, TOP)
 …
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
    !! $Id$
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 …
       !!                  ***  ROUTINE zdfmxl  ***
       !!
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!              with density criteria.
+      !! ** Purpose :   Compute 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) + rho_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 by default)
       !!
       !! ** Action  :   nmln, hmld, hmlp, hmlpt
+      !! ** Action  :   nmln, hmlp, hmlpt
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
 …
+      !
       INTEGER  ::   ji, jj, jk      ! dummy loop indices
       INTEGER  ::   iikn, iiki, ikt ! local integer
+      INTEGER  ::   iik, ikt        ! local integer
       REAL(wp) ::   zN2_c           ! local scalar
-      INTEGER, DIMENSION(jpi,jpj) ::   imld   ! 2D workspace
       !!----------------------------------------------------------------------
+      !
+      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' )
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         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
       ENDIF
+      !
       ! w-level of the mixing and mixed layers
+      nmln(:,:)  = nlb10                  ! Initialization to the number of w ocean point
+      hmlp(:,:)  = 0._wp                  ! here hmlp used as a dummy variable, integrating vertically N^2
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+         nmln(ji,jj)  = nlb10                  ! Initialization to the number of w ocean point
+         hmlp(ji,jj)  = 0._wp                  ! here hmlp used as a dummy variable, integrating vertically N^2
+      END_2D
       zN2_c = grav * rho_c * r1_rho0      ! convert density criteria into N^2 criteria
       DO_3D( 1, 1, 1, 1, nlb10, jpkm1 )   ! Mixed layer level: w-level
+      DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 )   ! Mixed layer level: w-level
          ikt = mbkt(ji,jj)
          hmlp(ji,jj) =   &
 …
          IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
       END_3D
+      !
+      ! w-level of the turbocline and mixing layer (iom_use)
+      imld(:,:) = mbkt(:,:) + 1                ! Initialization to the number of w ocean point
+      DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10
+         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline
+      END_3D
+      ! depth of the mixing and mixed layers
+      DO_2D( 1, 1, 1, 1 )
+         iiki = imld(ji,jj)
+         iikn = nmln(ji,jj)
+         hmld (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth
+         hmlp (ji,jj) = gdepw(ji,jj,iikn  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth
+         hmlpt(ji,jj) = gdept(ji,jj,iikn-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
+      ! depth of the mixed layer
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+         iik = nmln(ji,jj)
+         hmlp (ji,jj) = gdepw(ji,jj,iik  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth
+         hmlpt(ji,jj) = gdept(ji,jj,iik-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
       END_2D
+      !
+      IF( .NOT.l_offline ) THEN
+         IF( iom_use("mldr10_1") ) THEN
+            IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness
+            ELSE                  ;  CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth
+            END IF
+      IF( .NOT.l_offline .AND. iom_use("mldr10_1") ) THEN
+         IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness
+         ELSE                  ;  CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth
          END IF
-         IF( iom_use("mldkz5") ) THEN
-            IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness
-            ELSE                  ;  CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth
-            END IF
-         ENDIF
       ENDIF
+      !
 …
    END SUBROUTINE zdf_mxl
+   SUBROUTINE zdf_mxl_turb( kt, Kmm )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_mxl_turb  ***
+      !!
+      !! ** Purpose :   Compute the turbocline depth.
+      !!
+      !! ** Method  :   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 by default)
+      !!
+      !! ** Action  :   hmld
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      INTEGER  ::   iik             ! local integer
+      INTEGER, DIMENSION(A2D(nn_hls)) ::   imld   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      ! w-level of the turbocline and mixing layer (iom_use)
+      imld(:,:) = mbkt(A2D(nn_hls)) + 1                ! Initialization to the number of w ocean point
+      DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10
+         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline
+      END_3D
+      ! depth of the mixing layer
+      DO_2D_OVR( 1, 1, 1, 1 )
+         iik = imld(ji,jj)
+         hmld (ji,jj) = gdepw(ji,jj,iik  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth
+      END_2D
+      !
+      IF( .NOT.l_offline .AND. iom_use("mldkz5") ) THEN
+         IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness
+         ELSE                  ;  CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth
+         END IF
+      ENDIF
+      !
+   END SUBROUTINE zdf_mxl_turb
    !!======================================================================
 END MODULE zdfmxl

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfosm.F90

-                      r14433
+                      r14958
    !! 16/05/2019 (19) Fox-Kemper parametrization of restratification through mixed layer eddies added to revised code.
    !! 23/05/19   (20) Old code where key_osmldpth1` is *not* set removed, together with the key key_osmldpth1
+   !!             4.2  !  2021-05  (S. Mueller)  Efficiency improvements, source-code clarity enhancements, and adaptation to tiling
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   'ln_zdfosm'                                             OSMOSIS scheme
+   !!   'ln_zdfosm'                                          OSMOSIS scheme
    !!----------------------------------------------------------------------
+   !!   zdf_osm       : update momentum and tracer Kz from osm scheme
+   !!   zdf_osm_init  : initialization, namelist read, and parameters control
+   !!   osm_rst       : read (or initialize) and write osmosis restart fields
+   !!   tra_osm       : compute and add to the T & S trend the non-local flux
+   !!   trc_osm       : compute and add to the passive tracer trend the non-local flux (TBD)
+   !!   dyn_osm       : compute and add to u & v trensd the non-local flux
+   !!
+   !! Subroutines in revised code.
+   !!   zdf_osm        : update momentum and tracer Kz from osm scheme
+   !!      zdf_osm_vertical_average             : compute vertical averages over boundary layers
+   !!      zdf_osm_velocity_rotation            : rotate velocity components
+   !!         zdf_osm_velocity_rotation_2d      :    rotation of 2d fields
+   !!         zdf_osm_velocity_rotation_3d      :    rotation of 3d fields
+   !!      zdf_osm_osbl_state                   : determine the state of the OSBL
+   !!      zdf_osm_external_gradients           : calculate gradients below the OSBL
+   !!      zdf_osm_calculate_dhdt               : calculate rate of change of hbl
+   !!      zdf_osm_timestep_hbl                 : hbl timestep
+   !!      zdf_osm_pycnocline_thickness         : calculate thickness of pycnocline
+   !!      zdf_osm_diffusivity_viscosity        : compute eddy diffusivity and viscosity profiles
+   !!      zdf_osm_fgr_terms                    : compute flux-gradient relationship terms
+   !!         zdf_osm_pycnocline_buoyancy_profiles : calculate pycnocline buoyancy profiles
+   !!      zdf_osm_zmld_horizontal_gradients    : calculate horizontal buoyancy gradients for use with Fox-Kemper parametrization
+   !!      zdf_osm_osbl_state_fk                : determine state of OSBL and MLE layers
+   !!      zdf_osm_mle_parameters               : timestep MLE depth and calculate MLE fluxes
+   !!   zdf_osm_init   : initialization, namelist read, and parameters control
+   !!      zdf_osm_alloc                        : memory allocation
+   !!   osm_rst        : read (or initialize) and write osmosis restart fields
+   !!   tra_osm        : compute and add to the T & S trend the non-local flux
+   !!   trc_osm        : compute and add to the passive tracer trend the non-local flux (TBD)
+   !!   dyn_osm        : compute and add to u & v trensd the non-local flux
+   !!   zdf_osm_iomput : iom_put wrapper that accepts arrays without halo
+   !!      zdf_osm_iomput_2d                    : iom_put wrapper for 2D fields
+   !!      zdf_osm_iomput_3d                    : iom_put wrapper for 3D fields
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and active tracers
                       ! uses ww from previous time step (which is now wb) to calculate hbl
    USE dom_oce        ! ocean space and time domain
    USE zdf_oce        ! ocean vertical physics
    USE sbc_oce        ! surface boundary condition: ocean
    USE sbcwave        ! surface wave parameters
    USE phycst         ! physical constants
    USE eosbn2         ! equation of state
    USE traqsr         ! details of solar radiation absorption
    USE zdfddm         ! double diffusion mixing (avs array)
    USE iom            ! I/O library
    USE lib_mpp        ! MPP library
    USE trd_oce        ! ocean trends definition
    USE trdtra         ! tracers trends
+   !
    USE in_out_manager ! I/O manager
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE prtctl         ! Print control
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE oce                       ! Ocean dynamics and active tracers
+   !                             ! Uses ww from previous time step (which is now wb) to calculate hbl
+   USE dom_oce                   ! Ocean space and time domain
+   USE zdf_oce                   ! Ocean vertical physics
+   USE sbc_oce                   ! Surface boundary condition: ocean
+   USE sbcwave                   ! Surface wave parameters
+   USE phycst                    ! Physical constants
+   USE eosbn2                    ! Equation of state
+   USE traqsr                    ! Details of solar radiation absorption
+   USE zdfdrg, ONLY : rCdU_bot   ! Bottom friction velocity
+   USE zdfddm                    ! Double diffusion mixing (avs array)
+   USE iom                       ! I/O library
+   USE lib_mpp                   ! MPP library
+   USE trd_oce                   ! Ocean trends definition
+   USE trdtra                    ! Tracers trends
+   USE in_out_manager            ! I/O manager
+   USE lbclnk                    ! Ocean lateral boundary conditions (or mpp link)
+   USE prtctl                    ! Print control
+   USE lib_fortran               ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
    PRIVATE
+   PUBLIC   zdf_osm       ! routine called by step.F90
+   PUBLIC   zdf_osm_init  ! routine called by nemogcm.F90
+   PUBLIC   osm_rst       ! routine called by step.F90
+   PUBLIC   tra_osm       ! routine called by step.F90
+   PUBLIC   trc_osm       ! routine called by trcstp.F90
+   PUBLIC   dyn_osm       ! routine called by step.F90
+   PUBLIC   ln_osm_mle    ! logical needed by tra_mle_init in tramle.F90
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamu    !: non-local u-momentum flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamv    !: non-local v-momentum flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamt    !: non-local temperature flux (gamma/<ws>o)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghams    !: non-local salinity flux (gamma/<ws>o)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean   !: averaging operator for avt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbl      !: boundary layer depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dh       ! depth of pycnocline
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hml      ! ML depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dstokes  !: penetration depth of the Stokes drift.
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   r1_ft    ! inverse of the modified Coriolis parameter at t-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hmle     ! Depth of layer affexted by mixed layer eddies in Fox-Kemper parametrization
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdx_mle ! zonal buoyancy gradient in ML
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdy_mle ! meridional buoyancy gradient in ML
+   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mld_prof ! level of base of MLE layer.
+   !                      !!** Namelist  namzdf_osm  **
+   LOGICAL  ::   ln_use_osm_la      ! Use namelist  rn_osm_la
+   LOGICAL  ::   ln_osm_mle           !: flag to activate the Mixed Layer Eddy (MLE) parameterisation
+   REAL(wp) ::   rn_osm_la          ! Turbulent Langmuir number
+   REAL(wp) ::   rn_osm_dstokes     ! Depth scale of Stokes drift
+   REAL(wp) ::   rn_zdfosm_adjust_sd = 1.0 ! factor to reduce Stokes drift by
+   REAL(wp) ::   rn_osm_hblfrac = 0.1! for nn_osm_wave = 3/4 specify fraction in top of hbl
+   LOGICAL  ::   ln_zdfosm_ice_shelter      ! flag to activate ice sheltering
+   REAL(wp) ::   rn_osm_hbl0 = 10._wp       ! Initial value of hbl for 1D runs
+   INTEGER  ::   nn_ave             ! = 0/1 flag for horizontal average on avt
+   INTEGER  ::   nn_osm_wave = 0    ! = 0/1/2 flag for getting stokes drift from La# / PM wind-waves/Inputs into sbcwave
+   INTEGER  ::   nn_osm_SD_reduce   ! = 0/1/2 flag for getting effective stokes drift from surface value
+   LOGICAL  ::   ln_dia_osm         ! Use namelist  rn_osm_la
+   LOGICAL  ::   ln_kpprimix  = .true.  ! Shear instability mixing
+   REAL(wp) ::   rn_riinfty   = 0.7     ! local Richardson Number limit for shear instability
+   REAL(wp) ::   rn_difri    =  0.005   ! maximum shear mixing at Rig = 0    (m2/s)
+   LOGICAL  ::   ln_convmix  = .true.   ! Convective instability mixing
+   REAL(wp) ::   rn_difconv = 1._wp     ! diffusivity when unstable below BL  (m2/s)
+! OSMOSIS mixed layer eddy parametrization constants
+   INTEGER  ::   nn_osm_mle             ! = 0/1 flag for horizontal average on avt
+   REAL(wp) ::   rn_osm_mle_ce           ! MLE coefficient
+   !                                        ! parameters used in nn_osm_mle = 0 case
+   REAL(wp) ::   rn_osm_mle_lf               ! typical scale of mixed layer front
+   REAL(wp) ::   rn_osm_mle_time             ! time scale for mixing momentum across the mixed layer
+   !                                        ! parameters used in nn_osm_mle = 1 case
+   REAL(wp) ::   rn_osm_mle_lat              ! reference latitude for a 5 km scale of ML front
+   LOGICAL  ::   ln_osm_hmle_limit           ! If true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld
+   REAL(wp) ::   rn_osm_hmle_limit           ! If ln_osm_hmle_limit true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld
+   REAL(wp) ::   rn_osm_mle_rho_c        ! Density criterion for definition of MLD used by FK
+   REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation
+   REAL(wp) ::   rb_c                   ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld
+   REAL(wp) ::   rc_f                   ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_osm_mle=1 case
+   REAL(wp) ::   rn_osm_mle_thresh          ! Threshold buoyancy for deepening of MLE layer below OSBL base.
+   REAL(wp) ::   rn_osm_bl_thresh          ! Threshold buoyancy for deepening of OSBL base.
+   REAL(wp) ::   rn_osm_mle_tau             ! Adjustment timescale for MLE.
+   !                                    !!! ** General constants  **
+   REAL(wp) ::   epsln   = 1.0e-20_wp   ! a small positive number to ensure no div by zero
+   REAL(wp) ::   depth_tol = 1.0e-6_wp  ! a small-ish positive number to give a hbl slightly shallower than gdepw
+   REAL(wp) ::   pthird  = 1._wp/3._wp  ! 1/3
+   REAL(wp) ::   p2third = 2._wp/3._wp  ! 2/3
+   INTEGER :: idebug = 236
+   INTEGER :: jdebug = 228
+   ! Public subroutines
+   PUBLIC zdf_osm        ! Routine called by step.F90
+   PUBLIC zdf_osm_init   ! Routine called by nemogcm.F90
+   PUBLIC osm_rst        ! Routine called by step.F90
+   PUBLIC tra_osm        ! Routine called by step.F90
+   PUBLIC trc_osm        ! Routine called by trcstp.F90
+   PUBLIC dyn_osm        ! Routine called by step.F90
+   ! Public variables
+   LOGICAL,  PUBLIC                                      ::   ln_osm_mle   !: Flag to activate the Mixed Layer Eddy (MLE)
+   !                                                                       !     parameterisation, needed by tra_mle_init in
+   !                                                                       !     tramle.F90
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamu        !: Non-local u-momentum flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamv        !: Non-local v-momentum flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamt        !: Non-local temperature flux (gamma/<ws>o)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghams        !: Non-local salinity flux (gamma/<ws>o)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbl          !: Boundary layer depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hml          !: ML depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hmle         !: Depth of layer affexted by mixed layer eddies in Fox-Kemper parametrization
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdx_mle     !: Zonal buoyancy gradient in ML
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdy_mle     !: Meridional buoyancy gradient in ML
+   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mld_prof     !: Level of base of MLE layer
+   INTERFACE zdf_osm_velocity_rotation
+      !!---------------------------------------------------------------------
+      !!              ***  INTERFACE zdf_velocity_rotation  ***
+      !!---------------------------------------------------------------------
+      MODULE PROCEDURE zdf_osm_velocity_rotation_2d
+      MODULE PROCEDURE zdf_osm_velocity_rotation_3d
+   END INTERFACE
+   !
+   INTERFACE zdf_osm_iomput
+      !!---------------------------------------------------------------------
+      !!                 ***  INTERFACE zdf_osm_iomput  ***
+      !!---------------------------------------------------------------------
+      MODULE PROCEDURE zdf_osm_iomput_2d
+      MODULE PROCEDURE zdf_osm_iomput_3d
+   END INTERFACE
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean      ! Averaging operator for avt
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dh          ! Depth of pycnocline
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   r1_ft       ! Inverse of the modified Coriolis parameter at t-pts
+   ! Layer indices
+   INTEGER,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nbld        ! Level of boundary layer base
+   INTEGER,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nmld        ! Level of mixed-layer depth (pycnocline top)
+   ! Layer type
+   INTEGER,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   n_ddh       ! Type of shear layer
+   !                                                              !    n_ddh=0: active shear layer
+   !                                                              !    n_ddh=1: shear layer not active
+   !                                                              !    n_ddh=2: shear production low
+   ! Layer flags
+   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_conv      ! Unstable/stable bl
+   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_shear     ! Shear layers
+   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_coup      ! Coupling to bottom
+   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_pyc       ! OSBL pycnocline present
+   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_flux      ! Surface flux extends below OSBL into MLE layer
+   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_mle       ! MLE layer increases in hickness.
+   ! Scales
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swth0       ! Surface heat flux (Kinematic)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sws0        ! Surface freshwater flux
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swb0        ! Surface buoyancy flux
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   suw0        ! Surface u-momentum flux
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sustar      ! Friction velocity
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   scos_wind   ! Cos angle of surface stress
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ssin_wind   ! Sin angle of surface stress
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swthav      ! Heat flux - bl average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swsav       ! Freshwater flux - bl average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swbav       ! Buoyancy flux - bl average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sustke      ! Surface Stokes drift
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dstokes     ! Penetration depth of the Stokes drift
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swstrl      ! Langmuir velocity scale
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swstrc      ! Convective velocity scale
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sla         ! Trubulent Langmuir number
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   svstr       ! Velocity scale that tends to sustar for large Langmuir number
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   shol        ! Stability parameter for boundary layer
+   ! Layer averages: BL
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_t_bl     ! Temperature average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_s_bl     ! Salinity average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_u_bl     ! Velocity average (u)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_v_bl     ! Velocity average (v)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_b_bl     ! Buoyancy average
+   ! Difference between layer average and parameter at the base of the layer: BL
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dt_bl    ! Temperature difference
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_ds_bl    ! Salinity difference
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_du_bl    ! Velocity difference (u)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dv_bl    ! Velocity difference (v)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_db_bl    ! Buoyancy difference
+   ! Layer averages: ML
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_t_ml     ! Temperature average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_s_ml     ! Salinity average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_u_ml     ! Velocity average (u)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_v_ml     ! Velocity average (v)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_b_ml     ! Buoyancy average
+   ! Difference between layer average and parameter at the base of the layer: ML
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dt_ml    ! Temperature difference
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_ds_ml    ! Salinity difference
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_du_ml    ! Velocity difference (u)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dv_ml    ! Velocity difference (v)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_db_ml    ! Buoyancy difference
+   ! Layer averages: MLE
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_t_mle    ! Temperature average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_s_mle    ! Salinity average
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_u_mle    ! Velocity average (u)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_v_mle    ! Velocity average (v)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_b_mle    ! Buoyancy average
+   ! Diagnostic output
+   REAL(WP), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   osmdia2d    ! Auxiliary array for diagnostic output
+   REAL(WP), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   osmdia3d    ! Auxiliary array for diagnostic output
+   LOGICAL  ::   ln_dia_pyc_scl = .FALSE.                         ! Output of pycnocline scalar-gradient profiles
+   LOGICAL  ::   ln_dia_pyc_shr = .FALSE.                         ! Output of pycnocline velocity-shear  profiles
+   !                                               !!* namelist namzdf_osm *
+   LOGICAL  ::   ln_use_osm_la                      ! Use namelist rn_osm_la
+   REAL(wp) ::   rn_osm_la                          ! Turbulent Langmuir number
+   REAL(wp) ::   rn_osm_dstokes                     ! Depth scale of Stokes drift
+   REAL(wp) ::   rn_zdfosm_adjust_sd   = 1.0_wp     ! Factor to reduce Stokes drift by
+   REAL(wp) ::   rn_osm_hblfrac        = 0.1_wp     ! For nn_osm_wave = 3/4 specify fraction in top of hbl
+   LOGICAL  ::   ln_zdfosm_ice_shelter              ! Flag to activate ice sheltering
+   REAL(wp) ::   rn_osm_hbl0           = 10.0_wp    ! Initial value of hbl for 1D runs
+   INTEGER  ::   nn_ave                             ! = 0/1 flag for horizontal average on avt
+   INTEGER  ::   nn_osm_wave = 0                    ! = 0/1/2 flag for getting stokes drift from La# / PM wind-waves/Inputs into
+   !                                                !    sbcwave
+   INTEGER  ::   nn_osm_SD_reduce                   ! = 0/1/2 flag for getting effective stokes drift from surface value
+   LOGICAL  ::   ln_dia_osm                         ! Use namelist  rn_osm_la
+   LOGICAL  ::   ln_kpprimix           = .TRUE.     ! Shear instability mixing
+   REAL(wp) ::   rn_riinfty            = 0.7_wp     ! Local Richardson Number limit for shear instability
+   REAL(wp) ::   rn_difri              = 0.005_wp   ! Maximum shear mixing at Rig = 0    (m2/s)
+   LOGICAL  ::   ln_convmix            = .TRUE.     ! Convective instability mixing
+   REAL(wp) ::   rn_difconv            = 1.0_wp     ! Diffusivity when unstable below BL  (m2/s)
+   ! OSMOSIS mixed layer eddy parametrization constants
+   INTEGER  ::   nn_osm_mle                         ! = 0/1 flag for horizontal average on avt
+   REAL(wp) ::   rn_osm_mle_ce                      ! MLE coefficient
+   !    Parameters used in nn_osm_mle = 0 case
+   REAL(wp) ::   rn_osm_mle_lf                      ! Typical scale of mixed layer front
+   REAL(wp) ::   rn_osm_mle_time                    ! Time scale for mixing momentum across the mixed layer
+   !    Parameters used in nn_osm_mle = 1 case
+   REAL(wp) ::   rn_osm_mle_lat                     ! Reference latitude for a 5 km scale of ML front
+   LOGICAL  ::   ln_osm_hmle_limit                  ! If true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld
+   REAL(wp) ::   rn_osm_hmle_limit                  ! If ln_osm_hmle_limit true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld
+   REAL(wp) ::   rn_osm_mle_rho_c                   ! Density criterion for definition of MLD used by FK
+   REAL(wp) ::   rb_c                               ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld
+   REAL(wp) ::   rc_f                               ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_osm_mle=1 case
+   REAL(wp) ::   rn_osm_mle_thresh                  ! Threshold buoyancy for deepening of MLE layer below OSBL base
+   REAL(wp) ::   rn_osm_bl_thresh                   ! Threshold buoyancy for deepening of OSBL base
+   REAL(wp) ::   rn_osm_mle_tau                     ! Adjustment timescale for MLE
+   ! General constants
+   REAL(wp) ::   epsln     = 1.0e-20_wp      ! A small positive number to ensure no div by zero
+   REAL(wp) ::   depth_tol = 1.0e-6_wp       ! A small-ish positive number to give a hbl slightly shallower than gdepw
+   REAL(wp) ::   pthird    = 1.0_wp/3.0_wp   ! 1/3
+   REAL(wp) ::   p2third   = 2.0_wp/3.0_wp   ! 2/3
    !! * Substitutions
 …
       !!                 ***  FUNCTION zdf_osm_alloc  ***
       !!----------------------------------------------------------------------
+     ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), &
+          &       hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), &
+          &       etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc )
+     ALLOCATE(  hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), &
+          &       mld_prof(jpi,jpj), STAT= zdf_osm_alloc )
+     CALL mpp_sum ( 'zdfosm', zdf_osm_alloc )
+     IF( zdf_osm_alloc /= 0 )   CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays')
+      INTEGER ::   ierr
+      !!----------------------------------------------------------------------
+      !
+      zdf_osm_alloc = 0
+      !
+      ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk), ghams(jpi,jpj,jpk), hbl(jpi,jpj), hml(jpi,jpj),   &
+         &      hmle(jpi,jpj),      dbdx_mle(jpi,jpj),  dbdy_mle(jpi,jpj),  mld_prof(jpi,jpj),  STAT=ierr )
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( etmean(A2D(nn_hls-1),jpk), dh(jpi,jpj), r1_ft(A2D(nn_hls-1)), STAT=ierr )
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( nbld(jpi,jpj), nmld(A2D(nn_hls-1)), STAT=ierr )
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( n_ddh(A2D(nn_hls-1)), STAT=ierr )
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( l_conv(A2D(nn_hls-1)), l_shear(A2D(nn_hls-1)), l_coup(A2D(nn_hls-1)), l_pyc(A2D(nn_hls-1)),   &
+         &      l_flux(A2D(nn_hls-1)), l_mle(A2D(nn_hls-1)),   STAT=ierr )
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( swth0(A2D(nn_hls-1)),  sws0(A2D(nn_hls-1)),      swb0(A2D(nn_hls-1)),      suw0(A2D(nn_hls-1)),      &
+         &      sustar(A2D(nn_hls-1)), scos_wind(A2D(nn_hls-1)), ssin_wind(A2D(nn_hls-1)), swthav(A2D(nn_hls-1)),    &
+         &      swsav(A2D(nn_hls-1)),  swbav(A2D(nn_hls-1)),     sustke(A2D(nn_hls-1)),    dstokes(A2D(nn_hls-1)),   &
+         &      swstrl(A2D(nn_hls-1)), swstrc(A2D(nn_hls-1)),    sla(A2D(nn_hls-1)),       svstr(A2D(nn_hls-1)),     &
+         &      shol(A2D(nn_hls-1)),   STAT=ierr )
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( av_t_bl(jpi,jpj), av_s_bl(jpi,jpj), av_u_bl(jpi,jpj), av_v_bl(jpi,jpj),   &
+         &      av_b_bl(jpi,jpj), STAT=ierr)
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( av_dt_bl(jpi,jpj), av_ds_bl(jpi,jpj), av_du_bl(jpi,jpj), av_dv_bl(jpi,jpj),   &
+         &      av_db_bl(jpi,jpj), STAT=ierr)
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( av_t_ml(jpi,jpj), av_s_ml(jpi,jpj), av_u_ml(jpi,jpj), av_v_ml(jpi,jpj),   &
+         &      av_b_ml(jpi,jpj), STAT=ierr)
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( av_dt_ml(jpi,jpj), av_ds_ml(jpi,jpj), av_du_ml(jpi,jpj), av_dv_ml(jpi,jpj),   &
+         &      av_db_ml(jpi,jpj), STAT=ierr)
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      ALLOCATE( av_t_mle(jpi,jpj), av_s_mle(jpi,jpj), av_u_mle(jpi,jpj), av_v_mle(jpi,jpj),   &
+         &      av_b_mle(jpi,jpj), STAT=ierr)
+      zdf_osm_alloc = zdf_osm_alloc + ierr
+      !
+      IF ( ln_dia_osm ) THEN
+         ALLOCATE( osmdia2d(jpi,jpj), osmdia3d(jpi,jpj,jpk), STAT=ierr )
+         zdf_osm_alloc = zdf_osm_alloc + ierr
+      END IF
+      !
+      CALL mpp_sum ( 'zdfosm', zdf_osm_alloc )
+      IF( zdf_osm_alloc /= 0 ) CALL ctl_warn( 'zdf_osm_alloc: failed to allocate zdf_osm arrays' )
+      !
    END FUNCTION zdf_osm_alloc
    SUBROUTINE zdf_osm( kt, Kbb, Kmm, Krhs, p_avm, p_avt )
+   SUBROUTINE zdf_osm( kt, Kbb, Kmm, Krhs, p_avm,   &
+      &                p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_osm  ***
 …
       !!         the equation number. (LMD94, here after)
       !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::  kt             ! ocean time step
+      INTEGER                   , INTENT(in   ) ::  Kbb, Kmm, Krhs ! ocean time level indices
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::  p_avm, p_avt   ! momentum and tracer Kz (w-points)
+      !!
+      INTEGER ::   ji, jj, jk                   ! dummy loop indices
+      INTEGER ::   jl                   ! dummy loop indices
+      INTEGER ::   ikbot, jkmax, jkm1, jkp2     !
+      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube      !
+      REAL(wp) ::   zbeta, zthermal                                  !
+      REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm ! Velocity scales
+      REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm       !
+      REAL(wp) ::   zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed   ! In situ density
+      INTEGER  ::   jm                          ! dummy loop indices
+      REAL(wp) ::   zr1, zr2, zr3, zr4, zrhop   ! Compression terms
+      REAL(wp) ::   zflag, zrn2, zdep21, zdep32, zdep43
+      REAL(wp) ::   zesh2, zri, zfri            ! Interior richardson mixing
+      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t
+      REAL(wp) :: zt,zs,zu,zv,zrh               ! variables used in constructing averages
+! Scales
+      REAL(wp), DIMENSION(jpi,jpj) :: zrad0     ! Surface solar temperature flux (deg m/s)
+      REAL(wp), DIMENSION(jpi,jpj) :: zradh     ! Radiative flux at bl base (Buoyancy units)
+      REAL(wp), DIMENSION(jpi,jpj) :: zradav    ! Radiative flux, bl average (Buoyancy Units)
+      REAL(wp), DIMENSION(jpi,jpj) :: zustar    ! friction velocity
+      REAL(wp), DIMENSION(jpi,jpj) :: zwstrl    ! Langmuir velocity scale
+      REAL(wp), DIMENSION(jpi,jpj) :: zvstr     ! Velocity scale that ends to zustar for large Langmuir number.
+      REAL(wp), DIMENSION(jpi,jpj) :: zwstrc    ! Convective velocity scale
+      REAL(wp), DIMENSION(jpi,jpj) :: zuw0      ! Surface u-momentum flux
+      REAL(wp), DIMENSION(jpi,jpj) :: zvw0      ! Surface v-momentum flux
+      REAL(wp), DIMENSION(jpi,jpj) :: zwth0     ! Surface heat flux (Kinematic)
+      REAL(wp), DIMENSION(jpi,jpj) :: zws0      ! Surface freshwater flux
+      REAL(wp), DIMENSION(jpi,jpj) :: zwb0      ! Surface buoyancy flux
+      REAL(wp), DIMENSION(jpi,jpj) :: zwthav    ! Heat flux - bl average
+      REAL(wp), DIMENSION(jpi,jpj) :: zwsav     ! freshwater flux - bl average
+      REAL(wp), DIMENSION(jpi,jpj) :: zwbav     ! Buoyancy flux - bl average
+      REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent   ! Buoyancy entrainment flux
+      REAL(wp), DIMENSION(jpi,jpj) :: zwb_min
+      REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk_b  ! MLE buoyancy flux averaged over OSBL
+      REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk    ! max MLE buoyancy flux
+      REAL(wp), DIMENSION(jpi,jpj) :: zdiff_mle ! extra MLE vertical diff
+      REAL(wp), DIMENSION(jpi,jpj) :: zvel_mle  ! velocity scale for dhdt with stable ML and FK
+      REAL(wp), DIMENSION(jpi,jpj) :: zustke    ! Surface Stokes drift
+      REAL(wp), DIMENSION(jpi,jpj) :: zla       ! Trubulent Langmuir number
+      REAL(wp), DIMENSION(jpi,jpj) :: zcos_wind ! Cos angle of surface stress
+      REAL(wp), DIMENSION(jpi,jpj) :: zsin_wind ! Sin angle of surface stress
+      REAL(wp), DIMENSION(jpi,jpj) :: zhol      ! Stability parameter for boundary layer
+      LOGICAL, DIMENSION(jpi,jpj)  :: lconv     ! unstable/stable bl
+      LOGICAL, DIMENSION(jpi,jpj)  :: lshear    ! Shear layers
+      LOGICAL, DIMENSION(jpi,jpj)  :: lpyc      ! OSBL pycnocline present
+      LOGICAL, DIMENSION(jpi,jpj)  :: lflux     ! surface flux extends below OSBL into MLE layer.
+      LOGICAL, DIMENSION(jpi,jpj)  :: lmle      ! MLE layer increases in hickness.
+      ! mixed-layer variables
+      INTEGER, DIMENSION(jpi,jpj) :: ibld ! level of boundary layer base
+      INTEGER, DIMENSION(jpi,jpj) :: imld ! level of mixed-layer depth (pycnocline top)
+      INTEGER, DIMENSION(jpi,jpj) :: jp_ext, jp_ext_mle ! offset for external level
+      INTEGER, DIMENSION(jpi, jpj) :: j_ddh ! Type of shear layer
+      REAL(wp) :: ztgrad,zsgrad,zbgrad ! Temporary variables used to calculate pycnocline gradients
+      REAL(wp) :: zugrad,zvgrad        ! temporary variables for calculating pycnocline shear
+      REAL(wp), DIMENSION(jpi,jpj) :: zhbl  ! bl depth - grid
+      REAL(wp), DIMENSION(jpi,jpj) :: zhml  ! ml depth - grid
+      REAL(wp), DIMENSION(jpi,jpj) :: zhmle ! MLE depth - grid
+      REAL(wp), DIMENSION(jpi,jpj) :: zmld  ! ML depth on grid
+      REAL(wp), DIMENSION(jpi,jpj) :: zdh   ! pycnocline depth - grid
+      REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! BL depth tendency
+      REAL(wp), DIMENSION(jpi,jpj) :: zddhdt                                    ! correction to dhdt due to internal structure.
+      REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_bl_ext,zdsdz_bl_ext,zdbdz_bl_ext              ! external temperature/salinity and buoyancy gradients
+      REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_mle_ext,zdsdz_mle_ext,zdbdz_mle_ext              ! external temperature/salinity and buoyancy gradients
+      REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy      ! horizontal gradients for Fox-Kemper parametrization.
+      REAL(wp), DIMENSION(jpi,jpj) :: zt_bl,zs_bl,zu_bl,zv_bl,zb_bl  ! averages over the depth of the blayer
+      REAL(wp), DIMENSION(jpi,jpj) :: zt_ml,zs_ml,zu_ml,zv_ml,zb_ml  ! averages over the depth of the mixed layer
+      REAL(wp), DIMENSION(jpi,jpj) :: zt_mle,zs_mle,zu_mle,zv_mle,zb_mle  ! averages over the depth of the MLE layer
+      REAL(wp), DIMENSION(jpi,jpj) :: zdt_bl,zds_bl,zdu_bl,zdv_bl,zdb_bl ! difference between blayer average and parameter at base of blayer
+      REAL(wp), DIMENSION(jpi,jpj) :: zdt_ml,zds_ml,zdu_ml,zdv_ml,zdb_ml ! difference between mixed layer average and parameter at base of blayer
+      REAL(wp), DIMENSION(jpi,jpj) :: zdt_mle,zds_mle,zdu_mle,zdv_mle,zdb_mle ! difference between MLE layer average and parameter at base of blayer
+!      REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline
+      REAL(wp) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline
+      REAL(wp) :: zuw_bse,zvw_bse  ! momentum fluxes at the top of the pycnocline
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz_pyc    ! parametrized gradient of temperature in pycnocline
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdsdz_pyc    ! parametrised gradient of salinity in pycnocline
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdbdz_pyc    ! parametrised gradient of buoyancy in the pycnocline
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz_pyc    ! u-shear across the pycnocline
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdvdz_pyc    ! v-shear across the pycnocline
+      REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle    ! Magnitude of horizontal buoyancy gradient.
+      ! Flux-gradient relationship variables
+      REAL(wp), DIMENSION(jpi, jpj) :: zshear, zri_i ! Shear production and interfacial richardon number.
+      REAL(wp) :: zl_c,zl_l,zl_eps  ! Used to calculate turbulence length scale.
+      REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline.
+      REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_1,zsc_ws_1 ! Temporary scales used to calculate scalar non-gradient terms.
+      REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_pyc, zsc_ws_pyc ! Scales for pycnocline transport term/
+      REAL(wp), DIMENSION(jpi,jpj) :: zsc_uw_1,zsc_uw_2,zsc_vw_1,zsc_vw_2 ! Temporary scales for non-gradient momentum flux terms.
+      REAL(wp), DIMENSION(jpi,jpj) :: zhbl_t ! holds boundary layer depth updated by full timestep
+      ! For calculating Ri#-dependent mixing
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3du   ! u-shear^2
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3dv   ! v-shear^2
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrimix ! spatial form of ri#-induced diffusion
+      ! Temporary variables
+      INTEGER :: inhml
+      REAL(wp) :: znd,znd_d,zznd_ml,zznd_pyc,zznd_d ! temporary non-dimensional depths used in various routines
+      REAL(wp) :: ztemp, zari, zpert, zzdhdt, zdb   ! temporary variables
+      REAL(wp) :: zthick, zz0, zz1 ! temporary variables
+      REAL(wp) :: zvel_max, zhbl_s ! temporary variables
+      REAL(wp) :: zfac, ztmp       ! temporary variable
+      REAL(wp) :: zus_x, zus_y     ! temporary Stokes drift
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdiffut ! t-diffusivity
+      REAL(wp), DIMENSION(jpi,jpj) :: zalpha_pyc
+      REAL(wp), DIMENSION(jpi,jpj) :: ztau_sc_u ! dissipation timescale at baes of WML.
+      REAL(wp) :: zdelta_pyc, zwt_pyc_sc_1, zws_pyc_sc_1, zzeta_pyc
+      REAL(wp) :: zbuoy_pyc_sc, zomega, zvw_max
+      INTEGER :: ibld_ext=0                          ! does not have to be zero for modified scheme
+      REAL(wp) :: zgamma_b_nd, zgamma_b, zdhoh, ztau
+      REAL(wp) :: zzeta_s = 0._wp
+      REAL(wp) :: zzeta_v = 0.46
+      REAL(wp) :: zabsstke
+      REAL(wp) :: zsqrtpi, z_two_thirds, zproportion, ztransp, zthickness
+      REAL(wp) :: z2k_times_thickness, zsqrt_depth, zexp_depth, zdstokes0, zf, zexperfc
+      ! For debugging
+      INTEGER :: ikt
+      !!--------------------------------------------------------------------
+      !
+      ibld(:,:)   = 0     ; imld(:,:)  = 0
+      zrad0(:,:)  = 0._wp ; zradh(:,:) = 0._wp ; zradav(:,:)    = 0._wp ; zustar(:,:)    = 0._wp
+      zwstrl(:,:) = 0._wp ; zvstr(:,:) = 0._wp ; zwstrc(:,:)    = 0._wp ; zuw0(:,:)      = 0._wp
+      zvw0(:,:)   = 0._wp ; zwth0(:,:) = 0._wp ; zws0(:,:)      = 0._wp ; zwb0(:,:)      = 0._wp
+      zwthav(:,:) = 0._wp ; zwsav(:,:) = 0._wp ; zwbav(:,:)     = 0._wp ; zwb_ent(:,:)   = 0._wp
+      zustke(:,:) = 0._wp ; zla(:,:)   = 0._wp ; zcos_wind(:,:) = 0._wp ; zsin_wind(:,:) = 0._wp
+      zhol(:,:)   = 0._wp
+      lconv(:,:)  = .FALSE.; lpyc(:,:) = .FALSE. ; lflux(:,:) = .FALSE. ;  lmle(:,:) = .FALSE.
+      ! mixed layer
+      ! no initialization of zhbl or zhml (or zdh?)
+      zhbl(:,:)    = 1._wp ; zhml(:,:)    = 1._wp ; zdh(:,:)      = 1._wp ; zdhdt(:,:)   = 0._wp
+      zt_bl(:,:)   = 0._wp ; zs_bl(:,:)   = 0._wp ; zu_bl(:,:)    = 0._wp
+      zv_bl(:,:)   = 0._wp ; zb_bl(:,:)  = 0._wp
+      zt_ml(:,:)   = 0._wp ; zs_ml(:,:)    = 0._wp ; zu_ml(:,:)   = 0._wp
+      zt_mle(:,:)   = 0._wp ; zs_mle(:,:)    = 0._wp ; zu_mle(:,:)   = 0._wp
+      zb_mle(:,:) = 0._wp
+      zv_ml(:,:)   = 0._wp ; zdt_bl(:,:)   = 0._wp ; zds_bl(:,:)  = 0._wp
+      zdu_bl(:,:)  = 0._wp ; zdv_bl(:,:)  = 0._wp ; zdb_bl(:,:)  = 0._wp
+      zdt_ml(:,:)  = 0._wp ; zds_ml(:,:)  = 0._wp ; zdu_ml(:,:)   = 0._wp ; zdv_ml(:,:)  = 0._wp
+      zdb_ml(:,:)  = 0._wp
+      zdt_mle(:,:)  = 0._wp ; zds_mle(:,:)  = 0._wp ; zdu_mle(:,:)   = 0._wp
+      zdv_mle(:,:)  = 0._wp ; zdb_mle(:,:)  = 0._wp
+      zwth_ent = 0._wp ; zws_ent = 0._wp
+      !
+      zdtdz_pyc(:,:,:) = 0._wp ; zdsdz_pyc(:,:,:) = 0._wp ; zdbdz_pyc(:,:,:) = 0._wp
+      zdudz_pyc(:,:,:) = 0._wp ; zdvdz_pyc(:,:,:) = 0._wp
+      !
+      zdtdz_bl_ext(:,:) = 0._wp ; zdsdz_bl_ext(:,:) = 0._wp ; zdbdz_bl_ext(:,:) = 0._wp
+      IF ( ln_osm_mle ) THEN  ! only initialise arrays if needed
+         zdtdx(:,:) = 0._wp ; zdtdy(:,:) = 0._wp ; zdsdx(:,:) = 0._wp
+         zdsdy(:,:) = 0._wp ; dbdx_mle(:,:) = 0._wp ; dbdy_mle(:,:) = 0._wp
+         zwb_fk(:,:) = 0._wp ; zvel_mle(:,:) = 0._wp; zdiff_mle(:,:) = 0._wp
+         zhmle(:,:) = 0._wp  ; zmld(:,:) = 0._wp
+      INTEGER                   , INTENT(in   ) ::  kt               ! Ocean time step
+      INTEGER                   , INTENT(in   ) ::  Kbb, Kmm, Krhs   ! Ocean time level indices
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::  p_avm, p_avt     ! Momentum and tracer Kz (w-points)
+      !!
+      INTEGER ::   ji, jj, jk, jl, jm, jkflt   ! Dummy loop indices
+      !!
+      REAL(wp) ::   zthermal, zbeta
+      REAL(wp) ::   zesh2, zri, zfri   ! Interior Richardson mixing
+      !! Scales
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zrad0       ! Surface solar temperature flux (deg m/s)
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zradh       ! Radiative flux at bl base (Buoyancy units)
+      REAL(wp)                           ::   zradav      ! Radiative flux, bl average (Buoyancy Units)
+      REAL(wp)                           ::   zvw0        ! Surface v-momentum flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb0tot     ! Total surface buoyancy flux including insolation
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_ent     ! Buoyancy entrainment flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_min
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_fk_b    ! MLE buoyancy flux averaged over OSBL
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_fk      ! Max MLE buoyancy flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdiff_mle   ! Extra MLE vertical diff
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zvel_mle    ! Velocity scale for dhdt with stable ML and FK
+      !! Mixed-layer variables
+      INTEGER,  DIMENSION(A2D(nn_hls-1)) ::   jk_nlev  ! Number of levels
+      INTEGER,  DIMENSION(A2D(nn_hls-1)) ::   jk_ext   ! Offset for external level
+      !!
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhbl   ! BL depth - grid
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhml   ! ML depth - grid
+      !!
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhmle   ! MLE depth - grid
+      REAL(wp), DIMENSION(A2D(nn_hls))   ::   zmld    ! ML depth on grid
+      !!
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdh                          ! Pycnocline depth - grid
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdhdt                        ! BL depth tendency
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdtdz_bl_ext, zdsdz_bl_ext   ! External temperature/salinity gradients
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdbdz_bl_ext                 ! External buoyancy gradients
+      REAL(wp), DIMENSION(A2D(nn_hls))   ::   zdtdx, zdtdy, zdsdx, zdsdy   ! Horizontal gradients for Fox-Kemper parametrization
+      !!
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdbds_mle   ! Magnitude of horizontal buoyancy gradient
+      !! Flux-gradient relationship variables
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zshear   ! Shear production
+      !!
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhbl_t   ! Holds boundary layer depth updated by full timestep
+      !! For calculating Ri#-dependent mixing
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::   z2du     ! u-shear^2
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::   z2dv     ! v-shear^2
+      REAL(wp)                         ::   zrimix   ! Spatial form of ri#-induced diffusion
+      !! Temporary variables
+      REAL(wp)                                 ::   znd              ! Temporary non-dimensional depth
+      REAL(wp)                                 ::   zz0, zz1, zfac
+      REAL(wp)                                 ::   zus_x, zus_y     ! Temporary Stokes drift
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk)   ::   zviscos          ! Viscosity
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk)   ::   zdiffut          ! t-diffusivity
+      REAL(wp)                                 ::   zabsstke
+      REAL(wp)                                 ::   zsqrtpi, z_two_thirds, zthickness
+      REAL(wp)                                 ::   z2k_times_thickness, zsqrt_depth, zexp_depth, zf, zexperfc
+      !! For debugging
+      REAL(wp), PARAMETER ::   pp_large = -1e10_wp
+      !!----------------------------------------------------------------------
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         nmld(ji,jj)   = 0
+         sustke(ji,jj) = pp_large
+         l_pyc(ji,jj)  = .FALSE.
+         l_flux(ji,jj) = .FALSE.
+         l_mle(ji,jj)  = .FALSE.
+      END_2D
+      ! Mixed layer
+      ! No initialization of zhbl or zhml (or zdh?)
+      zhbl(:,:) = pp_large
+      zhml(:,:) = pp_large
+      zdh(:,:)  = pp_large
+      !
+      IF ( ln_osm_mle ) THEN   ! Only initialise arrays if needed
+         zdtdx(:,:)  = pp_large ; zdtdy(:,:)    = pp_large ; zdsdx(:,:)     = pp_large
+         zdsdy(:,:)  = pp_large
+         zwb_fk(:,:) = pp_large ; zvel_mle(:,:) = pp_large
+         zhmle(:,:)  = pp_large ; zmld(:,:)     = pp_large
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+            dbdx_mle(ji,jj) = pp_large
+            dbdy_mle(ji,jj) = pp_large
+         END_2D
       ENDIF
+      zwb_fk_b(:,:) = 0._wp   ! must be initialised even with ln_osm_mle=F as used in zdf_osm_calculate_dhdt
+      ! Flux-Gradient arrays.
+      zsc_wth_1(:,:)  = 0._wp ; zsc_ws_1(:,:)   = 0._wp ; zsc_uw_1(:,:)   = 0._wp
+      zsc_uw_2(:,:)   = 0._wp ; zsc_vw_1(:,:)   = 0._wp ; zsc_vw_2(:,:)   = 0._wp
+      zhbl_t(:,:)     = 0._wp ; zdhdt(:,:)      = 0._wp
+      zdiffut(:,:,:) = 0._wp ; zviscos(:,:,:) = 0._wp ; ghamt(:,:,:) = 0._wp
+      ghams(:,:,:)   = 0._wp ; ghamu(:,:,:)   = 0._wp ; ghamv(:,:,:) = 0._wp
+      zddhdt(:,:) = 0._wp
+      ! hbl = MAX(hbl,epsln)
+      zhbl_t(:,:)   = pp_large
+      !
+      zdiffut(:,:,:) = 0.0_wp
+      zviscos(:,:,:) = 0.0_wp
+      !
+      DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+         ghamt(ji,jj,jk) = pp_large
+         ghams(ji,jj,jk) = pp_large
+         ghamu(ji,jj,jk) = pp_large
+         ghamv(ji,jj,jk) = pp_large
+      END_3D
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+         ghamt(ji,jj,jk) = 0.0_wp
+         ghams(ji,jj,jk) = 0.0_wp
+         ghamu(ji,jj,jk) = 0.0_wp
+         ghamv(ji,jj,jk) = 0.0_wp
+      END_3D
+      !
+      zdiff_mle(:,:) = 0.0_wp
+      !
+      ! Ensure only positive hbl values are accessed when using extended halo
+      ! (nn_hls==2)
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         hbl(ji,jj) = MAX( hbl(ji,jj), epsln )
+      END_2D
+      !
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Calculate boundary layer scales
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! Assume two-band radiation model for depth of OSBL
+     zz0 =       rn_abs       ! surface equi-partition in 2-bands
+     zz1 =  1. - rn_abs
+     DO_2D( 0, 0, 0, 0 )
+        ! Surface downward irradiance (so always +ve)
+        zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp
+        ! Downwards irradiance at base of boundary layer
+        zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) )
+        ! Downwards irradiance averaged over depth of the OSBL
+        zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 &
+              &                         + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj)
+     END_2D
+     ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL
+     DO_2D( 0, 0, 0, 0 )
+        zthermal = rab_n(ji,jj,1,jp_tem)
+        zbeta    = rab_n(ji,jj,1,jp_sal)
+        ! Upwards surface Temperature flux for non-local term
+        zwth0(ji,jj) = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1)
+        ! Upwards surface salinity flux for non-local term
+        zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm)  + sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1)
+        ! Non radiative upwards surface buoyancy flux
+        zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) -  grav * zbeta * zws0(ji,jj)
+        ! turbulent heat flux averaged over depth of OSBL
+        zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) )
+        ! turbulent salinity flux averaged over depth of the OBSL
+        zwsav(ji,jj) = 0.5 * zws0(ji,jj)
+        ! turbulent buoyancy flux averaged over the depth of the OBSBL
+        zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj)
+        ! Surface upward velocity fluxes
+        zuw0(ji,jj) = - 0.5 * (utau(ji-1,jj) + utau(ji,jj)) * r1_rho0 * tmask(ji,jj,1)
+        zvw0(ji,jj) = - 0.5 * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1)
+        ! Friction velocity (zustar), at T-point : LMD94 eq. 2
+        zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 )
+        zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) )
+        zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) )
+     END_2D
+     ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes)
+     SELECT CASE (nn_osm_wave)
+     ! Assume constant La#=0.3
+     CASE(0)
+        DO_2D( 0, 0, 0, 0 )
+           zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2
+           zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2
+           ! Linearly
+           zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 )
+           dstokes(ji,jj) = rn_osm_dstokes
+        END_2D
+     ! Assume Pierson-Moskovitz wind-wave spectrum
+     CASE(1)
+        DO_2D( 0, 0, 0, 0 )
+           ! Use wind speed wndm included in sbc_oce module
+           zustke(ji,jj) =  MAX ( 0.016 * wndm(ji,jj), 1.0e-8 )
+           dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1)
+        END_2D
+     ! Use ECMWF wave fields as output from SBCWAVE
+     CASE(2)
+        zfac =  2.0_wp * rpi / 16.0_wp
+        DO_2D( 0, 0, 0, 0 )
+           IF (hsw(ji,jj) > 1.e-4) THEN
+              ! Use  wave fields
+              zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2)
+              zustke(ji,jj) = MAX ( ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj)  * vt0sd(ji,jj) ), 1.0e-8)
+              dstokes(ji,jj) = MAX (zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke * wmp(ji,jj), 1.0e-7 ) ), 5.0e-1)
+           ELSE
+              ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run)
+              ! .. so default to Pierson-Moskowitz
+              zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 )
+              dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1)
+           END IF
+        END_2D
+     END SELECT
+     IF (ln_zdfosm_ice_shelter) THEN
+        ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice
+        DO_2D( 0, 0, 0, 0 )
+           zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj))
+           dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj))
+        END_2D
+     END IF
+     SELECT CASE (nn_osm_SD_reduce)
+     ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van  Roekel (2012) or Grant (2020).
+     CASE(0)
+        ! The Langmur number from the ECMWF model (or from PM)  appears to give La<0.3 for wind-driven seas.
+        !    The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3  in this situation.
+        ! It could represent the effects of the spread of wave directions
+        ! around the mean wind. The effect of this adjustment needs to be tested.
+        IF(nn_osm_wave > 0) THEN
+           zustke(2:jpim1,2:jpjm1) = rn_zdfosm_adjust_sd * zustke(2:jpim1,2:jpjm1)
+        END IF
+     CASE(1)
+        ! van  Roekel (2012): consider average SD over top 10% of boundary layer
+        ! assumes approximate depth profile of SD from Breivik (2016)
+        zsqrtpi = SQRT(rpi)
+        z_two_thirds = 2.0_wp / 3.0_wp
+        DO_2D( 0, 0, 0, 0 )
+           zthickness = rn_osm_hblfrac*hbl(ji,jj)
+           z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp )
+           zsqrt_depth = SQRT(z2k_times_thickness)
+           zexp_depth  = EXP(-z2k_times_thickness)
+           zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - zexp_depth  &
+                &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*z2k_times_thickness * ERFC(zsqrt_depth) &
+                &              + 1.0_wp - (1.0_wp + z2k_times_thickness)*zexp_depth ) ) / z2k_times_thickness
+        END_2D
+     CASE(2)
+        ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer
+        ! assumes approximate depth profile of SD from Breivik (2016)
+        zsqrtpi = SQRT(rpi)
+        DO_2D( 0, 0, 0, 0 )
+           zthickness = rn_osm_hblfrac*hbl(ji,jj)
+           z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp )
+           IF(z2k_times_thickness < 50._wp) THEN
+              zsqrt_depth = SQRT(z2k_times_thickness)
+              zexperfc = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP(z2k_times_thickness)
+           ELSE
+              ! asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large z2k_times_thickness
+              ! See Abramowitz and Stegun, Eq. 7.1.23
+              ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness)  + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3)
+              zexperfc = ((- 1.875_wp/z2k_times_thickness + 0.75_wp)/z2k_times_thickness - 0.5_wp)/z2k_times_thickness + 1.0_wp
+           END IF
+           zf = z2k_times_thickness*(1.0_wp/zexperfc - 1.0_wp)
+           dstokes(ji,jj) = 5.97 * zf * dstokes(ji,jj)
+           zustke(ji,jj) = zustke(ji,jj) * EXP(z2k_times_thickness * ( 1.0_wp / (2. * zf) - 1.0_wp )) * ( 1.0_wp - zexperfc)
+        END_2D
+     END SELECT
+     ! Langmuir velocity scale (zwstrl), La # (zla)
+     ! mixed scale (zvstr), convective velocity scale (zwstrc)
+     DO_2D( 0, 0, 0, 0 )
+        ! Langmuir velocity scale (zwstrl), at T-point
+        zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird
+        zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2)
+        IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj))
+        ! Velocity scale that tends to zustar for large Langmuir numbers
+        zvstr(ji,jj) = ( zwstrl(ji,jj)**3  + &
+             & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird
+        ! limit maximum value of Langmuir number as approximate treatment for shear turbulence.
+        ! Note zustke and zwstrl are not amended.
+        !
+        ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv
+        IF ( zwbav(ji,jj) > 0.0) THEN
+           zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird
+           zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln )
+      !
+      ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL
+      zz0 =           rn_abs   ! Assume two-band radiation model for depth of OSBL - surface equi-partition in 2-bands
+      zz1 =  1.0_wp - rn_abs
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         zrad0(ji,jj)  = qsr(ji,jj) * r1_rho0_rcp   ! Surface downward irradiance (so always +ve)
+         zradh(ji,jj)  = zrad0(ji,jj) *                                &   ! Downwards irradiance at base of boundary layer
+            &            ( zz0 * EXP( -1.0_wp * hbl(ji,jj) / rn_si0 ) + zz1 * EXP( -1.0_wp * hbl(ji,jj) / rn_si1 ) )
+         zradav        = zrad0(ji,jj) *                                              &            ! Downwards irradiance averaged
+            &            ( zz0 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si0 ) ) * rn_si0 +   &            !    over depth of the OSBL
+            &              zz1 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si1 ) ) * rn_si1 ) / hbl(ji,jj)
+         swth0(ji,jj)  = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1)   ! Upwards surface Temperature flux for non-local term
+         swthav(ji,jj) = 0.5_wp * swth0(ji,jj) - ( 0.5_wp * ( zrad0(ji,jj) + zradh(ji,jj) ) -   &   ! Turbulent heat flux averaged
+            &                                                 zradav )                              !    over depth of OSBL
+      END_2D
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         sws0(ji,jj)    = -1.0_wp * ( ( emp(ji,jj) - rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm) +   &   ! Upwards surface salinity flux
+            &                         sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1)                      !    for non-local term
+         zthermal       = rab_n(ji,jj,1,jp_tem)
+         zbeta          = rab_n(ji,jj,1,jp_sal)
+         swb0(ji,jj)    = grav * zthermal * swth0(ji,jj) - grav * zbeta * sws0(ji,jj)   ! Non radiative upwards surface buoyancy flux
+         zwb0tot(ji,jj) = swb0(ji,jj) - grav * zthermal * ( zrad0(ji,jj) - zradh(ji,jj) )   ! Total upwards surface buoyancy flux
+         swsav(ji,jj)   = 0.5_wp * sws0(ji,jj)                              ! Turbulent salinity flux averaged over depth of the OBSL
+         swbav(ji,jj)   = grav  * zthermal * swthav(ji,jj) -            &   ! Turbulent buoyancy flux averaged over the depth of the
+            &             grav  * zbeta * swsav(ji,jj)                      ! OBSBL
+      END_2D
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         suw0(ji,jj)    = -0.5_wp * (utau(ji-1,jj) + utau(ji,jj)) * r1_rho0 * tmask(ji,jj,1)   ! Surface upward velocity fluxes
+         zvw0           = -0.5_wp * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1)
+         sustar(ji,jj)  = MAX( SQRT( SQRT( suw0(ji,jj) * suw0(ji,jj) + zvw0 * zvw0 ) ),   &   ! Friction velocity (sustar), at
+            &                  1e-8_wp )                                                      !    T-point : LMD94 eq. 2
+         scos_wind(ji,jj) = -1.0_wp * suw0(ji,jj) / ( sustar(ji,jj) * sustar(ji,jj) )
+         ssin_wind(ji,jj) = -1.0_wp * zvw0        / ( sustar(ji,jj) * sustar(ji,jj) )
+      END_2D
+      ! Calculate Stokes drift in direction of wind (sustke) and Stokes penetration depth (dstokes)
+      SELECT CASE (nn_osm_wave)
+         ! Assume constant La#=0.3
+      CASE(0)
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            zus_x = scos_wind(ji,jj) * sustar(ji,jj) / 0.3_wp**2
+            zus_y = ssin_wind(ji,jj) * sustar(ji,jj) / 0.3_wp**2
+            ! Linearly
+            sustke(ji,jj)  = MAX( SQRT( zus_x * zus_x + zus_y * zus_y ), 1e-8_wp )
+            dstokes(ji,jj) = rn_osm_dstokes
+         END_2D
+         ! Assume Pierson-Moskovitz wind-wave spectrum
+      CASE(1)
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ! Use wind speed wndm included in sbc_oce module
+            sustke(ji,jj)  = MAX ( 0.016_wp * wndm(ji,jj), 1e-8_wp )
+            dstokes(ji,jj) = MAX ( 0.12_wp * wndm(ji,jj)**2 / grav, 5e-1_wp )
+         END_2D
+         ! Use ECMWF wave fields as output from SBCWAVE
+      CASE(2)
+         zfac =  2.0_wp * rpi / 16.0_wp
+         !
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            IF ( hsw(ji,jj) > 1e-4_wp ) THEN
+               ! Use  wave fields
+               zabsstke       = SQRT( ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2 )
+               sustke(ji,jj)  = MAX( ( scos_wind(ji,jj) * ut0sd(ji,jj) + ssin_wind(ji,jj)  * vt0sd(ji,jj) ), 1e-8_wp )
+               dstokes(ji,jj) = MAX( zfac * hsw(ji,jj) * hsw(ji,jj) / ( MAX( zabsstke * wmp(ji,jj), 1e-7 ) ), 5e-1_wp )
+            ELSE
+               ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run)
+               ! .. so default to Pierson-Moskowitz
+               sustke(ji,jj)  = MAX( 0.016_wp * wndm(ji,jj), 1e-8_wp )
+               dstokes(ji,jj) = MAX( 0.12_wp * wndm(ji,jj)**2 / grav, 5e-1_wp )
+            END IF
+         END_2D
+      END SELECT
+      !
+      IF (ln_zdfosm_ice_shelter) THEN
+         ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            sustke(ji,jj)  = sustke(ji,jj)  * ( 1.0_wp - fr_i(ji,jj) )
+            dstokes(ji,jj) = dstokes(ji,jj) * ( 1.0_wp - fr_i(ji,jj) )
+         END_2D
+      END IF
+      !
+      SELECT CASE (nn_osm_SD_reduce)
+         ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van Roekel (2012) or Grant (2020).
+      CASE(0)
+         ! The Langmur number from the ECMWF model (or from PM) appears to give La<0.3 for wind-driven seas.
+         ! The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3 in this situation.
+         ! It could represent the effects of the spread of wave directions around the mean wind. The effect of this adjustment needs to be tested.
+         IF(nn_osm_wave > 0) THEN
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+               sustke(ji,jj) = rn_zdfosm_adjust_sd * sustke(ji,jj)
+            END_2D
+         END IF
+      CASE(1)
+         ! Van Roekel (2012): consider average SD over top 10% of boundary layer
+         ! Assumes approximate depth profile of SD from Breivik (2016)
+         zsqrtpi = SQRT(rpi)
+         z_two_thirds = 2.0_wp / 3.0_wp
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            zthickness = rn_osm_hblfrac*hbl(ji,jj)
+            z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 1e-7_wp )
+            zsqrt_depth = SQRT( z2k_times_thickness )
+            zexp_depth  = EXP( -1.0_wp * z2k_times_thickness )
+            sustke(ji,jj) = sustke(ji,jj) * ( 1.0_wp - zexp_depth -   &
+               &                              z_two_thirds * ( zsqrtpi * zsqrt_depth * z2k_times_thickness * ERFC(zsqrt_depth) +   &
+               &                                               1.0_wp - ( 1.0_wp + z2k_times_thickness ) * zexp_depth ) ) /        &
+               &            z2k_times_thickness
+         END_2D
+      CASE(2)
+         ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer
+         ! Assumes approximate depth profile of SD from Breivik (2016)
+         zsqrtpi = SQRT(rpi)
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            zthickness = rn_osm_hblfrac*hbl(ji,jj)
+            z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 1e-7_wp )
+            IF( z2k_times_thickness < 50.0_wp ) THEN
+               zsqrt_depth = SQRT( z2k_times_thickness )
+               zexperfc    = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP( z2k_times_thickness )
+            ELSE
+               ! Asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large
+               !    z2k_times_thickness
+               ! See Abramowitz and Stegun, Eq. 7.1.23
+               ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness) + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3)
+               zexperfc = ( ( -1.875_wp / z2k_times_thickness + 0.75_wp ) / z2k_times_thickness - 0.5_wp ) /   &
+                  &       z2k_times_thickness + 1.0_wp
+            END IF
+            zf = z2k_times_thickness * ( 1.0_wp / zexperfc - 1.0_wp )
+            dstokes(ji,jj) = 5.97_wp * zf * dstokes(ji,jj)
+            sustke(ji,jj)  = sustke(ji,jj) * EXP( z2k_times_thickness * ( 1.0_wp / ( 2.0_wp * zf ) - 1.0_wp ) ) *   &
+               &             ( 1.0_wp - zexperfc )
+         END_2D
+      END SELECT
+      !
+      ! Langmuir velocity scale (swstrl), La # (sla)
+      ! Mixed scale (svstr), convective velocity scale (swstrc)
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         ! Langmuir velocity scale (swstrl), at T-point
+         swstrl(ji,jj) = ( sustar(ji,jj) * sustar(ji,jj) * sustke(ji,jj) )**pthird
+         sla(ji,jj)    = MAX( MIN( SQRT( sustar(ji,jj) / ( swstrl(ji,jj) + epsln ) )**3, 4.0_wp ), 0.2_wp )
+         IF ( sla(ji,jj) > 0.45_wp ) dstokes(ji,jj) = MIN( dstokes(ji,jj), 0.5_wp * hbl(ji,jj) )
+         ! Velocity scale that tends to sustar for large Langmuir numbers
+         svstr(ji,jj)  = ( swstrl(ji,jj)**3 + ( 1.0_wp - EXP( -0.5_wp * sla(ji,jj)**2 ) ) * sustar(ji,jj) * sustar(ji,jj) *   &
+            &                                 sustar(ji,jj) )**pthird
+         !
+         ! Limit maximum value of Langmuir number as approximate treatment for shear turbulence
+         ! Note sustke and swstrl are not amended
+         !
+         ! Get convective velocity (swstrc), stabilty scale (shol) and logical conection flag l_conv
+         IF ( swbav(ji,jj) > 0.0_wp ) THEN
+            swstrc(ji,jj) = ( 2.0_wp * swbav(ji,jj) * 0.9_wp * hbl(ji,jj) )**pthird
+            shol(ji,jj)   = -0.9_wp * hbl(ji,jj) * 2.0_wp * swbav(ji,jj) / ( svstr(ji,jj)**3 + epsln )
          ELSE
+           zhol(ji,jj) = -hbl(ji,jj) *  2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3  + epsln )
+        ENDIF
+     END_2D
+     !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+     ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth
+     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+     ! BL must be always 4 levels deep.
+     ! For calculation of lateral buoyancy gradients for FK in
+     ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must
+     ! previously exist for hbl also.
+     ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway
+     ! ##########################################################################
+      hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) )
+      ibld(:,:) = 4
+      DO_3D( 1, 1, 1, 1, 5, jpkm1 )
+         IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN
+            ibld(ji,jj) = MIN(mbkt(ji,jj), jk)
+            swstrc(ji,jj) = 0.0_wp
+            shol(ji,jj)   = -1.0_wp * hbl(ji,jj) * 2.0_wp * swbav(ji,jj) / ( svstr(ji,jj)**3  + epsln )
+         ENDIF
+      END_2D
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! BL must be always 4 levels deep.
+      ! For calculation of lateral buoyancy gradients for FK in
+      ! zdf_osm_zmld_horizontal_gradients need halo values for nbld
+      !
+      ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway
+      ! ##########################################################################
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         hbl(ji,jj) = MAX(hbl(ji,jj), gdepw(ji,jj,4,Kmm) )
+      END_2D
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+         nbld(ji,jj) = 4
+      END_2D
+      DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 5, jpkm1 )
+         IF ( MAX( hbl(ji,jj), gdepw(ji,jj,4,Kmm) ) >= gdepw(ji,jj,jk,Kmm) ) THEN
+            nbld(ji,jj) = MIN(mbkt(ji,jj)-2, jk)
          ENDIF
       END_3D
      ! ##########################################################################
       DO_2D( 0, 0, 0, 0 )
          zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm)
          imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji, jj, ibld(ji,jj), Kmm )) , 1 ))
          zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm)
+      ! ##########################################################################
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         zhbl(ji,jj) = gdepw(ji,jj,nbld(ji,jj),Kmm)
+         nmld(ji,jj) = MAX( 3, nbld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji,jj,nbld(ji,jj)-1,Kmm) ), 1 ) )
+         zhml(ji,jj) = gdepw(ji,jj,nmld(ji,jj),Kmm)
          zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj)
       END_2D
+      ! Averages over well-mixed and boundary layer
+      jp_ext(:,:) = 2
+      CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl)
+!      jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1
+      CALL zdf_osm_vertical_average(ibld, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml)
+! Velocity components in frame aligned with surface stress.
+      CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml )
+      CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl )
+! Determine the state of the OSBL, stable/unstable, shear/no shear
+      CALL zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear, zri_i )
+      !
+      ! Averages over well-mixed and boundary layer, note BL averages use jk_ext=2 everywhere
+      jk_nlev(:,:) = nbld(A2D(nn_hls-1))
+      jk_ext(:,:) = 1   ! ag 19/03
+      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_bl,  av_s_bl,    &
+         &                           av_b_bl,  av_u_bl,  av_v_bl,  jk_ext,   av_dt_bl,   &
+         &                           av_ds_bl, av_db_bl, av_du_bl, av_dv_bl )
+      jk_nlev(:,:) = nmld(A2D(nn_hls-1)) - 1
+      jk_ext(:,:) = nbld(A2D(nn_hls-1)) - nmld(A2D(nn_hls-1)) + jk_ext(:,:) + 1   ! ag 19/03
+      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_ml,  av_s_ml,    &
+         &                           av_b_ml,  av_u_ml,  av_v_ml,  jk_ext,   av_dt_ml,   &
+         &                           av_ds_ml, av_db_ml, av_du_ml, av_dv_ml )
+      ! Velocity components in frame aligned with surface stress
+      CALL zdf_osm_velocity_rotation( av_u_ml,  av_v_ml  )
+      CALL zdf_osm_velocity_rotation( av_du_ml, av_dv_ml )
+      CALL zdf_osm_velocity_rotation( av_u_bl,  av_v_bl  )
+      CALL zdf_osm_velocity_rotation( av_du_bl, av_dv_bl )
+      !
+      ! Determine the state of the OSBL, stable/unstable, shear/no shear
+      CALL zdf_osm_osbl_state( Kmm, zwb_ent, zwb_min, zshear, zhbl,     &
+         &                     zhml, zdh )
+      !
       IF ( ln_osm_mle ) THEN
+! Fox-Kemper Scheme
+         mld_prof = 4
+         DO_3D( 0, 0, 0, 0, 5, jpkm1 )
+         IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)
+         ! Fox-Kemper Scheme
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+            mld_prof(ji,jj) = 4
+         END_2D
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 )
+            IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN( mbkt(ji,jj), jk)
          END_3D
+         jp_ext_mle(:,:) = 2
+        CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle)
+         DO_2D( 0, 0, 0, 0 )
+           zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm)
+         jk_nlev(:,:) = mld_prof(A2D(nn_hls-1))
+         CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_mle, av_s_mle,   &
+            &                           av_b_mle, av_u_mle, av_v_mle )
+         !
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm)
          END_2D
+!! External gradient
+         CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext )
+         CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle )
+         CALL zdf_osm_external_gradients( mld_prof, zdtdz_mle_ext, zdsdz_mle_ext, zdbdz_mle_ext )
+         CALL zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk )
+         CALL zdf_osm_mle_parameters( mld_prof, hmle, zhmle, zvel_mle, zdiff_mle )
+         !
+         ! Calculate fairly-well-mixed depth zmld & its index mld_prof + lateral zmld-averaged gradients
+         CALL zdf_osm_zmld_horizontal_gradients( Kmm, zmld, zdtdx, zdtdy, zdsdx,   &
+            &                                    zdsdy, zdbds_mle )
+         ! Calculate max vertical FK flux zwb_fk & set logical descriptors
+         CALL zdf_osm_osbl_state_fk( Kmm, zwb_fk, zhbl, zhmle, zwb_ent,   &
+            &                        zdbds_mle )
+         ! Recalculate hmle, zmle, zvel_mle, zdiff_mle & redefine mld_proc to be index for new hmle
+         CALL zdf_osm_mle_parameters( Kmm, zmld, zhmle, zvel_mle, zdiff_mle,   &
+            &                         zdbds_mle, zhbl, zwb0tot )
       ELSE    ! ln_osm_mle
 ! FK not selected, Boundary Layer only.
          lpyc(:,:) = .TRUE.
          lflux(:,:) = .FALSE.
          lmle(:,:) = .FALSE.
          DO_2D( 0, 0, 0, 0 )
           IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE.
+         ! FK not selected, Boundary Layer only.
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            l_pyc(ji,jj)  = .TRUE.
+            l_flux(ji,jj) = .FALSE.
+            l_mle(ji,jj)  = .FALSE.
+            IF ( l_conv(ji,jj) .AND. av_db_bl(ji,jj) < rn_osm_bl_thresh ) l_pyc(ji,jj) = .FALSE.
          END_2D
       ENDIF   ! ln_osm_mle
+! Test if pycnocline well resolved
+      DO_2D( 0, 0, 0, 0 )
+       IF (lconv(ji,jj) ) THEN
+          ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm)
+          IF ( ztmp > 6 ) THEN
+   ! pycnocline well resolved
+            jp_ext(ji,jj) = 1
+          ELSE
+   ! pycnocline poorly resolved
+            jp_ext(ji,jj) = 0
+          ENDIF
+       ELSE
+   ! Stable conditions
+         jp_ext(ji,jj) = 0
+       ENDIF
+      END_2D
+      CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl )
+!      jp_ext = ibld-imld+1
+      CALL zdf_osm_vertical_average(imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml)
+! Rate of change of hbl
+      CALL zdf_osm_calculate_dhdt( zdhdt, zddhdt )
+      DO_2D( 0, 0, 0, 0 )
+       zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need ww here, so subtract it
+            ! adjustment to represent limiting by ocean bottom
+       IF ( zhbl_t(ji,jj) >= gdepw(ji, jj, mbkt(ji,jj) + 1, Kmm ) ) THEN
+          zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm) - depth_tol)! ht(:,:))
+          lpyc(ji,jj) = .FALSE.
+       ENDIF
+      END_2D
+      imld(:,:) = ibld(:,:)           ! use imld to hold previous blayer index
+      ibld(:,:) = 4
+      DO_3D( 0, 0, 0, 0, 4, jpkm1 )
+      !
+      !! External gradient below BL needed both with and w/o FK
+      jk_ext(:,:) = nbld(A2D(nn_hls-1)) + 1
+      CALL zdf_osm_external_gradients( Kmm, jk_ext, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext )   ! ag 19/03
+      !
+      ! Test if pycnocline well resolved
+      !      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                                         Removed with ag 19/03 changes. A change in eddy diffusivity/viscosity
+      !         IF (l_conv(ji,jj) ) THEN                                  should account for this.
+      !            ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,nbld(ji,jj),Kmm)
+      !            IF ( ztmp > 6 ) THEN
+      !               ! pycnocline well resolved
+      !               jk_ext(ji,jj) = 1
+      !            ELSE
+      !               ! pycnocline poorly resolved
+      !               jk_ext(ji,jj) = 0
+      !            ENDIF
+      !         ELSE
+      !            ! Stable conditions
+      !            jk_ext(ji,jj) = 0
+      !         ENDIF
+      !      END_2D
+      !
+      ! Recalculate bl averages using jk_ext & ml averages .... note no rotation of u & v here..
+      jk_nlev(:,:) = nbld(A2D(nn_hls-1))
+      jk_ext(:,:) = 1   ! ag 19/03
+      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_bl,  av_s_bl,    &
+         &                           av_b_bl,  av_u_bl,  av_v_bl,  jk_ext,   av_dt_bl,   &
+         &                           av_ds_bl, av_db_bl, av_du_bl, av_dv_bl )
+      jk_nlev(:,:) = nmld(A2D(nn_hls-1)) - 1
+      jk_ext(:,:) = nbld(A2D(nn_hls-1)) - nmld(A2D(nn_hls-1)) + jk_ext(:,:) + 1   ! ag 19/03
+      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_ml,  av_s_ml,    &
+         &                           av_b_ml,  av_u_ml,  av_v_ml,  jk_ext,   av_dt_ml,   &
+         &                           av_ds_ml, av_db_ml, av_du_ml, av_dv_ml )   ! ag 19/03
+      !
+      ! Rate of change of hbl
+      CALL zdf_osm_calculate_dhdt( zdhdt, zhbl, zdh, zwb_ent, zwb_min,   &
+         &                         zdbdz_bl_ext, zwb_fk_b, zwb_fk, zvel_mle )
+      ! Test if surface boundary layer coupled to bottom
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         l_coup(ji,jj) = .FALSE.   ! ag 19/03
+         zhbl_t(ji,jj) = hbl(ji,jj) + ( zdhdt(ji,jj) - ww(ji,jj,nbld(ji,jj)) ) * rn_Dt   ! Certainly need ww here, so subtract it
+         ! Adjustment to represent limiting by ocean bottom
+         IF ( mbkt(ji,jj) > 2 ) THEN   ! To ensure mbkt(ji,jj) - 2 > 0 so no incorrect array access
+            IF ( zhbl_t(ji,jj) > gdepw(ji, jj,mbkt(ji,jj)-2,Kmm) ) THEN
+               zhbl_t(ji,jj) = MIN( zhbl_t(ji,jj), gdepw(ji,jj,mbkt(ji,jj)-2,Kmm) )   ! ht(:,:))
+               l_pyc(ji,jj)  = .FALSE.
+               l_coup(ji,jj) = .TRUE.   ! ag 19/03
+            END IF
+         END IF
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         nmld(ji,jj) = nbld(ji,jj)           ! use nmld to hold previous blayer index
+         nbld(ji,jj) = 4
+      END_2D
+      !
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 4, jpkm1 )
          IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN
+            ibld(ji,jj) = jk
+            nbld(ji,jj) = jk
+         END IF
+      END_3D
+      !
+      !
+      ! Step through model levels taking account of buoyancy change to determine the effect on dhdt
+      !
+      CALL zdf_osm_timestep_hbl( Kmm, zdhdt, zhbl, zhbl_t, zwb_ent,   &
+         &                       zwb_fk_b )
+      ! Is external level in bounds?
+      !
+      ! Recalculate BL averages and differences using new BL depth
+      jk_nlev(:,:) = nbld(A2D(nn_hls-1))
+      jk_ext(:,:) = 1   ! ag 19/03
+      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_bl,  av_s_bl,    &
+         &                           av_b_bl,  av_u_bl,  av_v_bl,  jk_ext,   av_dt_bl,   &
+         &                           av_ds_bl, av_db_bl, av_du_bl, av_dv_bl )
+      !
+      CALL zdf_osm_pycnocline_thickness( Kmm, zdh, zhml, zdhdt, zhbl,   &
+         &                               zwb_ent, zdbdz_bl_ext, zwb_fk_b )
+      !
+      ! Reset l_pyc before calculating terms in the flux-gradient relationship
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh .OR. nbld(ji,jj) >= mbkt(ji,jj) - 2 .OR.   &
+            & nbld(ji,jj) - nmld(ji,jj) == 1   .OR. zdhdt(ji,jj) < 0.0_wp ) THEN   ! ag 19/03
+            l_pyc(ji,jj) = .FALSE.   ! ag 19/03
+            IF ( nbld(ji,jj) >= mbkt(ji,jj) -2 ) THEN
+               nmld(ji,jj) = nbld(ji,jj) - 1                                               ! ag 19/03
+               zdh(ji,jj)  = gdepw(ji,jj,nbld(ji,jj),Kmm) - gdepw(ji,jj,nmld(ji,jj),Kmm)   ! ag 19/03
+               zhml(ji,jj) = gdepw(ji,jj,nmld(ji,jj),Kmm)                                  ! ag 19/03
+               dh(ji,jj)   = zdh(ji,jj)                                                    ! ag 19/03
+               hml(ji,jj)  = hbl(ji,jj) - dh(ji,jj)                                        ! ag 19/03
+            ENDIF
+         ENDIF                                              ! ag 19/03
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )               ! Limit delta for shallow boundary layers for calculating
+         dstokes(ji,jj) = MIN ( dstokes(ji,jj), hbl(ji,jj) / 3.0_wp )   !    flux-gradient terms
+      END_2D
+      !
+      !
+      ! Average over the depth of the mixed layer in the convective boundary layer
+      !      jk_ext = nbld - nmld + 1
+      ! Recalculate ML averages and differences using new ML depth
+      jk_nlev(:,:) = nmld(A2D(nn_hls-1)) - 1
+      jk_ext(:,:) = nbld(A2D(nn_hls-1)) - nmld(A2D(nn_hls-1)) + jk_ext(:,:) + 1   ! ag 19/03
+      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_ml,  av_s_ml,    &
+         &                           av_b_ml,  av_u_ml,  av_v_ml,  jk_ext,   av_dt_ml,   &
+         &                           av_ds_ml, av_db_ml, av_du_ml, av_dv_ml )
+      !
+      jk_ext(:,:) = nbld(A2D(nn_hls-1)) + 1
+      CALL zdf_osm_external_gradients( Kmm, jk_ext, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext )
+      ! Rotate mean currents and changes onto wind aligned co-ordinates
+      CALL zdf_osm_velocity_rotation( av_u_ml,  av_v_ml  )
+      CALL zdf_osm_velocity_rotation( av_du_ml, av_dv_ml )
+      CALL zdf_osm_velocity_rotation( av_u_bl,  av_v_bl  )
+      CALL zdf_osm_velocity_rotation( av_du_bl, av_dv_bl )
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      CALL zdf_osm_diffusivity_viscosity( Kbb, Kmm, zdiffut, zviscos, zhbl,    &
+         &                                zhml, zdh, zdhdt, zshear, zwb_ent,   &
+         &                                zwb_min )
+      !
+      ! Calculate non-gradient components of the flux-gradient relationships
+      ! --------------------------------------------------------------------
+      jk_ext(:,:) = 1   ! ag 19/03
+      CALL zdf_osm_fgr_terms( Kmm, jk_ext, zhbl, zhml, zdh,                              &
+         &                    zdhdt, zshear, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext,   &
+         &                    zdiffut, zviscos )
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Need to put in code for contributions that are applied explicitly to
+      ! the prognostic variables
+      !  1. Entrainment flux
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      ! Rotate non-gradient velocity terms back to model reference frame
+      jk_nlev(:,:) = nbld(A2D(nn_hls-1))
+      CALL zdf_osm_velocity_rotation( ghamu, ghamv, .FALSE.,  2, jk_nlev )
+      !
+      ! KPP-style Ri# mixing
+      IF ( ln_kpprimix ) THEN
+         jkflt = jpk
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            IF ( nbld(ji,jj) < jkflt ) jkflt = nbld(ji,jj)
+         END_2D
+         DO jk = jkflt+1, jpkm1
+            ! Shear production at uw- and vw-points (energy conserving form)
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+               z2du(ji,jj) = 0.5_wp * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) * ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) *   &
+                  &          wumask(ji,jj,jk) / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) )
+               z2dv(ji,jj) = 0.5_wp * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj,jk,Kmm) ) * ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj,jk,Kbb) ) *   &
+                  &          wvmask(ji,jj,jk) / ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) )
+            END_2D
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+               IF ( jk > nbld(ji,jj) ) THEN
+                  ! Shear prod. at w-point weightened by mask
+                  zesh2 = ( z2du(ji-1,jj) + z2du(ji,jj) ) / MAX( 1.0_wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) +   &
+                     &    ( z2dv(ji,jj-1) + z2dv(ji,jj) ) / MAX( 1.0_wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
+                  ! Local Richardson number
+                  zri     = MAX( rn2b(ji,jj,jk), 0.0_wp ) / MAX( zesh2, epsln )
+                  zfri    = MIN( zri / rn_riinfty, 1.0_wp )
+                  zfri    = ( 1.0_wp - zfri * zfri )
+                  zrimix  =  zfri * zfri  * zfri * wmask(ji, jj, jk)
+                  zdiffut(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), zrimix*rn_difri )
+                  zviscos(ji,jj,jk) = MAX( zviscos(ji,jj,jk), zrimix*rn_difri )
+               END IF
+            END_2D
+         END DO
+      END IF   ! ln_kpprimix = .true.
+      !
+      ! KPP-style set diffusivity large if unstable below BL
+      IF ( ln_convmix) THEN
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            DO jk = nbld(ji,jj) + 1, jpkm1
+               IF ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1e-12_wp ) zdiffut(ji,jj,jk) = MAX( rn_difconv, zdiffut(ji,jj,jk) )
+            END DO
+         END_2D
+      END IF   ! ln_convmix = .true.
+      !
+      IF ( ln_osm_mle ) THEN   ! Set up diffusivity and non-gradient mixing
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            IF ( l_flux(ji,jj) ) THEN   ! MLE mixing extends below boundary layer
+               ! Calculate MLE flux contribution from surface fluxes
+               DO jk = 1, nbld(ji,jj)
+                  znd = gdepw(ji,jj,jk,Kmm) / MAX( zhbl(ji,jj), epsln )
+                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - ( swth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0_wp - znd )
+                  ghams(ji,jj,jk) = ghams(ji,jj,jk) - sws0(ji,jj) * ( 1.0_wp - znd )
+               END DO
+               DO jk = 1, mld_prof(ji,jj)
+                  znd = gdepw(ji,jj,jk,Kmm) / MAX( zhmle(ji,jj), epsln )
+                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + ( swth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0_wp - znd )
+                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + sws0(ji,jj) * ( 1.0_wp -znd )
+               END DO
+               ! Viscosity for MLEs
+               DO jk = 1, mld_prof(ji,jj)
+                  znd = -1.0_wp * gdepw(ji,jj,jk,Kmm) / MAX( zhmle(ji,jj), epsln )
+                  zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0_wp - ( 2.0_wp * znd + 1.0_wp )**2 ) *   &
+                     &                                    ( 1.0_wp + 5.0_wp / 21.0_wp * ( 2.0_wp * znd + 1.0_wp )**2 )
+               END DO
+            ELSE   ! Surface transports limited to OSBL
+               ! Viscosity for MLEs
+               DO jk = 1, mld_prof(ji,jj)
+                  znd = -1.0_wp * gdepw(ji,jj,jk,Kmm) / MAX( zhmle(ji,jj), epsln )
+                  zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0_wp - ( 2.0_wp * znd + 1.0_wp )**2 ) *   &
+                     &                                    ( 1.0_wp + 5.0_wp / 21.0_wp * ( 2.0_wp * znd + 1.0_wp )**2 )
+               END DO
+            END IF
+         END_2D
+      ENDIF
+      !
+      ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids
+      ! CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp )
+      ! GN 25/8: need to change tmask --> wmask
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+         p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+         p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk)
+      END_3D
+      !
+      IF ( ln_dia_osm ) THEN
+         SELECT CASE (nn_osm_wave)
+            ! Stokes drift set by assumimg onstant La#=0.3 (=0) or Pierson-Moskovitz spectrum (=1)
+         CASE(0:1)
+            CALL zdf_osm_iomput( "us_x", tmask(A2D(0),1) * sustke(A2D(0)) * scos_wind(A2D(0)) )   ! x surface Stokes drift
+            CALL zdf_osm_iomput( "us_y", tmask(A2D(0),1) * sustke(A2D(0)) * scos_wind(A2D(0)) )   ! y surface Stokes drift
+            CALL zdf_osm_iomput( "wind_wave_abs_power", 1000.0_wp * rho0 * tmask(A2D(0),1) * sustar(A2D(0))**2 * sustke(A2D(0)) )
+            ! Stokes drift read in from sbcwave  (=2).
+         CASE(2:3)
+            CALL zdf_osm_iomput( "us_x",   ut0sd(A2D(0)) * umask(A2D(0),1) )                         ! x surface Stokes drift
+            CALL zdf_osm_iomput( "us_y",   vt0sd(A2D(0)) * vmask(A2D(0),1) )                         ! y surface Stokes drift
+            CALL zdf_osm_iomput( "wmp",    wmp(A2D(0)) * tmask(A2D(0),1) )                           ! Wave mean period
+            CALL zdf_osm_iomput( "hsw",    hsw(A2D(0)) * tmask(A2D(0),1) )                           ! Significant wave height
+            CALL zdf_osm_iomput( "wmp_NP", ( 2.0_wp * rpi * 1.026_wp / ( 0.877_wp * grav ) ) *   &   ! Wave mean period from NP
+               &                           wndm(A2D(0)) * tmask(A2D(0),1) )                          !    spectrum
+            CALL zdf_osm_iomput( "hsw_NP", ( 0.22_wp / grav ) * wndm(A2D(0))**2 * tmask(A2D(0),1) )  ! Significant wave height from
+            !                                                                                        !    NP spectrum
+            CALL zdf_osm_iomput( "wndm",   wndm(A2D(0)) * tmask(A2D(0),1) )                          ! U_10
+            CALL zdf_osm_iomput( "wind_wave_abs_power", 1000.0_wp * rho0 * tmask(A2D(0),1) * sustar(A2D(0))**2 *   &
+               &                                        SQRT( ut0sd(A2D(0))**2 + vt0sd(A2D(0))**2 ) )
+         END SELECT
+         CALL zdf_osm_iomput( "zwth0",           tmask(A2D(0),1) * swth0(A2D(0))     )      ! <Tw_0>
+         CALL zdf_osm_iomput( "zws0",            tmask(A2D(0),1) * sws0(A2D(0))      )      ! <Sw_0>
+         CALL zdf_osm_iomput( "zwb0",            tmask(A2D(0),1) * swb0(A2D(0))      )      ! <Sw_0>
+         CALL zdf_osm_iomput( "zwbav",           tmask(A2D(0),1) * swth0(A2D(0))     )      ! Upward BL-avged turb buoyancy flux
+         CALL zdf_osm_iomput( "ibld",            tmask(A2D(0),1) * nbld(A2D(0))      )      ! Boundary-layer max k
+         CALL zdf_osm_iomput( "zdt_bl",          tmask(A2D(0),1) * av_dt_bl(A2D(0))  )      ! dt at ml base
+         CALL zdf_osm_iomput( "zds_bl",          tmask(A2D(0),1) * av_ds_bl(A2D(0))  )      ! ds at ml base
+         CALL zdf_osm_iomput( "zdb_bl",          tmask(A2D(0),1) * av_db_bl(A2D(0))  )      ! db at ml base
+         CALL zdf_osm_iomput( "zdu_bl",          tmask(A2D(0),1) * av_du_bl(A2D(0))  )      ! du at ml base
+         CALL zdf_osm_iomput( "zdv_bl",          tmask(A2D(0),1) * av_dv_bl(A2D(0))  )      ! dv at ml base
+         CALL zdf_osm_iomput( "dh",              tmask(A2D(0),1) * dh(A2D(0))        )      ! Initial boundary-layer depth
+         CALL zdf_osm_iomput( "hml",             tmask(A2D(0),1) * hml(A2D(0))       )      ! Initial boundary-layer depth
+         CALL zdf_osm_iomput( "zdt_ml",          tmask(A2D(0),1) * av_dt_ml(A2D(0))  )      ! dt at ml base
+         CALL zdf_osm_iomput( "zds_ml",          tmask(A2D(0),1) * av_ds_ml(A2D(0))  )      ! ds at ml base
+         CALL zdf_osm_iomput( "zdb_ml",          tmask(A2D(0),1) * av_db_ml(A2D(0))  )      ! db at ml base
+         CALL zdf_osm_iomput( "dstokes",         tmask(A2D(0),1) * dstokes(A2D(0))   )      ! Stokes drift penetration depth
+         CALL zdf_osm_iomput( "zustke",          tmask(A2D(0),1) * sustke(A2D(0))    )      ! Stokes drift magnitude at T-points
+         CALL zdf_osm_iomput( "zwstrc",          tmask(A2D(0),1) * swstrc(A2D(0))    )      ! Convective velocity scale
+         CALL zdf_osm_iomput( "zwstrl",          tmask(A2D(0),1) * swstrl(A2D(0))    )      ! Langmuir velocity scale
+         CALL zdf_osm_iomput( "zustar",          tmask(A2D(0),1) * sustar(A2D(0))    )      ! Friction velocity scale
+         CALL zdf_osm_iomput( "zvstr",           tmask(A2D(0),1) * svstr(A2D(0))     )      ! Mixed velocity scale
+         CALL zdf_osm_iomput( "zla",             tmask(A2D(0),1) * sla(A2D(0))       )      ! Langmuir #
+         CALL zdf_osm_iomput( "wind_power",      1000.0_wp * rho0 * tmask(A2D(0),1) *   &   ! BL depth internal to zdf_osm routine
+            &                                    sustar(A2D(0))**3 )
+         CALL zdf_osm_iomput( "wind_wave_power", 1000.0_wp * rho0 * tmask(A2D(0),1) *   &
+            &                                    sustar(A2D(0))**2 * sustke(A2D(0))  )
+         CALL zdf_osm_iomput( "zhbl",            tmask(A2D(0),1) * zhbl(A2D(0))      )      ! BL depth internal to zdf_osm routine
+         CALL zdf_osm_iomput( "zhml",            tmask(A2D(0),1) * zhml(A2D(0))      )      ! ML depth internal to zdf_osm routine
+         CALL zdf_osm_iomput( "imld",            tmask(A2D(0),1) * nmld(A2D(0))      )      ! Index for ML depth internal to zdf_osm
+         !                                                                                  !    routine
+         CALL zdf_osm_iomput( "jp_ext",          tmask(A2D(0),1) * jk_ext(A2D(0))    )      ! =1 if pycnocline resolved internal to
+         !                                                                                  !    zdf_osm routine
+         CALL zdf_osm_iomput( "j_ddh",           tmask(A2D(0),1) * n_ddh(A2D(0))     )      ! Index forpyc thicknessh internal to
+         !                                                                                  !    zdf_osm routine
+         CALL zdf_osm_iomput( "zshear",          tmask(A2D(0),1) * zshear(A2D(0))    )      ! Shear production of TKE internal to
+         !                                                                                  !    zdf_osm routine
+         CALL zdf_osm_iomput( "zdh",             tmask(A2D(0),1) * zdh(A2D(0))       )      ! Pyc thicknessh internal to zdf_osm
+         !                                                                                  !    routine
+         CALL zdf_osm_iomput( "zhol",            tmask(A2D(0),1) * shol(A2D(0))      )      ! ML depth internal to zdf_osm routine
+         CALL zdf_osm_iomput( "zwb_ent",         tmask(A2D(0),1) * zwb_ent(A2D(0))   )      ! Upward turb buoyancy entrainment flux
+         CALL zdf_osm_iomput( "zt_ml",           tmask(A2D(0),1) * av_t_ml(A2D(0))   )      ! Average T in ML
+         CALL zdf_osm_iomput( "zmld",            tmask(A2D(0),1) * zmld(A2D(0))      )      ! FK target layer depth
+         CALL zdf_osm_iomput( "zwb_fk",          tmask(A2D(0),1) * zwb_fk(A2D(0))    )      ! FK b flux
+         CALL zdf_osm_iomput( "zwb_fk_b",        tmask(A2D(0),1) * zwb_fk_b(A2D(0))  )      ! FK b flux averaged over ML
+         CALL zdf_osm_iomput( "mld_prof",        tmask(A2D(0),1) * mld_prof(A2D(0))  )      ! FK layer max k
+         CALL zdf_osm_iomput( "zdtdx",           umask(A2D(0),1) * zdtdx(A2D(0))     )      ! FK dtdx at u-pt
+         CALL zdf_osm_iomput( "zdtdy",           vmask(A2D(0),1) * zdtdy(A2D(0))     )      ! FK dtdy at v-pt
+         CALL zdf_osm_iomput( "zdsdx",           umask(A2D(0),1) * zdsdx(A2D(0))     )      ! FK dtdx at u-pt
+         CALL zdf_osm_iomput( "zdsdy",           vmask(A2D(0),1) * zdsdy(A2D(0))     )      ! FK dsdy at v-pt
+         CALL zdf_osm_iomput( "dbdx_mle",        umask(A2D(0),1) * dbdx_mle(A2D(0))  )      ! FK dbdx at u-pt
+         CALL zdf_osm_iomput( "dbdy_mle",        vmask(A2D(0),1) * dbdy_mle(A2D(0))  )      ! FK dbdy at v-pt
+         CALL zdf_osm_iomput( "zdiff_mle",       tmask(A2D(0),1) * zdiff_mle(A2D(0)) )      ! FK diff in MLE at t-pt
+         CALL zdf_osm_iomput( "zvel_mle",        tmask(A2D(0),1) * zdiff_mle(A2D(0)) )      ! FK diff in MLE at t-pt
+      END IF
+      !
+      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and
+      !    v grids
+      IF ( .NOT. l_istiled .OR. ntile == nijtile ) THEN   ! Finalise ghamu, ghamv, hbl, and hmle only after full domain has been
+         !                                                !    processed
+         IF ( nn_hls == 1 ) CALL lbc_lnk( 'zdfosm', ghamu, 'W', 1.0_wp,   &
+            &                                       ghamv, 'W', 1.0_wp )
+         DO jk = 2, jpkm1
+            DO jj = Njs0, Nje0
+               DO ji = Nis0, Nie0
+                  ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) /   &
+                     &              MAX( 1.0_wp, tmask(ji,jj,jk) + tmask (ji+1,jj,jk) ) * umask(ji,jj,jk)
+                  ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) /   &
+                     &              MAX( 1.0_wp, tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk)
+                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) * tmask(ji,jj,jk)
+                  ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged)
+         CALL lbc_lnk( 'zdfosm', hbl,  'T', 1.0_wp,   &
+            &                    hmle, 'T', 1.0_wp )
+         !
+         CALL zdf_osm_iomput( "ghamt", tmask * ghamt       )   ! <Tw_NL>
+         CALL zdf_osm_iomput( "ghams", tmask * ghams       )   ! <Sw_NL>
+         CALL zdf_osm_iomput( "ghamu", umask * ghamu       )   ! <uw_NL>
+         CALL zdf_osm_iomput( "ghamv", vmask * ghamv       )   ! <vw_NL>
+         CALL zdf_osm_iomput( "hbl",   tmask(:,:,1) * hbl  )   ! Boundary-layer depth
+         CALL zdf_osm_iomput( "hmle",  tmask(:,:,1) * hmle )   ! FK layer depth
+      END IF
+      !
+   END SUBROUTINE zdf_osm
+   SUBROUTINE zdf_osm_vertical_average( Kbb, Kmm, knlev, pt, ps,   &
+      &                                 pb, pu, pv, kp_ext, pdt,   &
+      &                                 pds, pdb, pdu, pdv )
+      !!---------------------------------------------------------------------
+      !!                ***  ROUTINE zdf_vertical_average  ***
+      !!
+      !! ** Purpose : Determines vertical averages from surface to knlev,
+      !!              and optionally the differences between these vertical
+      !!              averages and values at an external level
+      !!
+      !! ** Method  : Averages are calculated from the surface to knlev.
+      !!              The external level used to calculate differences is
+      !!              knlev+kp_ext
+      !!----------------------------------------------------------------------
+      INTEGER,                            INTENT(in   )           ::   Kbb, Kmm   ! Ocean time-level indices
+      INTEGER,  DIMENSION(A2D(nn_hls-1)), INTENT(in   )           ::   knlev      ! Number of levels to average over.
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out)           ::   pt, ps     ! Average temperature and salinity
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out)           ::   pb         ! Average buoyancy
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out)           ::   pu, pv     ! Average current components
+      INTEGER,  DIMENSION(A2D(nn_hls-1)), INTENT(in   ), OPTIONAL ::   kp_ext     ! External-level offsets
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pdt        ! Difference between average temperature,
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pds        !    salinity,
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pdb        !    buoyancy, and
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pdu, pdv   !    velocity components and the OSBL
+      !!
+      INTEGER                              ::   jk, jkflt, jkmax, ji, jj   ! Loop indices
+      INTEGER                              ::   ibld_ext                   ! External-layer index
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zthick                     ! Layer thickness
+      REAL(wp)                             ::   zthermal                   ! Thermal expansion coefficient
+      REAL(wp)                             ::   zbeta                      ! Haline contraction coefficient
+      !!----------------------------------------------------------------------
+      !
+      ! Averages over depth of boundary layer
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pt(ji,jj) = 0.0_wp
+         ps(ji,jj) = 0.0_wp
+         pu(ji,jj) = 0.0_wp
+         pv(ji,jj) = 0.0_wp
+      END_2D
+      zthick(:,:) = epsln
+      jkflt = jpk
+      jkmax = 0
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( knlev(ji,jj) < jkflt ) jkflt = knlev(ji,jj)
+         IF ( knlev(ji,jj) > jkmax ) jkmax = knlev(ji,jj)
+      END_2D
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkflt )   ! Upper, flat part of layer
+         zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm)
+         pt(ji,jj)     = pt(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)
+         ps(ji,jj)     = ps(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
+         pu(ji,jj)     = pu(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        &
+            &                               ( uu(ji,jj,jk,Kbb) + uu(ji - 1,jj,jk,Kbb) ) /           &
+            &                               MAX( 1.0_wp , umask(ji,jj,jk) + umask(ji - 1,jj,jk) )
+         pv(ji,jj)     = pv(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        &
+            &                               ( vv(ji,jj,jk,Kbb) + vv(ji,jj - 1,jk,Kbb) ) /           &
+            &                               MAX( 1.0_wp , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) )
+      END_3D
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jkflt+1, jkmax )   ! Lower, non-flat part of layer
+         IF ( knlev(ji,jj) >= jk ) THEN
+            zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm)
+            pt(ji,jj)     = pt(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)
+            ps(ji,jj)     = ps(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
+            pu(ji,jj)     = pu(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        &
+               &                               ( uu(ji,jj,jk,Kbb) + uu(ji - 1,jj,jk,Kbb) ) /           &
+               &                               MAX( 1.0_wp , umask(ji,jj,jk) + umask(ji - 1,jj,jk) )
+            pv(ji,jj)     = pv(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        &
+               &                               ( vv(ji,jj,jk,Kbb) + vv(ji,jj - 1,jk,Kbb) ) /           &
+               &                               MAX( 1.0_wp , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) )
+         END IF
+      END_3D
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pt(ji,jj) = pt(ji,jj) / zthick(ji,jj)
+         ps(ji,jj) = ps(ji,jj) / zthick(ji,jj)
+         pu(ji,jj) = pu(ji,jj) / zthick(ji,jj)
+         pv(ji,jj) = pv(ji,jj) / zthick(ji,jj)
+         zthermal  = rab_n(ji,jj,1,jp_tem)   ! ideally use nbld not 1??
+         zbeta     = rab_n(ji,jj,1,jp_sal)
+         pb(ji,jj) = grav * zthermal * pt(ji,jj) - grav * zbeta * ps(ji,jj)
+      END_2D
+      !
+      ! Differences between vertical averages and values at an external layer
+      IF ( PRESENT( kp_ext ) ) THEN
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            ibld_ext = knlev(ji,jj) + kp_ext(ji,jj)
+            IF ( ibld_ext <= mbkt(ji,jj)-1 ) THEN   ! ag 09/03
+               ! Two external levels are available
+               pdt(ji,jj) = pt(ji,jj) - ts(ji,jj,ibld_ext,jp_tem,Kmm)
+               pds(ji,jj) = ps(ji,jj) - ts(ji,jj,ibld_ext,jp_sal,Kmm)
+               pdu(ji,jj) = pu(ji,jj) - ( uu(ji,jj,ibld_ext,Kbb) + uu(ji-1,jj,ibld_ext,Kbb ) ) /              &
+                  &                        MAX(1.0_wp , umask(ji,jj,ibld_ext ) + umask(ji-1,jj,ibld_ext ) )
+               pdv(ji,jj) = pv(ji,jj) - ( vv(ji,jj,ibld_ext,Kbb) + vv(ji,jj-1,ibld_ext,Kbb ) ) /              &
+                  &                        MAX(1.0_wp , vmask(ji,jj,ibld_ext ) + vmask(ji,jj-1,ibld_ext ) )
+               zthermal   = rab_n(ji,jj,1,jp_tem)   ! ideally use nbld not 1??
+               zbeta      = rab_n(ji,jj,1,jp_sal)
+               pdb(ji,jj) = grav * zthermal * pdt(ji,jj) - grav * zbeta * pds(ji,jj)
+            ELSE
+               pdt(ji,jj) = 0.0_wp
+               pds(ji,jj) = 0.0_wp
+               pdu(ji,jj) = 0.0_wp
+               pdv(ji,jj) = 0.0_wp
+               pdb(ji,jj) = 0.0_wp
+            ENDIF
+         END_2D
+      END IF
+      !
+   END SUBROUTINE zdf_osm_vertical_average
+   SUBROUTINE zdf_osm_velocity_rotation_2d( pu, pv, fwd )
+      !!---------------------------------------------------------------------
+      !!            ***  ROUTINE zdf_velocity_rotation_2d  ***
+      !!
+      !! ** Purpose : Rotates frame of reference of velocity components pu and
+      !!              pv (2d)
+      !!
+      !! ** Method : The velocity components are rotated into (fwd=.TRUE.) or
+      !!             from (fwd=.FALSE.) the frame specified by scos_wind and
+      !!             ssin_wind
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp),           INTENT(inout), DIMENSION(jpi,jpj) ::   pu, pv   ! Components of current
+      LOGICAL,  OPTIONAL, INTENT(in   )                     ::   fwd      ! Forward (default) or reverse rotation
+      !!
+      INTEGER  ::   ji, jj       ! Loop indices
+      REAL(wp) ::   ztmp, zfwd   ! Auxiliary variables
+      !!----------------------------------------------------------------------
+      !
+      zfwd = 1.0_wp
+      IF( PRESENT(fwd) .AND. ( .NOT. fwd ) ) zfwd = -1.0_wp
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         ztmp      = pu(ji,jj)
+         pu(ji,jj) = pu(ji,jj) * scos_wind(ji,jj) + zfwd * pv(ji,jj) * ssin_wind(ji,jj)
+         pv(ji,jj) = pv(ji,jj) * scos_wind(ji,jj) - zfwd * ztmp      * ssin_wind(ji,jj)
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_velocity_rotation_2d
+   SUBROUTINE zdf_osm_velocity_rotation_3d( pu, pv, fwd, ktop, knlev )
+      !!---------------------------------------------------------------------
+      !!            ***  ROUTINE zdf_velocity_rotation_3d  ***
+      !!
+      !! ** Purpose : Rotates frame of reference of velocity components pu and
+      !!              pv (3d)
+      !!
+      !! ** Method : The velocity components are rotated into (fwd=.TRUE.) or
+      !!             from (fwd=.FALSE.) the frame specified by scos_wind and
+      !!             ssin_wind; optionally, the rotation can be restricted at
+      !!             each water column to span from the a minimum index ktop to
+      !!             the depth index specified in array knlev
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp),           INTENT(inout), DIMENSION(jpi,jpj,jpk)   ::   pu, pv   ! Components of current
+      LOGICAL,  OPTIONAL, INTENT(in   )                           ::   fwd      ! Forward (default) or reverse rotation
+      INTEGER,  OPTIONAL, INTENT(in   )                           ::   ktop     ! Minimum depth index
+      INTEGER,  OPTIONAL, INTENT(in   ), DIMENSION(A2D(nn_hls-1)) ::   knlev    ! Array of maximum depth indices
+      !!
+      INTEGER  ::   ji, jj, jk, jktop, jkmax   ! Loop indices
+      REAL(wp) ::   ztmp, zfwd                 ! Auxiliary variables
+      LOGICAL  ::   llkbot                     ! Auxiliary variable
+      !!----------------------------------------------------------------------
+      !
+      zfwd = 1.0_wp
+      IF( PRESENT(fwd) .AND. ( .NOT. fwd ) ) zfwd = -1.0_wp
+      jktop = 1
+      IF( PRESENT(ktop) ) jktop = ktop
+      IF( PRESENT(knlev) ) THEN
+         jkmax = 0
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            IF ( knlev(ji,jj) > jkmax ) jkmax = knlev(ji,jj)
+         END_2D
+         llkbot = .FALSE.
+      ELSE
+         jkmax = jpk
+         llkbot = .TRUE.
+      END IF
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jktop, jkmax )
+         IF ( llkbot .OR. knlev(ji,jj) >= jk ) THEN
+            ztmp         = pu(ji,jj,jk)
+            pu(ji,jj,jk) = pu(ji,jj,jk) * scos_wind(ji,jj) + zfwd * pv(ji,jj,jk) * ssin_wind(ji,jj)
+            pv(ji,jj,jk) = pv(ji,jj,jk) * scos_wind(ji,jj) - zfwd * ztmp         * ssin_wind(ji,jj)
+         END IF
+      END_3D
+      !
+   END SUBROUTINE zdf_osm_velocity_rotation_3d
+   SUBROUTINE zdf_osm_osbl_state( Kmm, pwb_ent, pwb_min, pshear, phbl,   &
+      &                           phml, pdh )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE zdf_osm_osbl_state  ***
+      !!
+      !! ** Purpose : Determines the state of the OSBL, stable/unstable,
+      !!              shear/ noshear. Also determines shear production,
+      !!              entrainment buoyancy flux and interfacial Richardson
+      !!              number
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                            INTENT(in   ) ::   Kmm       ! Ocean time-level index
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pwb_ent   ! Buoyancy fluxes at base
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pwb_min   !    of well-mixed layer
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pshear    ! Production of TKE due to shear across the pycnocline
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl      ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phml      ! ML depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdh       ! Pycnocline depth
+      !!
+      INTEGER :: jj, ji   ! Loop indices
+      !!
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zekman
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zri_p, zri_b   ! Richardson numbers
+      REAL(wp)                           ::   zshear_u, zshear_v, zwb_shr
+      REAL(wp)                           ::   zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes
+      !!
+      REAL(wp), PARAMETER ::   pp_a_shr         = 0.4_wp,  pp_b_shr    = 6.5_wp,  pp_a_wb_s = 0.8_wp
+      REAL(wp), PARAMETER ::   pp_alpha_c       = 0.2_wp,  pp_alpha_lc = 0.03_wp
+      REAL(wp), PARAMETER ::   pp_alpha_ls      = 0.06_wp, pp_alpha_s  = 0.15_wp
+      REAL(wp), PARAMETER ::   pp_ri_p_thresh   = 27.0_wp
+      REAL(wp), PARAMETER ::   pp_ri_c          = 0.25_wp
+      REAL(wp), PARAMETER ::   pp_ek            = 4.0_wp
+      REAL(wp), PARAMETER ::   pp_large         = -1e10_wp
+      !!----------------------------------------------------------------------
+      !
+      ! Initialise arrays
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         l_conv(ji,jj)  = .FALSE.
+         l_shear(ji,jj) = .FALSE.
+         n_ddh(ji,jj)   = 1
+      END_2D
+      ! Initialise INTENT(  out) arrays
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pwb_ent(ji,jj) = pp_large
+         pwb_min(ji,jj) = pp_large
+      END_2D
+      !
+      ! Determins stability and set flag l_conv
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( shol(ji,jj) < 0.0_wp ) THEN
+            l_conv(ji,jj) = .TRUE.
+         ELSE
+            l_conv(ji,jj) = .FALSE.
          ENDIF
+      END_3D
+!
+! Step through model levels taking account of buoyancy change to determine the effect on dhdt
+!
+      CALL zdf_osm_timestep_hbl( zdhdt )
+! is external level in bounds?
+      CALL zdf_osm_vertical_average( ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl )
+!
+!
+! Check to see if lpyc needs to be changed
+      CALL zdf_osm_pycnocline_thickness( dh, zdh )
+      DO_2D( 0, 0, 0, 0 )
+       IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE.
+      END_2D
+      dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. )  !  Limit delta for shallow boundary layers for calculating flux-gradient terms.
+!
+    ! Average over the depth of the mixed layer in the convective boundary layer
+!      jp_ext = ibld - imld +1
+      CALL zdf_osm_vertical_average( imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml )
+    ! rotate mean currents and changes onto wind align co-ordinates
+    !
+     CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml )
+     CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl )
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Pycnocline gradients for scalars and velocity
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext )
+      CALL zdf_osm_pycnocline_scalar_profiles( zdtdz_pyc, zdsdz_pyc, zdbdz_pyc, zalpha_pyc )
+      CALL zdf_osm_pycnocline_shear_profiles( zdudz_pyc, zdvdz_pyc )
+       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+       ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship
+       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+       CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos )
+       !
+       ! calculate non-gradient components of the flux-gradient relationships
+       !
+! Stokes term in scalar flux, flux-gradient relationship
+       WHERE ( lconv )
+          zsc_wth_1 = zwstrl**3 * zwth0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln)
+          !
+          zsc_ws_1 = zwstrl**3 * zws0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )
+       ELSEWHERE
+          zsc_wth_1 = 2.0 * zwthav
+          !
+          zsc_ws_1 = 2.0 * zwsav
+       ENDWHERE
+       DO_2D( 0, 0, 0, 0 )
+         IF ( lconv(ji,jj) ) THEN
+           DO jk = 2, imld(ji,jj)
+              zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+              ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj)
+              !
+              ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) *  zsc_ws_1(ji,jj)
+           END DO ! end jk loop
+         ELSE     ! else for if (lconv)
+ ! Stable conditions
+            DO jk = 2, ibld(ji,jj)
+               zznd_d=gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) &
+                    &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj)
+               !
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) &
+                    &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) *  zsc_ws_1(ji,jj)
+            END DO
+         ENDIF               ! endif for check on lconv
+       END_2D
+! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use zvstr since term needs to go to zero as zwstrl goes to zero)
+       WHERE ( lconv )
+          zsc_uw_1 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MAX( ( 1.0 - 1.0 * 6.5 * zla**(8.0/3.0) ), 0.2 )
+          zsc_uw_2 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MIN( zla**(8.0/3.0) + epsln, 0.12 )
+          zsc_vw_1 = ff_t * zhml * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / ( ( zvstr**3 + 0.5 * zwstrc**3 )**(2.0/3.0) + epsln )
+       ELSEWHERE
+          zsc_uw_1 = zustar**2
+          zsc_vw_1 = ff_t * zhbl * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / (zvstr**2 + epsln)
+       ENDWHERE
+       IF(ln_dia_osm) THEN
+          IF ( iom_use("ghamu_00") ) CALL iom_put( "ghamu_00", wmask*ghamu )
+          IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv )
+       END IF
+       DO_2D( 0, 0, 0, 0 )
+          IF ( lconv(ji,jj) ) THEN
+             DO jk = 2, imld(ji,jj)
+                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +      ( -0.05 * EXP ( -0.4 * zznd_d )   * zsc_uw_1(ji,jj)   &
+                     &          +                        0.00125 * EXP (      - zznd_d )   * zsc_uw_2(ji,jj) ) &
+                     &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) )
+!
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 *  0.15 * EXP (      - zznd_d )                       &
+                     &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj)
+             END DO   ! end jk loop
+          ELSE
+! Stable conditions
+             DO jk = 2, ibld(ji,jj) ! corrected to ibld
+                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 *   1.3 * EXP ( -0.5 * zznd_d )                       &
+                     &                                   * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj)
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp
+             END DO   ! end jk loop
+          ENDIF
+       END_2D
+! Buoyancy term in flux-gradient relationship [note : includes ROI ratio (X0.3) and pressure (X0.5)]
+       WHERE ( lconv )
+          zsc_wth_1 = zwbav * zwth0 * ( 1.0 + EXP ( 0.2 * zhol ) ) / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )
+          zsc_ws_1  = zwbav * zws0  * ( 1.0 + EXP ( 0.2 * zhol ) ) / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )
+       ELSEWHERE
+          zsc_wth_1 = 0._wp
+          zsc_ws_1 = 0._wp
+       ENDWHERE
+       DO_2D( 0, 0, 0, 0 )
+          IF (lconv(ji,jj) ) THEN
+             DO jk = 2, imld(ji,jj)
+                zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+                ! calculate turbulent length scale
+                zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           &
+                     &     * ( 1.0 - EXP ( -15.0 * (     1.1 - zznd_ml          ) ) )
+                zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           &
+                     &     * ( 1.0 - EXP ( - 5.0 * (     1.0 - zznd_ml          ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) )
+                zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0 / 2.0)
+                ! non-gradient buoyancy terms
+                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml )
+                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 *  zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml )
+             END DO
+             IF ( lpyc(ji,jj) ) THEN
+               ztau_sc_u(ji,jj) = zhml(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird
+               ztau_sc_u(ji,jj) = ztau_sc_u(ji,jj) * ( 1.4 -0.4 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )**1.5 )
+               zwth_ent =  -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj)
+               zws_ent =  -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj)
+! Cubic profile used for buoyancy term
+               za_cubic = 0.755 * ztau_sc_u(ji,jj)
+               zb_cubic = 0.25 * ztau_sc_u(ji,jj)
+               DO jk = 2, ibld(ji,jj)
+                 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj)
+                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - 0.045 * ( ( zwth_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 )
+                 ghams(ji,jj,jk) = ghams(ji,jj,jk) - 0.045 * ( ( zws_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 )
+               END DO
+!
+               zbuoy_pyc_sc = zalpha_pyc(ji,jj) * zdb_ml(ji,jj) / zdh(ji,jj) + zdbdz_bl_ext(ji,jj)
+               zdelta_pyc = ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird / SQRT( MAX( zbuoy_pyc_sc, ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / zdh(ji,jj)**2 ) )
+!
+               zwt_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zdt_ml(ji,jj) / zdh(ji,jj) + zdtdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj)
+!
+               zws_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zds_ml(ji,jj) / zdh(ji,jj) + zdsdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj)
+!
+               zzeta_pyc = 0.15 - 0.175 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )
+               DO jk = 2, ibld(ji,jj)
+                 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj)
+                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05 * zwt_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird
+!
+                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05 * zws_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird
+               END DO
+            ENDIF ! End of pycnocline
+          ELSE ! lconv test - stable conditions
+             DO jk = 2, ibld(ji,jj)
+                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj)
+                ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj)
+             END DO
+          ENDIF
+       END_2D
+       WHERE ( lconv )
+          zsc_uw_1 = -zwb0 * zustar**2 * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )
+          zsc_uw_2 =  zwb0 * zustke    * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )**(2.0/3.0)
+          zsc_vw_1 = 0._wp
+       ELSEWHERE
+         zsc_uw_1 = 0._wp
+         zsc_vw_1 = 0._wp
+       ENDWHERE
+       DO_2D( 0, 0, 0, 0 )
+          IF ( lconv(ji,jj) ) THEN
+             DO jk = 2 , imld(ji,jj)
+                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) +   0.125 * EXP( -0.5 * zznd_d )     &
+                     &                                                            * (   1.0 - EXP( -0.5 * zznd_d ) )   &
+                     &                                          * zsc_uw_2(ji,jj)                                    )
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
+             END DO  ! jk loop
+          ELSE
+          ! stable conditions
+             DO jk = 2, ibld(ji,jj)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj)
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
+             END DO
+          ENDIF
+       END_2D
+       DO_2D( 0, 0, 0, 0 )
+        IF ( lpyc(ji,jj) ) THEN
+          IF ( j_ddh(ji,jj) == 0 ) THEN
+! Place holding code. Parametrization needs checking for these conditions.
+            zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) )**pthird )**pthird
+            zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj)
+            zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj)
+          ELSE
+            zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) )**pthird )**pthird
+            zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj)
+            zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj)
+          ENDIF
+          zd_cubic = zdh(ji,jj) / zhbl(ji,jj) * zuw0(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zuw_bse
+          zc_cubic = zuw_bse - zd_cubic
+! need ztau_sc_u to be available. Change to array.
+          DO jk = imld(ji,jj), ibld(ji,jj)
+             zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj)
+             ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.045 * ztau_sc_u(ji,jj)**2 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk)
+          END DO
+          zvw_max = 0.7 * ff_t(ji,jj) * ( zustke(ji,jj) * dstokes(ji,jj) + 0.75 * zustar(ji,jj) * zhml(ji,jj) )
+          zd_cubic = zvw_max * zdh(ji,jj) / zhml(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zvw_bse
+          zc_cubic = zvw_bse - zd_cubic
+          DO jk = imld(ji,jj), ibld(ji,jj)
+            zznd_pyc = -( gdepw(ji,jj,jk,Kmm) -zhbl(ji,jj) ) / zdh(ji,jj)
+            ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.045 * ztau_sc_u(ji,jj)**2 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk)
+          END DO
+        ENDIF  ! lpyc
+       END_2D
+       IF(ln_dia_osm) THEN
+          IF ( iom_use("ghamu_0") ) CALL iom_put( "ghamu_0", wmask*ghamu )
+          IF ( iom_use("zsc_uw_1_0") ) CALL iom_put( "zsc_uw_1_0", tmask(:,:,1)*zsc_uw_1 )
+       END IF
+! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ]
+       DO_2D( 1, 0, 1, 0 )
+         IF ( lconv(ji,jj) ) THEN
+           zsc_wth_1(ji,jj) = zwth0(ji,jj) / ( 1.0 - 0.56 * EXP( zhol(ji,jj) ) )
+           zsc_ws_1(ji,jj) = zws0(ji,jj) / (1.0 - 0.56 *EXP( zhol(ji,jj) ) )
+           IF ( lpyc(ji,jj) ) THEN
+! Pycnocline scales
+              zsc_wth_pyc(ji,jj) = -0.2 * zwb0(ji,jj) * zdt_bl(ji,jj) / zdb_bl(ji,jj)
+              zsc_ws_pyc(ji,jj) = -0.2 * zwb0(ji,jj) * zds_bl(ji,jj) / zdb_bl(ji,jj)
+            ENDIF
+         ELSE
+           zsc_wth_1(ji,jj) = 2.0 * zwthav(ji,jj)
+           zsc_ws_1(ji,jj) = zws0(ji,jj)
+         ENDIF
+       END_2D
+       DO_2D( 0, 0, 0, 0 )
+         IF ( lconv(ji,jj) ) THEN
+            DO jk = 2, imld(ji,jj)
+               zznd_ml=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj)                &
+                    &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      &
+                    &                               - EXP(     - 6.0 * zznd_ml    ) ) )  &
+                    &          * ( 1.0 - EXP( - 15.0 * (         1.0 - zznd_ml    ) ) )
+               !
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj)  &
+                    &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      &
+                    &                               - EXP(     - 6.0 * zznd_ml    ) ) )  &
+                    &          * ( 1.0 - EXP ( -15.0 * (         1.0 - zznd_ml    ) ) )
+            END DO
+!
+            IF ( lpyc(ji,jj) ) THEN
+! pycnocline
+              DO jk = imld(ji,jj), ibld(ji,jj)
+                zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj)
+                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0 * zsc_wth_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) )
+                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0 * zsc_ws_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) )
+              END DO
+           ENDIF
+         ELSE
+            IF( zdhdt(ji,jj) > 0. ) THEN
+              DO jk = 2, ibld(ji,jj)
+                 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + &
+              &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj)
+                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + &
+               &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj)
+              END DO
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pshear(ji,jj) = 0.0_wp
+      END_2D
+      zekman(:,:) = EXP( -1.0_wp * pp_ek * ABS( ff_t(A2D(nn_hls-1)) ) * phbl(A2D(nn_hls-1)) /   &
+         &               MAX( sustar(A2D(nn_hls-1)), 1.e-8 ) )
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN
+               zri_p(ji,jj) = MAX (  SQRT( av_db_bl(ji,jj) * pdh(ji,jj) / MAX( av_du_bl(ji,jj)**2 + av_dv_bl(ji,jj)**2,     &
+                  &                                                          1e-8_wp ) ) * ( phbl(ji,jj) / pdh(ji,jj) ) *   &
+                  &                  ( svstr(ji,jj) / MAX( sustar(ji,jj), 1e-6_wp ) )**2 /                                  &
+                  &                  MAX( zekman(ji,jj), 1.0e-6_wp ), 5.0_wp )
+               IF ( ff_t(ji,jj) >= 0.0_wp ) THEN   ! Northern hemisphere
+                  zri_b(ji,jj) = av_db_ml(ji,jj) * pdh(ji,jj) / ( MAX( av_du_ml(ji,jj), 1e-5_wp )**2 +   &
+                     &                                          MAX( -1.0_wp * av_dv_ml(ji,jj), 1e-5_wp)**2 )
+               ELSE                                ! Southern hemisphere
+                  zri_b(ji,jj) = av_db_ml(ji,jj) * pdh(ji,jj) / ( MAX( av_du_ml(ji,jj), 1e-5_wp )**2 +   &
+                     &                                          MAX(           av_dv_ml(ji,jj), 1e-5_wp)**2 )
+               END IF
+               pshear(ji,jj) = pp_a_shr * zekman(ji,jj) *                                                   &
+                  &            ( MAX( sustar(ji,jj)**2 * av_du_ml(ji,jj) / phbl(ji,jj), 0.0_wp ) +          &
+                  &              pp_b_shr * MAX( -1.0_wp * ff_t(ji,jj) * sustke(ji,jj) * dstokes(ji,jj) *   &
+                  &                            av_dv_ml(ji,jj) / phbl(ji,jj), 0.0_wp ) )
+               ! Stability dependence
+               pshear(ji,jj) = pshear(ji,jj) * EXP( -0.75_wp * MAX( 0.0_wp, ( zri_b(ji,jj) - pp_ri_c ) / pp_ri_c ) )
+               !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+               ! Test ensures n_ddh=0 is not selected. Change to zri_p<27 when  !
+               ! full code available                                          !
+               !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+               IF ( pshear(ji,jj) > 1e-10 ) THEN
+                  IF ( zri_p(ji,jj) < pp_ri_p_thresh .AND.   &
+                     & MIN( hu(ji,jj,Kmm), hu(ji-1,jj,Kmm), hv(ji,jj,Kmm), hv(ji,jj-1,Kmm) ) > 100.0_wp ) THEN
+                     ! Growing shear layer
+                     n_ddh(ji,jj) = 0
+                     l_shear(ji,jj) = .TRUE.
+                  ELSE
+                     n_ddh(ji,jj) = 1
+                     !             IF ( zri_b <= 1.5 .and. pshear(ji,jj) > 0._wp ) THEN
+                     ! Shear production large enough to determine layer charcteristics, but can't maintain a shear layer
+                     l_shear(ji,jj) = .TRUE.
+                     !             ELSE
+                  END IF
+               ELSE
+                  n_ddh(ji,jj) = 2
+                  l_shear(ji,jj) = .FALSE.
+               END IF
+               ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline
+               !               pshear(ji,jj) = 0.5 * pshear(ji,jj)
+               !               l_shear(ji,jj) = .FALSE.
+               !            ENDIF
+            ELSE   ! av_db_bl test, note pshear set to zero
+               n_ddh(ji,jj) = 2
+               l_shear(ji,jj) = .FALSE.
             ENDIF
          ENDIF
+       END_2D
+       WHERE ( lconv )
+          zsc_uw_1 = zustar**2
+          zsc_vw_1 = ff_t * zustke * zhml
+       ELSEWHERE
+          zsc_uw_1 = zustar**2
+          zsc_uw_2 = (2.25 - 3.0 * ( 1.0 - EXP( -1.25 * 2.0 ) ) ) * ( 1.0 - EXP( -4.0 * 2.0 ) ) * zsc_uw_1
+          zsc_vw_1 = ff_t * zustke * zhbl
+          zsc_vw_2 = -0.11 * SIN( 3.14159 * ( 2.0 + 0.4 ) ) * EXP(-( 1.5 + 2.0 )**2 ) * zsc_vw_1
+       ENDWHERE
+       DO_2D( 0, 0, 0, 0 )
+          IF ( lconv(ji,jj) ) THEN
+            DO jk = 2, imld(ji,jj)
+               zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk)&
+                    & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj)
+      END_2D
+      !
+      ! Calculate entrainment buoyancy flux due to surface fluxes.
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_conv(ji,jj) ) THEN
+            zwcor        = ABS( ff_t(ji,jj) ) * phbl(ji,jj) + epsln
+            zrf_conv     = TANH( ( swstrc(ji,jj) / zwcor )**0.69_wp )
+            zrf_shear    = TANH( ( sustar(ji,jj) / zwcor )**0.69_wp )
+            zrf_langmuir = TANH( ( swstrl(ji,jj) / zwcor )**0.69_wp )
+            IF ( nn_osm_SD_reduce > 0 ) THEN
+               ! Effective Stokes drift already reduced from surface value
+               zr_stokes = 1.0_wp
+            ELSE
+               ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd,
+               ! requires further reduction where BL is deep
+               zr_stokes = 1.0 - EXP( -25.0_wp * dstokes(ji,jj) / hbl(ji,jj) * ( 1.0_wp + 4.0_wp * dstokes(ji,jj) / hbl(ji,jj) ) )
+            END IF
+            pwb_ent(ji,jj) = -2.0_wp * pp_alpha_c * zrf_conv * swbav(ji,jj) -                                          &
+               &             pp_alpha_s * zrf_shear * sustar(ji,jj)**3 / phml(ji,jj) +                                 &
+               &             zr_stokes * ( pp_alpha_s * EXP( -1.5_wp * sla(ji,jj) ) * zrf_shear * sustar(ji,jj)**3 -   &
+               &                           zrf_langmuir * pp_alpha_lc * swstrl(ji,jj)**3 ) / phml(ji,jj)
+         ENDIF
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_shear(ji,jj) ) THEN
+            IF ( l_conv(ji,jj) ) THEN
+               ! Unstable OSBL
+               zwb_shr = -1.0_wp * pp_a_wb_s * zri_b(ji,jj) * pshear(ji,jj)
+               IF ( n_ddh(ji,jj) == 0 ) THEN
+                  ! Developing shear layer, additional shear production possible.
+                  !    pshear_u = MAX( zustar(ji,jj)**2 * MAX( av_du_ml(ji,jj), 0._wp ) /  phbl(ji,jj), 0._wp )
+                  !    pshear(ji,jj) = pshear(ji,jj) + pshear_u * ( 1.0 - MIN( zri_p(ji,jj) / pp_ri_p_thresh, 1.d0 )**2 )
+                  !    pshear(ji,jj) = MIN( pshear(ji,jj), pshear_u )
+                  !    zwb_shr = zwb_shr - 0.25 * MAX ( pshear_u, 0._wp) * ( 1.0 - MIN( zri_p(ji,jj) / pp_ri_p_thresh, 1._wp )**2 )
+                  !    zwb_shr = MAX( zwb_shr, -0.25 * pshear_u )
+               ENDIF
+               pwb_ent(ji,jj) = pwb_ent(ji,jj) + zwb_shr
+               !           pwb_min(ji,jj) = pwb_ent(ji,jj) + pdh(ji,jj) / phbl(ji,jj) * zwb0(ji,jj)
+            ELSE   ! IF ( l_conv ) THEN - ENDIF
+               ! Stable OSBL  - shear production not coded for first attempt.
+            ENDIF   ! l_conv
+         END IF   ! l_shear
+         IF ( l_conv(ji,jj) ) THEN
+            ! Unstable OSBL
+            pwb_min(ji,jj) = pwb_ent(ji,jj) + pdh(ji,jj) / phbl(ji,jj) * 2.0_wp * swbav(ji,jj)
+         END IF  ! l_conv
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_osbl_state
+   SUBROUTINE zdf_osm_external_gradients( Kmm, kbase, pdtdz, pdsdz, pdbdz )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_osm_external_gradients  ***
+      !!
+      !! ** Purpose : Calculates the gradients below the OSBL
+      !!
+      !! ** Method  : Uses nbld and ibld_ext to determine levels to calculate the gradient.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                            INTENT(in   ) ::   Kmm            ! Ocean time-level index
+      INTEGER,  DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   kbase          ! OSBL base layer index
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pdtdz, pdsdz   ! External gradients of temperature, salinity
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pdbdz          !    and buoyancy
+      !!
+      INTEGER  ::   ji, jj, jkb, jkb1
+      REAL(wp) ::   zthermal, zbeta
+      !!
+      REAL(wp), PARAMETER ::   pp_large = -1e10_wp
+      !!----------------------------------------------------------------------
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pdtdz(ji,jj) = pp_large
+         pdsdz(ji,jj) = pp_large
+         pdbdz(ji,jj) = pp_large
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( kbase(ji,jj)+1 < mbkt(ji,jj) ) THEN
+            zthermal = rab_n(ji,jj,1,jp_tem)   ! Ideally use nbld not 1??
+            zbeta    = rab_n(ji,jj,1,jp_sal)
+            jkb = kbase(ji,jj)
+            jkb1 = MIN( jkb + 1, mbkt(ji,jj) )
+            pdtdz(ji,jj) = -1.0_wp * ( ts(ji,jj,jkb1,jp_tem,Kmm) - ts(ji,jj,jkb,jp_tem,Kmm ) ) / e3w(ji,jj,jkb1,Kmm)
+            pdsdz(ji,jj) = -1.0_wp * ( ts(ji,jj,jkb1,jp_sal,Kmm) - ts(ji,jj,jkb,jp_sal,Kmm ) ) / e3w(ji,jj,jkb1,Kmm)
+            pdbdz(ji,jj) = grav * zthermal * pdtdz(ji,jj) - grav * zbeta * pdsdz(ji,jj)
+         ELSE
+            pdtdz(ji,jj) = 0.0_wp
+            pdsdz(ji,jj) = 0.0_wp
+            pdbdz(ji,jj) = 0.0_wp
+         END IF
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_external_gradients
+   SUBROUTINE zdf_osm_calculate_dhdt( pdhdt, phbl, pdh, pwb_ent, pwb_min,   &
+      &                               pdbdz_bl_ext, pwb_fk_b, pwb_fk, pvel_mle )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_osm_calculate_dhdt  ***
+      !!
+      !! ** Purpose : Calculates the rate at which hbl changes.
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pdhdt          ! Rate of change of hbl
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl           ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdh            ! Pycnocline depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent        ! Buoyancy entrainment flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_min
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pwb_fk_b       ! MLE buoyancy flux averaged over OSBL
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_fk         ! Max MLE buoyancy flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pvel_mle       ! Vvelocity scale for dhdt with stable ML and FK
+      !!
+      INTEGER  ::   jj, ji
+      REAL(wp) ::   zgamma_b_nd, zgamma_dh_nd, zpert, zpsi, zari
+      REAL(wp) ::   zvel_max, zddhdt
+      !!
+      REAL(wp), PARAMETER ::   pp_alpha_b = 0.3_wp
+      REAL(wp), PARAMETER ::   pp_ddh     = 2.5_wp, pp_ddh_2 = 3.5_wp   ! Also in pycnocline_depth
+      REAL(wp), PARAMETER ::   pp_large   = -1e10_wp
+      !!----------------------------------------------------------------------
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pdhdt(ji,jj)    = pp_large
+         pwb_fk_b(ji,jj) = pp_large
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         !
+         IF ( l_shear(ji,jj) ) THEN
+            !
+            IF ( l_conv(ji,jj) ) THEN   ! Convective
+               !
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
+                    & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj)
+            END DO
+          ELSE
+            DO jk = 2, ibld(ji,jj)
+               znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               IF ( zznd_d <= 2.0 ) THEN
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 &
+                       &*  ( 2.25 - 3.0  * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj)
+               IF ( ln_osm_mle ) THEN
+                  IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN   ! Fox-Kemper buoyancy flux average over OSBL
+                     pwb_fk_b(ji,jj) = pwb_fk(ji,jj) * ( 1.0_wp + hmle(ji,jj) / ( 6.0_wp * hbl(ji,jj) ) *   &
+                        &                                         ( -1.0_wp + ( 1.0_wp - 2.0_wp * hbl(ji,jj) / hmle(ji,jj) )**3 ) )
+                  ELSE
+                     pwb_fk_b(ji,jj) = 0.5_wp * pwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj)
+                  ENDIF
+                  zvel_max = ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+                  IF ( ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) < 0.0_wp ) THEN   ! OSBL is deepening,
+                     !                                                                 !    entrainment > restratification
+                     IF ( av_db_bl(ji,jj) > 1e-15_wp ) THEN
+                        zgamma_b_nd = MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) * pdh(ji,jj) /   &
+                           &          ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                        zpsi = ( 1.0_wp - 0.5_wp * pdh(ji,jj) / phbl(ji,jj) ) *                                                &
+                           &   ( swb0(ji,jj) - MIN( ( pwb_min(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ), 0.0_wp ) ) * pdh(ji,jj) /   &
+                           &   phbl(ji,jj)
+                        zpsi = zpsi + 1.75_wp * ( 1.0_wp - 0.5_wp * pdh(ji,jj) / phbl(ji,jj) ) *   &
+                           &          ( pdh(ji,jj) / phbl(ji,jj) + zgamma_b_nd ) *   &
+                           &          MIN( ( pwb_min(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ), 0.0_wp )
+                        zpsi = pp_alpha_b * MAX( zpsi, 0.0_wp )
+                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) /      &
+                           &                      ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) +   &
+                           &            zpsi / ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                        IF ( n_ddh(ji,jj) == 1 ) THEN
+                           IF ( ( swstrc(ji,jj) / svstr(ji,jj) )**3 <= 0.5_wp ) THEN
+                              zari = MIN( 1.5_wp * av_db_bl(ji,jj) /                                                   &
+                                 &        ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +                       &
+                                 &                               av_db_bl(ji,jj)**2 / MAX( 4.5_wp * svstr(ji,jj)**2,   &
+                                 &                                                       1e-12_wp ) ) ), 0.2_wp )
+                           ELSE
+                              zari = MIN( 1.5_wp * av_db_bl(ji,jj) /                                                    &
+                                 &        ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +                        &
+                                 &                               av_db_bl(ji,jj)**2 / MAX( 4.5_wp * swstrc(ji,jj)**2,   &
+                                 &                                                       1e-12_wp ) ) ), 0.2_wp )
+                           ENDIF
+                           ! Relaxation to dh_ref = zari * hbl
+                           zddhdt = -1.0_wp * pp_ddh_2 * ( 1.0_wp - pdh(ji,jj) / ( zari * phbl(ji,jj) ) ) * pwb_ent(ji,jj) /   &
+                              &     ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                        ELSE IF ( n_ddh(ji,jj) == 0 ) THEN   ! Growing shear layer
+                           zddhdt = -1.0_wp * pp_ddh * ( 1.0_wp - 1.6_wp * pdh(ji,jj) / phbl(ji,jj) ) * pwb_ent(ji,jj) /   &
+                              &     ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                           zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * phbl(ji,jj) / MAX( sustar(ji,jj), 1e-8_wp ) ) * zddhdt
+                        ELSE
+                           zddhdt = 0.0_wp
+                        ENDIF   ! n_ddh
+                        pdhdt(ji,jj) = pdhdt(ji,jj) + pp_alpha_b * ( 1.0_wp - 0.5_wp * pdh(ji,jj) / phbl(ji,jj) ) *   &
+                           &                            av_db_ml(ji,jj) * MAX( zddhdt, 0.0_wp ) /   &
+                           &                            ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                     ELSE   ! av_db_bl >0
+                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1e-15_wp )
+                     ENDIF
+                  ELSE   ! pwb_min + 2*pwb_fk_b < 0
+                     ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008)
+                     pdhdt(ji,jj) = -1.0_wp * MIN( pvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp )
+                  ENDIF
+               ELSE   ! Fox-Kemper not used.
+                  zvel_max = -1.0_wp * ( 1.0_wp + 1.0_wp * ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird *     &
+                     &                                                         rn_Dt / hbl(ji,jj) ) * pwb_ent(ji,jj) /   &
+                     &       MAX( ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird, epsln )
+                  pdhdt(ji,jj) = -1.0_wp * pwb_ent(ji,jj) / ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                  ! added ajgn 23 July as temporay fix
+               ENDIF   ! ln_osm_mle
+               !
+            ELSE   ! l_conv - Stable
+               !
+               pdhdt(ji,jj) = ( 0.06_wp + 0.52_wp * shol(ji,jj) / 2.0_wp ) * svstr(ji,jj)**3 / hbl(ji,jj) + swbav(ji,jj)
+               IF ( pdhdt(ji,jj) < 0.0_wp ) THEN   ! For long timsteps factor in brackets slows the rapid collapse of the OSBL
+                  zpert = 2.0_wp * ( 1.0_wp + 0.0_wp * 2.0_wp * svstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * svstr(ji,jj)**2 / hbl(ji,jj)
+               ELSE
+                  zpert = MAX( svstr(ji,jj)**2 / hbl(ji,jj), av_db_bl(ji,jj) )
+               ENDIF
+               pdhdt(ji,jj) = 2.0_wp * pdhdt(ji,jj) / MAX( zpert, epsln )
+               pdhdt(ji,jj) = MAX( pdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp )
+               !
+            ENDIF   ! l_conv
+            !
+         ELSE   ! l_shear
+            !
+            IF ( l_conv(ji,jj) ) THEN   ! Convective
+               !
+               IF ( ln_osm_mle ) THEN
+                  IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN   ! Fox-Kemper buoyancy flux average over OSBL
+                     pwb_fk_b(ji,jj) = pwb_fk(ji,jj) *                       &
+                        ( 1.0_wp + hmle(ji,jj) / ( 6.0_wp * hbl(ji,jj) ) *   &
+                        &          ( -1.0_wp + ( 1.0_wp - 2.0_wp * hbl(ji,jj) / hmle(ji,jj))**3) )
+                  ELSE
+                     pwb_fk_b(ji,jj) = 0.5_wp * pwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj)
+                  ENDIF
+                  zvel_max = ( swstrl(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+                  IF ( ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) < 0.0_wp ) THEN   ! OSBL is deepening,
+                     !                                                                 !    entrainment > restratification
+                     IF ( av_db_bl(ji,jj) > 0.0_wp .AND. pdbdz_bl_ext(ji,jj) > 0.0_wp ) THEN
+                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) /   &
+                           &            ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                     ELSE
+                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) / MAX( zvel_max, 1e-15_wp )
+                     ENDIF
+                  ELSE   ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008)
+                     pdhdt(ji,jj) = -1.0_wp * MIN( pvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp )
+                  ENDIF
+               ELSE   ! Fox-Kemper not used
+                  zvel_max = -1.0_wp * pwb_ent(ji,jj) / MAX( ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird, epsln )
+                  pdhdt(ji,jj) = -1.0_wp * pwb_ent(ji,jj) / ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) )
+                  ! added ajgn 23 July as temporay fix
+               ENDIF  ! ln_osm_mle
+               !
+            ELSE                        ! Stable
+               !
+               pdhdt(ji,jj) = ( 0.06_wp + 0.52_wp * shol(ji,jj) / 2.0_wp ) * svstr(ji,jj)**3 / hbl(ji,jj) + swbav(ji,jj)
+               IF ( pdhdt(ji,jj) < 0.0_wp ) THEN
+                  ! For long timsteps factor in brackets slows the rapid collapse of the OSBL
+                  zpert = 2.0_wp * svstr(ji,jj)**2 / hbl(ji,jj)
+               ELSE
+                  zpert = MAX( svstr(ji,jj)**2 / hbl(ji,jj), av_db_bl(ji,jj) )
+               ENDIF
+               pdhdt(ji,jj) = 2.0_wp * pdhdt(ji,jj) / MAX(zpert, epsln)
+               pdhdt(ji,jj) = MAX( pdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp )
+               !
+            ENDIF  ! l_conv
+            !
+         ENDIF ! l_shear
+         !
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_calculate_dhdt
+   SUBROUTINE zdf_osm_timestep_hbl( Kmm, pdhdt, phbl, phbl_t, pwb_ent,   &
+      &                             pwb_fk_b )
+      !!---------------------------------------------------------------------
+      !!                ***  ROUTINE zdf_osm_timestep_hbl  ***
+      !!
+      !! ** Purpose : Increments hbl.
+      !!
+      !! ** Method  : If the change in hbl exceeds one model level the change is
+      !!              is calculated by moving down the grid, changing the
+      !!              buoyancy jump. This is to ensure that the change in hbl
+      !!              does not overshoot a stable layer.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                            INTENT(in   ) ::   Kmm        ! Ocean time-level index
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdhdt      ! Rates of change of hbl
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   phbl       ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl_t     ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent    ! Buoyancy entrainment flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_fk_b   ! MLE buoyancy flux averaged over OSBL
+      !!
+      INTEGER  ::   jk, jj, ji, jm
+      REAL(wp) ::   zhbl_s, zvel_max, zdb
+      REAL(wp) ::   zthermal, zbeta
+      !!----------------------------------------------------------------------
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( nbld(ji,jj) - nmld(ji,jj) > 1 ) THEN
+            !
+            ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths.
+            !
+            zhbl_s   = hbl(ji,jj)
+            jm       = nmld(ji,jj)
+            zthermal = rab_n(ji,jj,1,jp_tem)
+            zbeta    = rab_n(ji,jj,1,jp_sal)
+            !
+            IF ( l_conv(ji,jj) ) THEN   ! Unstable
+               !
+               IF( ln_osm_mle ) THEN
+                  zvel_max = ( swstrl(ji,jj)**3 + swstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+               ELSE
+                  zvel_max = -1.0_wp * ( 1.0_wp + 1.0_wp * ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird * rn_Dt /   &
+                     &                                     hbl(ji,jj) ) * pwb_ent(ji,jj) /                                     &
+                     &       ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird
+               ENDIF
+               DO jk = nmld(ji,jj), nbld(ji,jj)
+                  zdb = MAX( grav * ( zthermal * ( av_t_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) -   &
+                     &                zbeta    * ( av_s_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0_wp ) + zvel_max
+                  !
+               ELSE
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk)&
+                       & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj)
+                  IF ( ln_osm_mle ) THEN
+                     zhbl_s = zhbl_s + MIN( rn_Dt * ( ( -1.0_wp * pwb_ent(ji,jj) - 2.0_wp * pwb_fk_b(ji,jj) ) / zdb ) /   &
+                        &                   REAL( nbld(ji,jj) - nmld(ji,jj), KIND=wp ), e3w(ji,jj,jm,Kmm) )
+                  ELSE
+                     zhbl_s = zhbl_s + MIN( rn_Dt * ( -1.0_wp * pwb_ent(ji,jj) / zdb ) /   &
+                        &                   REAL( nbld(ji,jj) - nmld(ji,jj), KIND=wp ), e3w(ji,jj,jm,Kmm) )
+                  ENDIF
+                  !                    zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol)
+                  IF ( zhbl_s >= gdepw(ji,jj,mbkt(ji,jj) + 1,Kmm) ) THEN
+                     zhbl_s = MIN( zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm ) - depth_tol )
+                     l_pyc(ji,jj) = .FALSE.
+                  ENDIF
+                  IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1
+               END DO
+               hbl(ji,jj)  = zhbl_s
+               nbld(ji,jj) = jm
+            ELSE   ! Stable
+               DO jk = nmld(ji,jj), nbld(ji,jj)
+                  zdb = MAX(  grav * ( zthermal * ( av_t_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) -               &
+                     &                 zbeta    * ( av_s_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0_wp ) +   &
+                     &  2.0_wp * svstr(ji,jj)**2 / zhbl_s
+                  !
+               ENDIF
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
+                    & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj)
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)&
+                    & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj)
+            END DO
+          ENDIF
+       END_2D
+       IF(ln_dia_osm) THEN
+          IF ( iom_use("ghamu_f") ) CALL iom_put( "ghamu_f", wmask*ghamu )
+          IF ( iom_use("ghamv_f") ) CALL iom_put( "ghamv_f", wmask*ghamv )
+          IF ( iom_use("zsc_uw_1_f") ) CALL iom_put( "zsc_uw_1_f", tmask(:,:,1)*zsc_uw_1 )
+          IF ( iom_use("zsc_vw_1_f") ) CALL iom_put( "zsc_vw_1_f", tmask(:,:,1)*zsc_vw_1 )
+          IF ( iom_use("zsc_uw_2_f") ) CALL iom_put( "zsc_uw_2_f", tmask(:,:,1)*zsc_uw_2 )
+          IF ( iom_use("zsc_vw_2_f") ) CALL iom_put( "zsc_vw_2_f", tmask(:,:,1)*zsc_vw_2 )
+       END IF
+!
+! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer.
+ ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer.
+      DO_2D( 0, 0, 0, 0 )
+         IF ( .not. lconv(ji,jj) ) THEN
+            DO jk = 2, ibld(ji,jj)
+               znd = ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zhbl(ji,jj) !ALMG to think about
+               IF ( znd >= 0.0 ) THEN
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) )
+                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) )
+               ELSE
+                  ghamu(ji,jj,jk) = 0._wp
+                  ghamv(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+                  ! Alan is thuis right? I have simply changed hbli to hbl
+                  shol(ji,jj)  = -1.0_wp * zhbl_s / ( ( svstr(ji,jj)**3 + epsln ) / swbav(ji,jj) )
+                  pdhdt(ji,jj) = -1.0_wp * ( swbav(ji,jj) - 0.04_wp / 2.0_wp * swstrl(ji,jj)**3 / zhbl_s -   &
+                     &                       0.15_wp / 2.0_wp * ( 1.0_wp - EXP( -1.5_wp * sla(ji,jj) ) ) *   &
+                     &                                 sustar(ji,jj)**3 / zhbl_s ) *                         &
+                     &           ( 0.725_wp + 0.225_wp * EXP( -7.5_wp * shol(ji,jj) ) )
+                  pdhdt(ji,jj) = pdhdt(ji,jj) + swbav(ji,jj)
+                  zhbl_s = zhbl_s + MIN( pdhdt(ji,jj) / zdb * rn_Dt / REAL( nbld(ji,jj) - nmld(ji,jj), KIND=wp ),   &
+                     &                   e3w(ji,jj,jm,Kmm) )
+                  !                    zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol)
+                  IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN
+                     zhbl_s      = MIN( zhbl_s,  gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - depth_tol )
+                     l_pyc(ji,jj) = .FALSE.
+                  ENDIF
+                  IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1
+               END DO
+            ENDIF   ! IF ( l_conv )
+            hbl(ji,jj)  = MAX( zhbl_s, gdepw(ji,jj,4,Kmm) )
+            nbld(ji,jj) = MAX( jm, 4 )
+         ELSE
+            ! change zero or one model level.
+            hbl(ji,jj) = MAX( phbl_t(ji,jj), gdepw(ji,jj,4,Kmm) )
          ENDIF
+      END_2D
+      ! pynocline contributions
+       DO_2D( 0, 0, 0, 0 )
+         IF ( .not. lconv(ji,jj) ) THEN
+          IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN
+             DO jk= 2, ibld(ji,jj)
+                znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk)
+                ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk)
+                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk)
+                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk)
+             END DO
+          END IF
+         END IF
+       END_2D
+      IF(ln_dia_osm) THEN
+          IF ( iom_use("ghamu_b") ) CALL iom_put( "ghamu_b", wmask*ghamu )
+          IF ( iom_use("ghamv_b") ) CALL iom_put( "ghamv_b", wmask*ghamv )
+       END IF
+       DO_2D( 0, 0, 0, 0 )
+          ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+          ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+          ghamu(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+          ghamv(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp
+       END_2D
+       IF(ln_dia_osm) THEN
+          IF ( iom_use("ghamu_1") ) CALL iom_put( "ghamu_1", wmask*ghamu )
+          IF ( iom_use("ghamv_1") ) CALL iom_put( "ghamv_1", wmask*ghamv )
+          IF ( iom_use("zdudz_pyc") ) CALL iom_put( "zdudz_pyc", wmask*zdudz_pyc )
+          IF ( iom_use("zdvdz_pyc") ) CALL iom_put( "zdvdz_pyc", wmask*zdvdz_pyc )
+          IF ( iom_use("zviscos") ) CALL iom_put( "zviscos", wmask*zviscos )
+       END IF
+       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+       ! Need to put in code for contributions that are applied explicitly to
+       ! the prognostic variables
+       !  1. Entrainment flux
+       !
+       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+       ! rotate non-gradient velocity terms back to model reference frame
+       DO_2D( 0, 0, 0, 0 )
+          DO jk = 2, ibld(ji,jj)
+             ztemp = ghamu(ji,jj,jk)
+             ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj)
+             ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj)
+          END DO
+       END_2D
+       IF(ln_dia_osm) THEN
+          IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc )
+          IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc )
+          IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc )
+       END IF
+! KPP-style Ri# mixing
+       IF( ln_kpprimix) THEN
+          DO_3D( 1, 0, 1, 0, 2, jpkm1 )      !* Shear production at uw- and vw-points (energy conserving form)
+             z3du(ji,jj,jk) = 0.5 * (  uu(ji,jj,jk-1,Kmm) -  uu(ji  ,jj,jk,Kmm) )   &
+                  &                 * (  uu(ji,jj,jk-1,Kbb) -  uu(ji  ,jj,jk,Kbb) ) * wumask(ji,jj,jk) &
+                  &                 / (  e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) )
+             z3dv(ji,jj,jk) = 0.5 * (  vv(ji,jj,jk-1,Kmm) -  vv(ji,jj  ,jk,Kmm) )   &
+                  &                 * (  vv(ji,jj,jk-1,Kbb) -  vv(ji,jj  ,jk,Kbb) ) * wvmask(ji,jj,jk) &
+                  &                 / (  e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) )
+          END_3D
+      !
+         DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+            !                                          ! shear prod. at w-point weightened by mask
+            zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+               &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
+            !                                          ! local Richardson number
+            zri   = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln)
+            zfri =  MIN( zri / rn_riinfty , 1.0_wp )
+            zfri  = ( 1.0_wp - zfri * zfri )
+            zrimix(ji,jj,jk)  =  zfri * zfri  * zfri * wmask(ji, jj, jk)
+         END_3D
+          DO_2D( 0, 0, 0, 0 )
+             DO jk = ibld(ji,jj) + 1, jpkm1
+                zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri
+                zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri
+             END DO
+          END_2D
+       END IF ! ln_kpprimix = .true.
+! KPP-style set diffusivity large if unstable below BL
+       IF( ln_convmix) THEN
+          DO_2D( 0, 0, 0, 0 )
+             DO jk = ibld(ji,jj) + 1, jpkm1
+               IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv
+             END DO
+          END_2D
+       END IF ! ln_convmix = .true.
+       IF ( ln_osm_mle ) THEN  ! set up diffusivity and non-gradient mixing
+          DO_2D( 0, 0, 0, 0 )
+              IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer
+             ! Calculate MLE flux contribution from surface fluxes
+                DO jk = 1, ibld(ji,jj)
+                  znd = gdepw(ji,jj,jk,Kmm) / MAX(zhbl(ji,jj),epsln)
+                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - zwth0(ji,jj) * ( 1.0 - znd )
+                  ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd )
+                 END DO
+                 DO jk = 1, mld_prof(ji,jj)
+                   znd = gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln)
+                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth0(ji,jj) * ( 1.0 - znd )
+                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd )
+                 END DO
+         ! Viscosity for MLEs
+                 DO jk = 1, mld_prof(ji,jj)
+                   znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln)
+                   zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 )
+                 END DO
+              ELSE
+! Surface transports limited to OSBL.
+         ! Viscosity for MLEs
+                 DO jk = 1, mld_prof(ji,jj)
+                   znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln)
+                   zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 )
+                 END DO
+              ENDIF
+          END_2D
+       ENDIF
+       IF(ln_dia_osm) THEN
+          IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc )
+          IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc )
+          IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc )
+       END IF
+       ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids
+       !CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp )
+       ! GN 25/8: need to change tmask --> wmask
+     DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+          p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+          p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk)
+     END_3D
+      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids
+     CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   &
+        &                    ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp )
+       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+            ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) &
+               &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
+            ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) &
+                &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk)
+            ghamt(ji,jj,jk) =  ghamt(ji,jj,jk) * tmask(ji,jj,jk)
+            ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk)
+       END_3D
+        ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged)
+        CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. )
+        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged)
+        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign changed)
+        CALL lbc_lnk( 'zdfosm', ghamt, 'W',  1.0_wp , ghams, 'W',  1.0_wp,   &
+           &                    ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp )
+      IF(ln_dia_osm) THEN
+         SELECT CASE (nn_osm_wave)
+         ! Stokes drift set by assumimg onstant La#=0.3(=0)  or Pierson-Moskovitz spectrum (=1).
+         CASE(0:1)
+            IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind )   ! x surface Stokes drift
+            IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind )  ! y surface Stokes drift
+            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke )
+         ! Stokes drift read in from sbcwave  (=2).
+         CASE(2:3)
+            IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd*umask(:,:,1) )               ! x surface Stokes drift
+            IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd*vmask(:,:,1) )               ! y surface Stokes drift
+            IF ( iom_use("wmp") ) CALL iom_put( "wmp", wmp*tmask(:,:,1) )                   ! wave mean period
+            IF ( iom_use("hsw") ) CALL iom_put( "hsw", hsw*tmask(:,:,1) )                   ! significant wave height
+            IF ( iom_use("wmp_NP") ) CALL iom_put( "wmp_NP", (2.*rpi*1.026/(0.877*grav) )*wndm*tmask(:,:,1) )                  ! wave mean period from NP spectrum
+            IF ( iom_use("hsw_NP") ) CALL iom_put( "hsw_NP", (0.22/grav)*wndm**2*tmask(:,:,1) )                   ! significant wave height from NP spectrum
+            IF ( iom_use("wndm") ) CALL iom_put( "wndm", wndm*tmask(:,:,1) )                   ! U_10
+            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* &
+                 & SQRT(ut0sd**2 + vt0sd**2 ) )
+         END SELECT
+         IF ( iom_use("ghamt") ) CALL iom_put( "ghamt", tmask*ghamt )            ! <Tw_NL>
+         IF ( iom_use("ghams") ) CALL iom_put( "ghams", tmask*ghams )            ! <Sw_NL>
+         IF ( iom_use("ghamu") ) CALL iom_put( "ghamu", umask*ghamu )            ! <uw_NL>
+         IF ( iom_use("ghamv") ) CALL iom_put( "ghamv", vmask*ghamv )            ! <vw_NL>
+         IF ( iom_use("zwth0") ) CALL iom_put( "zwth0", tmask(:,:,1)*zwth0 )            ! <Tw_0>
+         IF ( iom_use("zws0") ) CALL iom_put( "zws0", tmask(:,:,1)*zws0 )                ! <Sw_0>
+         IF ( iom_use("hbl") ) CALL iom_put( "hbl", tmask(:,:,1)*hbl )                  ! boundary-layer depth
+         IF ( iom_use("ibld") ) CALL iom_put( "ibld", tmask(:,:,1)*ibld )               ! boundary-layer max k
+         IF ( iom_use("zdt_bl") ) CALL iom_put( "zdt_bl", tmask(:,:,1)*zdt_bl )           ! dt at ml base
+         IF ( iom_use("zds_bl") ) CALL iom_put( "zds_bl", tmask(:,:,1)*zds_bl )           ! ds at ml base
+         IF ( iom_use("zdb_bl") ) CALL iom_put( "zdb_bl", tmask(:,:,1)*zdb_bl )           ! db at ml base
+         IF ( iom_use("zdu_bl") ) CALL iom_put( "zdu_bl", tmask(:,:,1)*zdu_bl )           ! du at ml base
+         IF ( iom_use("zdv_bl") ) CALL iom_put( "zdv_bl", tmask(:,:,1)*zdv_bl )           ! dv at ml base
+         IF ( iom_use("dh") ) CALL iom_put( "dh", tmask(:,:,1)*dh )               ! Initial boundary-layer depth
+         IF ( iom_use("hml") ) CALL iom_put( "hml", tmask(:,:,1)*hml )               ! Initial boundary-layer depth
+         IF ( iom_use("dstokes") ) CALL iom_put( "dstokes", tmask(:,:,1)*dstokes )      ! Stokes drift penetration depth
+         IF ( iom_use("zustke") ) CALL iom_put( "zustke", tmask(:,:,1)*zustke )            ! Stokes drift magnitude at T-points
+         IF ( iom_use("zwstrc") ) CALL iom_put( "zwstrc", tmask(:,:,1)*zwstrc )         ! convective velocity scale
+         IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl )         ! Langmuir velocity scale
+         IF ( iom_use("zustar") ) CALL iom_put( "zustar", tmask(:,:,1)*zustar )         ! friction velocity scale
+         IF ( iom_use("zvstr") ) CALL iom_put( "zvstr", tmask(:,:,1)*zvstr )         ! mixed velocity scale
+         IF ( iom_use("zla") ) CALL iom_put( "zla", tmask(:,:,1)*zla )         ! langmuir #
+         IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rho0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine
+         IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke )
+         IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl )               ! BL depth internal to zdf_osm routine
+         IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml )               ! ML depth internal to zdf_osm routine
+         IF ( iom_use("imld") ) CALL iom_put( "imld", tmask(:,:,1)*imld )               ! index for ML depth internal to zdf_osm routine
+         IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh )                  ! pyc thicknessh internal to zdf_osm routine
+         IF ( iom_use("zhol") ) CALL iom_put( "zhol", tmask(:,:,1)*zhol )               ! ML depth internal to zdf_osm routine
+         IF ( iom_use("zwthav") ) CALL iom_put( "zwthav", tmask(:,:,1)*zwthav )         ! upward BL-avged turb temp flux
+         IF ( iom_use("zwth_ent") ) CALL iom_put( "zwth_ent", tmask(:,:,1)*zwth_ent )   ! upward turb temp entrainment flux
+         IF ( iom_use("zwb_ent") ) CALL iom_put( "zwb_ent", tmask(:,:,1)*zwb_ent )      ! upward turb buoyancy entrainment flux
+         IF ( iom_use("zws_ent") ) CALL iom_put( "zws_ent", tmask(:,:,1)*zws_ent )      ! upward turb salinity entrainment flux
+         IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml )            ! average T in ML
+         IF ( iom_use("hmle") ) CALL iom_put( "hmle", tmask(:,:,1)*hmle )               ! FK layer depth
+         IF ( iom_use("zmld") ) CALL iom_put( "zmld", tmask(:,:,1)*zmld )               ! FK target layer depth
+         IF ( iom_use("zwb_fk") ) CALL iom_put( "zwb_fk", tmask(:,:,1)*zwb_fk )         ! FK b flux
+         IF ( iom_use("zwb_fk_b") ) CALL iom_put( "zwb_fk_b", tmask(:,:,1)*zwb_fk_b )   ! FK b flux averaged over ML
+         IF ( iom_use("mld_prof") ) CALL iom_put( "mld_prof", tmask(:,:,1)*mld_prof )! FK layer max k
+         IF ( iom_use("zdtdx") ) CALL iom_put( "zdtdx", umask(:,:,1)*zdtdx )            ! FK dtdx at u-pt
+         IF ( iom_use("zdtdy") ) CALL iom_put( "zdtdy", vmask(:,:,1)*zdtdy )            ! FK dtdy at v-pt
+         IF ( iom_use("zdsdx") ) CALL iom_put( "zdsdx", umask(:,:,1)*zdsdx )            ! FK dtdx at u-pt
+         IF ( iom_use("zdsdy") ) CALL iom_put( "zdsdy", vmask(:,:,1)*zdsdy )            ! FK dsdy at v-pt
+         IF ( iom_use("dbdx_mle") ) CALL iom_put( "dbdx_mle", umask(:,:,1)*dbdx_mle )            ! FK dbdx at u-pt
+         IF ( iom_use("dbdy_mle") ) CALL iom_put( "dbdy_mle", vmask(:,:,1)*dbdy_mle )            ! FK dbdy at v-pt
+         IF ( iom_use("zdiff_mle") ) CALL iom_put( "zdiff_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt
+         IF ( iom_use("zvel_mle") ) CALL iom_put( "zvel_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt
+      END IF
+CONTAINS
+! subroutine code changed, needs syntax checking.
+  SUBROUTINE zdf_osm_diffusivity_viscosity( zdiffut, zviscos )
+!!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_osm_diffusivity_viscosity  ***
+     !!
+     !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline.
+     !!
+     !! ** Method  :
+     !!
+     !! !!----------------------------------------------------------------------
+     REAL(wp), DIMENSION(:,:,:) :: zdiffut
+     REAL(wp), DIMENSION(:,:,:) :: zviscos
+! local
+! Scales used to calculate eddy diffusivity and viscosity profiles
+      REAL(wp), DIMENSION(jpi,jpj) :: zdifml_sc, zvisml_sc
+      REAL(wp), DIMENSION(jpi,jpj) :: zdifpyc_n_sc, zdifpyc_s_sc, zdifpyc_shr
+      REAL(wp), DIMENSION(jpi,jpj) :: zvispyc_n_sc, zvispyc_s_sc,zvispyc_shr
+      REAL(wp), DIMENSION(jpi,jpj) :: zbeta_d_sc, zbeta_v_sc
+!
+      REAL(wp) :: zvel_sc_pyc, zvel_sc_ml, zstab_fac
+      REAL(wp), PARAMETER :: rn_dif_ml = 0.8, rn_vis_ml = 0.375
+      REAL(wp), PARAMETER :: rn_dif_pyc = 0.15, rn_vis_pyc = 0.142
+      REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15
+      DO_2D( 0, 0, 0, 0 )
+          IF ( lconv(ji,jj) ) THEN
+            zvel_sc_pyc = ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.25 * zshear(ji,jj) * zhbl(ji,jj) )**pthird
+            zvel_sc_ml = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
+            zstab_fac = ( zhml(ji,jj) / zvel_sc_ml * ( 1.4 - 0.4 / ( 1.0 + EXP(-3.5 * LOG10(-zhol(ji,jj) ) ) )**1.25 ) )**2
+            zdifml_sc(ji,jj) = rn_dif_ml * zhml(ji,jj) * zvel_sc_ml
+            zvisml_sc(ji,jj) = rn_vis_ml * zdifml_sc(ji,jj)
+            IF ( lpyc(ji,jj) ) THEN
+              zdifpyc_n_sc(ji,jj) =  rn_dif_pyc * zvel_sc_ml * zdh(ji,jj)
+              IF ( lshear(ji,jj) .and. j_ddh(ji,jj) == 1 ) THEN
+                zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj)
+              ENDIF
+              zdifpyc_s_sc(ji,jj) = zwb_ent(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) )
+              zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac
+              zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) )
+              zvispyc_n_sc(ji,jj) = 0.09 * zvel_sc_pyc * ( 1.0 - zhbl(ji,jj) / zdh(ji,jj) )**2 * ( 0.005 * ( zu_ml(ji,jj)-zu_bl(ji,jj) )**2 + 0.0075 * ( zv_ml(ji,jj)-zv_bl(ji,jj) )**2 ) / zdh(ji,jj)
+              zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac
+              IF ( lshear(ji,jj) .and. j_ddh(ji,jj) == 1 ) THEN
+                zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj)
+              ENDIF
+              zvispyc_s_sc(ji,jj) = 0.09 * ( zwb_min(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) )
+              zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac
+              zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5 * zvispyc_s_sc(ji,jj) )
+              zbeta_d_sc(ji,jj) = 1.0 - ( ( zdifpyc_n_sc(ji,jj) + 1.4 * zdifpyc_s_sc(ji,jj) ) / ( zdifml_sc(ji,jj) + epsln ) )**p2third
+              zbeta_v_sc(ji,jj) = 1.0 -  2.0 * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln )
+            ELSE
+              zbeta_d_sc(ji,jj) = 1.0
+              zbeta_v_sc(ji,jj) = 1.0
+            ENDIF
+          ELSE
+            zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp)
+            zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp)
+          END IF
+      END_2D
+!
+       DO_2D( 0, 0, 0, 0 )
+          IF ( lconv(ji,jj) ) THEN
+             DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity
+                 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj)
+                 !
+                 zdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5
+                 !
+                 zviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) &
+   &            *                                      ( 1.0 - 0.5 * zznd_ml**2 )
+             END DO
+! pycnocline
+             IF ( lpyc(ji,jj) ) THEN
+! Diffusivity profile in the pycnocline given by cubic polynomial.
+                za_cubic = 0.5
+                zb_cubic = -1.75 * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj)
+                zd_cubic = ( zdh(ji,jj) * zdifml_sc(ji,jj) / zhml(ji,jj) * SQRT( 1.0 - zbeta_d_sc(ji,jj) ) * ( 2.5 * zbeta_d_sc(ji,jj) - 1.0 ) &
+                     & - 0.85 * zdifpyc_s_sc(ji,jj) ) / MAX(zdifpyc_n_sc(ji,jj), 1.e-8)
+                zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic  - zb_cubic )
+                zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic
+                DO jk = imld(ji,jj) , ibld(ji,jj)
+                  zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6)
+                      !
+                  zdiffut(ji,jj,jk) = zdifpyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 +   zd_cubic * zznd_pyc**3 )
+                  zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdifpyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 )
+                END DO
+ ! viscosity profiles.
+                za_cubic = 0.5
+                zb_cubic = -1.75 * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj)
+                zd_cubic = ( 0.5 * zvisml_sc(ji,jj) * zdh(ji,jj) / zhml(ji,jj) - 0.85 * zvispyc_s_sc(ji,jj)  )  / MAX(zvispyc_n_sc(ji,jj), 1.e-8)
+                zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zd_cubic )
+                zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic
+                DO jk = imld(ji,jj) , ibld(ji,jj)
+                   zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6)
+                    zviscos(ji,jj,jk) = zvispyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 )
+                    zviscos(ji,jj,jk) = zviscos(ji,jj,jk) + zvispyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 -0.2 * zznd_pyc**3 )
+                END DO
+                IF ( zdhdt(ji,jj) > 0._wp ) THEN
+                 zdiffut(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 )
+                 zviscos(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 )
+                ELSE
+                  zdiffut(ji,jj,ibld(ji,jj)) = 0._wp
+                  zviscos(ji,jj,ibld(ji,jj)) = 0._wp
+                ENDIF
+             ENDIF
+          ELSE
+          ! stable conditions
+             DO jk = 2, ibld(ji,jj)
+                zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+                zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5
+                zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 )
+             END DO
+             IF ( zdhdt(ji,jj) > 0._wp ) THEN
+                zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm)
+                zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm)
+             ENDIF
+          ENDIF   ! end if ( lconv )
+          !
+       END_2D
+  END SUBROUTINE zdf_osm_diffusivity_viscosity
+  SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear, zri_i )
+!!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_osm_osbl_state  ***
+     !!
+     !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number
+     !!
+     !! ** Method  :
+     !!
+     !! !!----------------------------------------------------------------------
+     INTEGER, DIMENSION(jpi,jpj) :: j_ddh  ! j_ddh = 0, active shear layer; j_ddh=1, shear layer not active; j_ddh=2 shear production low.
+     LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear
+     REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent, zwb_min ! Buoyancy fluxes at base of well-mixed layer.
+     REAL(wp), DIMENSION(jpi,jpj) :: zshear  ! production of TKE due to shear across the pycnocline
+     REAL(wp), DIMENSION(jpi,jpj) :: zri_i  ! Interfacial Richardson Number
+! Local Variables
+     INTEGER :: jj, ji
+     REAL(wp), DIMENSION(jpi,jpj) :: zekman
+     REAL(wp) :: zri_p, zri_b   ! Richardson numbers
+     REAL(wp) :: zshear_u, zshear_v, zwb_shr
+     REAL(wp) :: zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes
+     REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.1
+     REAL, PARAMETER :: rn_ri_thres_a = 0.5, rn_ri_thresh_b = 0.59
+     REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.04
+     REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15
+     REAL, PARAMETER :: rn_ri_p_thresh = 27.0
+     REAL, PARAMETER :: zrot=0._wp  ! dummy rotation rate of surface stress.
+! Determins stability and set flag lconv
+     DO_2D( 0, 0, 0, 0 )
+      IF ( zhol(ji,jj) < 0._wp ) THEN
+         lconv(ji,jj) = .TRUE.
+       ELSE
+          lconv(ji,jj) = .FALSE.
+       ENDIF
+     END_2D
+     zekman(:,:) = EXP( - 4.0 * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) )
+     WHERE ( lconv )
+       zri_i = zdb_ml * zhml**2 / MAX( ( zvstr**3 + 0.5 * zwstrc**3 )**p2third * zdh, 1.e-12 )
+     END WHERE
+     zshear(:,:) = 0._wp
+     j_ddh(:,:) = 1
+     DO_2D( 0, 0, 0, 0 )
+      IF ( lconv(ji,jj) ) THEN
+         IF ( zdb_bl(ji,jj) > 0._wp ) THEN
+           zri_p = MAX (  SQRT( zdb_bl(ji,jj) * zdh(ji,jj) / MAX( zdu_bl(ji,jj)**2 + zdv_bl(ji,jj)**2, 1.e-8) )  *  ( zhbl(ji,jj) / zdh(ji,jj) ) * ( zvstr(ji,jj) / MAX( zustar(ji,jj), 1.e-6 ) )**2 &
+                & / MAX( zekman(ji,jj), 1.e-6 )  , 5._wp )
+           zri_b = zdb_ml(ji,jj) * zdh(ji,jj) / MAX( zdu_ml(ji,jj)**2 + zdv_ml(ji,jj)**2, 1.e-8 )
+           zshear(ji,jj) = za_shr * zekman(ji,jj) * ( MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) + zb_shr * MAX( -ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) * zdv_ml(ji,jj) / zhbl(ji,jj), 0._wp ) )
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Test ensures j_ddh=0 is not selected. Change to zri_p<27 when  !
+! full code available                                          !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+           IF ( zri_p < -rn_ri_p_thresh .and. zshear(ji,jj) > 0._wp ) THEN
+! Growing shear layer
+             j_ddh(ji,jj) = 0
+             lshear(ji,jj) = .TRUE.
+           ELSE
+             j_ddh(ji,jj) = 1
+             IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN
+! shear production large enough to determine layer charcteristics, but can't maintain a shear layer.
+               lshear(ji,jj) = .TRUE.
+             ELSE
+! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline.
+               zshear(ji,jj) = 0.5 * zshear(ji,jj)
+               lshear(ji,jj) = .FALSE.
+             ENDIF
+           ENDIF
+         ELSE                ! zdb_bl test, note zshear set to zero
+           j_ddh(ji,jj) = 2
+           lshear(ji,jj) = .FALSE.
+         ENDIF
+       ENDIF
+     END_2D
+! Calculate entrainment buoyancy flux due to surface fluxes.
+     DO_2D( 0, 0, 0, 0 )
+      IF ( lconv(ji,jj) ) THEN
+        zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln
+        zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 )
+        zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 )
+        zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 )
+        IF (nn_osm_SD_reduce > 0 ) THEN
+        ! Effective Stokes drift already reduced from surface value
+           zr_stokes = 1.0_wp
+        ELSE
+         ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd,
+          ! requires further reduction where BL is deep
+           zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) &
+         &                  * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) )
+        END IF
+        zwb_ent(ji,jj) = - 2.0 * 0.2 * zrf_conv * zwbav(ji,jj) &
+               &                  - 0.15 * zrf_shear * zustar(ji,jj)**3 /zhml(ji,jj) &
+               &         + zr_stokes * ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 &
+               &                                         - zrf_langmuir * 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj)
+          !
+      ENDIF
+     END_2D
+     zwb_min(:,:) = 0._wp
+     DO_2D( 0, 0, 0, 0 )
+      IF ( lshear(ji,jj) ) THEN
+        IF ( lconv(ji,jj) ) THEN
+! Unstable OSBL
+           zwb_shr = -za_wb_s * zshear(ji,jj)
+           IF ( j_ddh(ji,jj) == 0 ) THEN
+! Developing shear layer, additional shear production possible.
+             zshear_u = MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) /  zhbl(ji,jj), 0._wp )
+             zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p / rn_ri_p_thresh, 1.d0 ) )
+             zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u )
+             zwb_shr = -za_wb_s * zshear(ji,jj)
+           ENDIF
+           zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr
+           zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj)
+        ELSE    ! IF ( lconv ) THEN - ENDIF
+! Stable OSBL  - shear production not coded for first attempt.
+        ENDIF  ! lconv
+      ELSE  ! lshear
+        IF ( lconv(ji,jj) ) THEN
+! Unstable OSBL
+           zwb_shr = -za_wb_s * zshear(ji,jj)
+           zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr
+           zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj)
+        ENDIF  ! lconv
+      ENDIF    ! lshear
+     END_2D
+   END SUBROUTINE zdf_osm_osbl_state
+   SUBROUTINE zdf_osm_vertical_average( jnlev_av, jp_ext, zt, zs, zb, zu, zv, zdt, zds, zdb, zdu, zdv )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_vertical_average  ***
+     !!
+     !! ** Purpose : Determines vertical averages from surface to jnlev.
+     !!
+     !! ** Method  : Averages are calculated from the surface to jnlev.
+     !!              The external level used to calculate differences is ibld+ibld_ext
+     !!
+     !!----------------------------------------------------------------------
+        INTEGER, DIMENSION(jpi,jpj) :: jnlev_av  ! Number of levels to average over.
+        INTEGER, DIMENSION(jpi,jpj) :: jp_ext
+        ! Alan: do we need zb?
+        REAL(wp), DIMENSION(jpi,jpj) :: zt, zs, zb        ! Average temperature and salinity
+        REAL(wp), DIMENSION(jpi,jpj) :: zu,zv         ! Average current components
+        REAL(wp), DIMENSION(jpi,jpj) :: zdt, zds, zdb ! Difference between average and value at base of OSBL
+        REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv      ! Difference for velocity components.
+        INTEGER :: jk, ji, jj, ibld_ext
+        REAL(wp) :: zthick, zthermal, zbeta
+        zt   = 0._wp
+        zs   = 0._wp
+        zu   = 0._wp
+        zv   = 0._wp
+        DO_2D( 0, 0, 0, 0 )
+         zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
+         zbeta    = rab_n(ji,jj,1,jp_sal)
+            ! average over depth of boundary layer
+         zthick = epsln
+         DO jk = 2, jnlev_av(ji,jj)
+            zthick = zthick + e3t(ji,jj,jk,Kmm)
+            zt(ji,jj)   = zt(ji,jj)  + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)
+            zs(ji,jj)   = zs(ji,jj)  + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
+            zu(ji,jj)   = zu(ji,jj)  + e3t(ji,jj,jk,Kmm) &
+                  &            * ( uu(ji,jj,jk,Kbb) + uu(ji - 1,jj,jk,Kbb) ) &
+                  &            / MAX( 1. , umask(ji,jj,jk) + umask(ji - 1,jj,jk) )
+            zv(ji,jj)   = zv(ji,jj)  + e3t(ji,jj,jk,Kmm) &
+                  &            * ( vv(ji,jj,jk,Kbb) + vv(ji,jj - 1,jk,Kbb) ) &
+                  &            / MAX( 1. , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) )
+         END DO
+         zt(ji,jj) = zt(ji,jj) / zthick
+         zs(ji,jj) = zs(ji,jj) / zthick
+         zu(ji,jj) = zu(ji,jj) / zthick
+         zv(ji,jj) = zv(ji,jj) / zthick
+         zb(ji,jj) = grav * zthermal * zt(ji,jj) - grav * zbeta * zs(ji,jj)
+         ibld_ext = jnlev_av(ji,jj) + jp_ext(ji,jj)
+         IF ( ibld_ext < mbkt(ji,jj) ) THEN
+           zdt(ji,jj) = zt(ji,jj) - ts(ji,jj,ibld_ext,jp_tem,Kmm)
+           zds(ji,jj) = zs(ji,jj) - ts(ji,jj,ibld_ext,jp_sal,Kmm)
+           zdu(ji,jj) = zu(ji,jj) - ( uu(ji,jj,ibld_ext,Kbb) + uu(ji-1,jj,ibld_ext,Kbb ) ) &
+                  &    / MAX(1. , umask(ji,jj,ibld_ext ) + umask(ji-1,jj,ibld_ext ) )
+           zdv(ji,jj) = zv(ji,jj) - ( vv(ji,jj,ibld_ext,Kbb) + vv(ji,jj-1,ibld_ext,Kbb ) ) &
+                  &   / MAX(1. , vmask(ji,jj,ibld_ext ) + vmask(ji,jj-1,ibld_ext ) )
+           zdb(ji,jj) = grav * zthermal * zdt(ji,jj) - grav * zbeta * zds(ji,jj)
+         ELSE
+           zdt(ji,jj) = 0._wp
+           zds(ji,jj) = 0._wp
+           zdu(ji,jj) = 0._wp
+           zdv(ji,jj) = 0._wp
+           zdb(ji,jj) = 0._wp
+         ENDIF
+        END_2D
+   END SUBROUTINE zdf_osm_vertical_average
+   SUBROUTINE zdf_osm_velocity_rotation( zcos_w, zsin_w, zu, zv, zdu, zdv )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_velocity_rotation  ***
+     !!
+     !! ** Purpose : Rotates frame of reference of averaged velocity components.
+     !!
+     !! ** Method  : The velocity components are rotated into frame specified by zcos_w and zsin_w
+     !!
+     !!----------------------------------------------------------------------
+        REAL(wp), DIMENSION(jpi,jpj) :: zcos_w, zsin_w       ! Cos and Sin of rotation angle
+        REAL(wp), DIMENSION(jpi,jpj) :: zu, zv               ! Components of current
+        REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv             ! Change in velocity components across pycnocline
+        INTEGER :: ji, jj
+        REAL(wp) :: ztemp
+        DO_2D( 0, 0, 0, 0 )
+           ztemp = zu(ji,jj)
+           zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj)
+           zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj)
+           ztemp = zdu(ji,jj)
+           zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj)
+           zdv(ji,jj) = zdv(ji,jj) * zsin_w(ji,jj) - ztemp * zsin_w(ji,jj)
+        END_2D
+    END SUBROUTINE zdf_osm_velocity_rotation
+    SUBROUTINE zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_osm_osbl_state_fk  ***
+     !!
+     !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is returned in the logicals lpyc,lflux and lmle. Used with Fox-Kemper scheme.
+     !!  lpyc :: determines whether pycnocline flux-grad relationship needs to be determined
+     !!  lflux :: determines whether effects of surface flux extend below the base of the OSBL
+     !!  lmle  :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl.
+     !!
+     !! ** Method  :
+     !!
+     !!
+     !!----------------------------------------------------------------------
+! Outputs
+      LOGICAL,  DIMENSION(jpi,jpj)  :: lpyc, lflux, lmle
+      REAL(wp), DIMENSION(jpi,jpj)  :: zwb_fk
+!
+      REAL(wp), DIMENSION(jpi,jpj)  :: znd_param
+      REAL(wp)                      :: zbuoy, ztmp, zpe_mle_layer
+      REAL(wp)                      :: zpe_mle_ref, zwb_ent, zdbdz_mle_int
+      znd_param(:,:) = 0._wp
+        DO_2D( 0, 0, 0, 0 )
+          ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf
+          zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj)
+        END_2D
+        DO_2D( 0, 0, 0, 0 )
+                 !
+         IF ( lconv(ji,jj) ) THEN
+           IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN
+             zt_mle(ji,jj) = ( zt_mle(ji,jj) * zhmle(ji,jj) - zt_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )
+             zs_mle(ji,jj) = ( zs_mle(ji,jj) * zhmle(ji,jj) - zs_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )
+             zb_mle(ji,jj) = ( zb_mle(ji,jj) * zhmle(ji,jj) - zb_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )
+             zdbdz_mle_int = ( zb_bl(ji,jj) - ( 2.0 * zb_mle(ji,jj) -zb_bl(ji,jj) ) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )
+! Calculate potential energies of actual profile and reference profile.
+             zpe_mle_layer = 0._wp
+             zpe_mle_ref = 0._wp
+             DO jk = ibld(ji,jj), mld_prof(ji,jj)
+               zbuoy = grav * ( zthermal * ts(ji,jj,jk,jp_tem,Kmm) - zbeta * ts(ji,jj,jk,jp_sal,Kmm) )
+               zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
+               zpe_mle_ref = zpe_mle_ref + ( zb_bl(ji,jj) - zdbdz_mle_int * ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
+             END DO
+! Non-dimensional parameter to diagnose the presence of thermocline
+             znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) / ( MAX( zwb_fk(ji,jj), 1.0e-10 ) * zhmle(ji,jj) )
+           ENDIF
+         ENDIF
+        END_2D
+! Diagnosis
+        DO_2D( 0, 0, 0, 0 )
+          IF ( lconv(ji,jj) ) THEN
+            zwb_ent = - 2.0 * 0.2 * zwbav(ji,jj) &
+               &                  - 0.15 * zustar(ji,jj)**3 /zhml(ji,jj) &
+               &         + ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zustar(ji,jj)**3 &
+               &         - 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj)
+            IF ( -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 ) THEN
+              IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN
+! MLE layer growing
+                IF ( znd_param (ji,jj) > 100. ) THEN
+! Thermocline present
+                  lflux(ji,jj) = .FALSE.
+                  lmle(ji,jj) =.FALSE.
+                ELSE
+! Thermocline not present
+                  lflux(ji,jj) = .TRUE.
+                  lmle(ji,jj) = .TRUE.
+                ENDIF  ! znd_param > 100
+!
+                IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN
+                  lpyc(ji,jj) = .FALSE.
+                ELSE
+                   lpyc = .TRUE.
+                ENDIF
+              ELSE
+! MLE layer restricted to OSBL or just below.
+                IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN
+! Weak stratification MLE layer can grow.
+                  lpyc(ji,jj) = .FALSE.
+                  lflux(ji,jj) = .TRUE.
+                  lmle(ji,jj) = .TRUE.
+                ELSE
+! Strong stratification
+                  lpyc(ji,jj) = .TRUE.
+                  lflux(ji,jj) = .FALSE.
+                  lmle(ji,jj) = .FALSE.
+                ENDIF ! zdb_bl < rn_mle_thresh_bl and
+              ENDIF  ! zhmle > 1.2 zhbl
+            ELSE
+              lpyc(ji,jj) = .TRUE.
+              lflux(ji,jj) = .FALSE.
+              lmle(ji,jj) = .FALSE.
+              IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE.
+            ENDIF !  -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5
+          ELSE
+! Stable Boundary Layer
+            lpyc(ji,jj) = .FALSE.
+            lflux(ji,jj) = .FALSE.
+            lmle(ji,jj) = .FALSE.
+          ENDIF  ! lconv
+        END_2D
+    END SUBROUTINE zdf_osm_osbl_state_fk
+    SUBROUTINE zdf_osm_external_gradients(jbase, zdtdz, zdsdz, zdbdz )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_osm_external_gradients  ***
+     !!
+     !! ** Purpose : Calculates the gradients below the OSBL
+     !!
+     !! ** Method  : Uses ibld and ibld_ext to determine levels to calculate the gradient.
+     !!
+     !!----------------------------------------------------------------------
+     INTEGER, DIMENSION(jpi,jpj)  :: jbase
+     REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz   ! External gradients of temperature, salinity and buoyancy.
+     INTEGER :: jj, ji, jkb, jkb1
+     REAL(wp) :: zthermal, zbeta
+     DO_2D( 0, 0, 0, 0 )
+        IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN
+           zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
+           zbeta    = rab_n(ji,jj,1,jp_sal)
+           jkb = jbase(ji,jj)
+           jkb1 = MIN(jkb + 1, mbkt(ji,jj))
+           zdtdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_tem,Kmm) - ts(ji,jj,jkb,jp_tem,Kmm ) ) &
+                &   / e3t(ji,jj,ibld(ji,jj),Kmm)
+           zdsdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_sal,Kmm) - ts(ji,jj,jkb,jp_sal,Kmm ) ) &
+                &   / e3t(ji,jj,ibld(ji,jj),Kmm)
+           zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj)
+        ELSE
+           zdtdz(ji,jj) = 0._wp
+           zdsdz(ji,jj) = 0._wp
+           zdbdz(ji,jj) = 0._wp
+        END IF
+     END_2D
+    END SUBROUTINE zdf_osm_external_gradients
+    SUBROUTINE zdf_osm_pycnocline_scalar_profiles( zdtdz, zdsdz, zdbdz, zalpha )
+     REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz, zdsdz, zdbdz      ! gradients in the pycnocline
+     REAL(wp), DIMENSION(jpi,jpj) :: zalpha
+     INTEGER :: jk, jj, ji
+     REAL(wp) :: ztgrad, zsgrad, zbgrad
+     REAL(wp) :: zgamma_b_nd, znd
+     REAL(wp) :: zzeta_m, zzeta_en, zbuoy_pyc_sc
+     REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.15
+     DO_2D( 0, 0, 0, 0 )
+        IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN
+           IF ( lconv(ji,jj) ) THEN  ! convective conditions
+             IF ( lpyc(ji,jj) ) THEN
+                zzeta_m = 0.1 + 0.3 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )
+                zalpha(ji,jj) = 2.0 * ( 1.0 - ( 0.80 * zzeta_m + 0.5 * SQRT( 3.14159 / zgamma_b ) ) * zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / zdb_ml(ji,jj) ) / ( 0.723 + SQRT( 3.14159 / zgamma_b ) )
+                zalpha(ji,jj) = MAX( zalpha(ji,jj), 0._wp )
+                ztmp = 1._wp/MAX(zdh(ji,jj), epsln)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Commented lines in this section are not needed in new code, once tested !
+! can be removed                                                          !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                   ztgrad = zalpha * zdt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj)
+!                   zsgrad = zalpha * zds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj)
+                zbgrad = zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp + zdbdz_bl_ext(ji,jj)
+                zgamma_b_nd = zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln)
+                DO jk = 2, ibld(ji,jj)+ibld_ext
+                  znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) * ztmp
+                  IF ( znd <= zzeta_m ) THEN
+!                        zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * zdt_ml(ji,jj) * ztmp * &
+!                &        EXP( -6.0 * ( znd -zzeta_m )**2 )
+!                        zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * zds_ml(ji,jj) * ztmp * &
+!                                  & EXP( -6.0 * ( znd -zzeta_m )**2 )
+                     zdbdz(ji,jj,jk) = zdbdz_bl_ext(ji,jj) + zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp * &
+                               & EXP( -6.0 * ( znd -zzeta_m )**2 )
+                  ELSE
+!                         zdtdz(ji,jj,jk) =  ztgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 )
+!                         zdsdz(ji,jj,jk) =  zsgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 )
+                      zdbdz(ji,jj,jk) =  zbgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 )
+                  ENDIF
+               END DO
+            ENDIF ! if no pycnocline pycnocline gradients set to zero
+           ELSE
+              ! stable conditions
+              ! if pycnocline profile only defined when depth steady of increasing.
+              IF ( zdhdt(ji,jj) > 0.0 ) THEN        ! Depth increasing, or steady.
+                 IF ( zdb_bl(ji,jj) > 0._wp ) THEN
+                    IF ( zhol(ji,jj) >= 0.5 ) THEN      ! Very stable - 'thick' pycnocline
+                       ztmp = 1._wp/MAX(zhbl(ji,jj), epsln)
+                       ztgrad = zdt_bl(ji,jj) * ztmp
+                       zsgrad = zds_bl(ji,jj) * ztmp
+                       zbgrad = zdb_bl(ji,jj) * ztmp
+                       DO jk = 2, ibld(ji,jj)
+                          znd = gdepw(ji,jj,jk,Kmm) * ztmp
+                          zdtdz(ji,jj,jk) =  ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
+                          zdbdz(ji,jj,jk) =  zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
+                          zdsdz(ji,jj,jk) =  zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 )
+                       END DO
+                    ELSE                                   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form.
+                       ztmp = 1._wp/MAX(zdh(ji,jj), epsln)
+                       ztgrad = zdt_bl(ji,jj) * ztmp
+                       zsgrad = zds_bl(ji,jj) * ztmp
+                       zbgrad = zdb_bl(ji,jj) * ztmp
+                       DO jk = 2, ibld(ji,jj)
+                          znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) * ztmp
+                          zdtdz(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
+                          zdbdz(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
+                          zdsdz(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 )
+                       END DO
+                    ENDIF ! IF (zhol >=0.5)
+                 ENDIF    ! IF (zdb_bl> 0.)
+              ENDIF       ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero
+           ENDIF          ! IF (lconv)
+        ENDIF      ! IF ( ibld(ji,jj) < mbkt(ji,jj) )
+     END_2D
+    END SUBROUTINE zdf_osm_pycnocline_scalar_profiles
+    SUBROUTINE zdf_osm_pycnocline_shear_profiles( zdudz, zdvdz )
+         phbl(ji,jj) = gdepw(ji,jj,nbld(ji,jj),Kmm)
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_timestep_hbl
+   SUBROUTINE zdf_osm_pycnocline_thickness( Kmm, pdh, phml, pdhdt, phbl,   &
+      &                                     pwb_ent, pdbdz_bl_ext, pwb_fk_b )
       !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_osm_pycnocline_shear_profiles  ***
+      !!
+      !! ** Purpose : Calculates velocity shear in the pycnocline
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz, zdvdz
+      INTEGER :: jk, jj, ji
+      REAL(wp) :: zugrad, zvgrad, znd
+      REAL(wp) :: zzeta_v = 0.45
+      !
+      DO_2D( 0, 0, 0, 0 )
+         !
+         IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN
+            IF ( lconv (ji,jj) ) THEN
+               ! Unstable conditions. Shouldn;t be needed with no pycnocline code.
+!                  zugrad = 0.7 * zdu_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / &
+!                       &      ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * &
+!                      &      MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 ))
+               !Alan is this right?
+!                  zvgrad = ( 0.7 * zdv_ml(ji,jj) + &
+!                       &    2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / &
+!                       &          ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird  + epsln ) &
+!                       &      )/ (zdh(ji,jj)  + epsln )
+!                  DO jk = 2, ibld(ji,jj) - 1 + ibld_ext
+!                     znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v
+!                     IF ( znd <= 0.0 ) THEN
+!                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd )
+!                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd )
+!                     ELSE
+!                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd )
+!                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd )
+!                     ENDIF
+!                  END DO
+            ELSE
+               ! stable conditions
+               zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj)
+               zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj)
+               DO jk = 2, ibld(ji,jj)
+                  znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
+                  IF ( znd < 1.0 ) THEN
+                     zdudz(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 )
+                  ELSE
+                     zdudz(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 )
+                  ENDIF
+                  zdvdz(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 )
+               END DO
+            ENDIF
+            !
+         END IF      ! IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) )
+      END_2D
+    END SUBROUTINE zdf_osm_pycnocline_shear_profiles
+   SUBROUTINE zdf_osm_calculate_dhdt( zdhdt, zddhdt )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_osm_calculate_dhdt  ***
+     !!
+     !! ** Purpose : Calculates the rate at which hbl changes.
+     !!
+     !! ** Method  :
+     !!
+     !!----------------------------------------------------------------------
+    REAL(wp), DIMENSION(jpi,jpj) :: zdhdt, zddhdt        ! Rate of change of hbl
+    INTEGER :: jj, ji
+    REAL(wp) :: zgamma_b_nd, zgamma_dh_nd, zpert, zpsi
+    REAL(wp) :: zvel_max!, zwb_min
+    REAL(wp) :: zzeta_m = 0.3
+    REAL(wp) :: zgamma_c = 2.0
+    REAL(wp) :: zdhoh = 0.1
+    REAL(wp) :: alpha_bc = 0.5
+    REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth
+  DO_2D( 0, 0, 0, 0 )
+    IF ( lshear(ji,jj) ) THEN
+       IF ( lconv(ji,jj) ) THEN    ! Convective
+          IF ( ln_osm_mle ) THEN
+             IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN
+       ! Fox-Kemper buoyancy flux average over OSBL
+                zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  &
+                     (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) )
+             ELSE
+                zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj)
+             ENDIF
+             zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+             IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN
+                ! OSBL is deepening, entrainment > restratification
+                IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN
+! *** Used for shear Needs to be changed to work stabily
+!                zgamma_b_nd = zdbdz_bl_ext * dh / zdb_ml
+!                zalpha_b = 6.7 * zgamma_b_nd / ( 1.0 + zgamma_b_nd )
+!                zgamma_b = zgamma_b_nd / ( 0.12 * ( 1.25 + zgamma_b_nd ) )
+!                za_1 = 1.0 / zgamma_b**2 - 0.017
+!                za_2 = 1.0 / zgamma_b**3 - 0.0025
+!                zpsi = zalpha_b * ( 1.0 + zgamma_b_nd ) * ( za_1 - 2.0 * za_2 * dh / hbl )
+                   zpsi = 0._wp
+                   zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
+                   zdhdt(ji,jj) = zdhdt(ji,jj)! - zpsi * ( -1.0 / zhml(ji,jj) + 2.4 * zdbdz_bl_ext(ji,jj) / zdb_ml(ji,jj) ) * zwb_min(ji,jj) * zdh(ji,jj) / zdb_bl(ji,jj)
+                   IF ( j_ddh(ji,jj) == 1 ) THEN
+                     IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN
+                        zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+                     ELSE
+                        zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+                     ENDIF
+! Relaxation to dh_ref = zari * hbl
+                     zddhdt(ji,jj) = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj)
+                   ELSE  ! j_ddh == 0
+! Growing shear layer
+                     zddhdt(ji,jj) = -a_ddh * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj)
+                   ENDIF ! j_ddh
+                     zdhdt(ji,jj) = zdhdt(ji,jj) ! + zpsi * zddhdt(ji,jj)
+                ELSE    ! zdb_bl >0
+                   zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1.0e-15)
+                ENDIF
+             ELSE   ! zwb_min + 2*zwb_fk_b < 0
+                ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008)
+                zdhdt(ji,jj) = - zvel_mle(ji,jj)
+             ENDIF
+          ELSE
+             ! Fox-Kemper not used.
+               zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / &
+               &        MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln)
+               zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
+             ! added ajgn 23 July as temporay fix
+          ENDIF  ! ln_osm_mle
+         ELSE    ! lconv - Stable
+             zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj)
+             IF ( zdhdt(ji,jj) < 0._wp ) THEN
+                ! For long timsteps factor in brackets slows the rapid collapse of the OSBL
+                 zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj)
+             ELSE
+                 zpert = MAX( 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) )
+             ENDIF
+             zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln)
+         ENDIF  ! lconv
+    ELSE ! lshear
+      IF ( lconv(ji,jj) ) THEN    ! Convective
+          IF ( ln_osm_mle ) THEN
+             IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN
+       ! Fox-Kemper buoyancy flux average over OSBL
+                zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  &
+                     (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) )
+             ELSE
+                zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj)
+             ENDIF
+             zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+             IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN
+                ! OSBL is deepening, entrainment > restratification
+                IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN
+                   zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
+                ELSE
+                   zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1.0e-15)
+                ENDIF
+             ELSE
+                ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008)
+                zdhdt(ji,jj) = - zvel_mle(ji,jj)
+             ENDIF
+          ELSE
+             ! Fox-Kemper not used.
+               zvel_max = -zwb_ent(ji,jj) / &
+               &        MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln)
+               zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) )
+             ! added ajgn 23 July as temporay fix
+          ENDIF  ! ln_osm_mle
+         ELSE                        ! Stable
+             zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj)
+             IF ( zdhdt(ji,jj) < 0._wp ) THEN
+                ! For long timsteps factor in brackets slows the rapid collapse of the OSBL
+                 zpert = 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj)
+             ELSE
+                 zpert = MAX( 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) )
+             ENDIF
+             zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln)
+         ENDIF  ! lconv
+      ENDIF ! lshear
+  END_2D
+    END SUBROUTINE zdf_osm_calculate_dhdt
+    SUBROUTINE zdf_osm_timestep_hbl( zdhdt )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE zdf_osm_timestep_hbl  ***
+     !!
+     !! ** Purpose : Increments hbl.
+     !!
+     !! ** Method  : If thechange in hbl exceeds one model level the change is
+     !!              is calculated by moving down the grid, changing the buoyancy
+     !!              jump. This is to ensure that the change in hbl does not
+     !!              overshoot a stable layer.
+     !!
+     !!----------------------------------------------------------------------
+    REAL(wp), DIMENSION(jpi,jpj) :: zdhdt   ! rates of change of hbl.
+    INTEGER :: jk, jj, ji, jm
+    REAL(wp) :: zhbl_s, zvel_max, zdb
+    REAL(wp) :: zthermal, zbeta
+     DO_2D( 0, 0, 0, 0 )
+        IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN
+!
+! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths.
+!
+           zhbl_s = hbl(ji,jj)
+           jm = imld(ji,jj)
+           zthermal = rab_n(ji,jj,1,jp_tem)
+           zbeta = rab_n(ji,jj,1,jp_sal)
+           IF ( lconv(ji,jj) ) THEN
+!unstable
+              IF( ln_osm_mle ) THEN
+                 zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+              ELSE
+                 zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / &
+                   &      ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
+              ENDIF
+              DO jk = imld(ji,jj), ibld(ji,jj)
+                 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) &
+                      & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), &
+                      &  0.0 ) + zvel_max
+                 IF ( ln_osm_mle ) THEN
+                    zhbl_s = zhbl_s + MIN( &
+                     & rn_Dt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), &
+                     & e3w(ji,jj,jm,Kmm) )
+                 ELSE
+                   zhbl_s = zhbl_s + MIN( &
+                     & rn_Dt * (  -zwb_ent(ji,jj) / zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), &
+                     & e3w(ji,jj,jm,Kmm) )
+                 ENDIF
+!                    zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol)
+                 IF ( zhbl_s >= gdepw(ji,jj,mbkt(ji,jj) + 1,Kmm) ) THEN
+                   zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol)
+                   lpyc(ji,jj) = .FALSE.
+                 ENDIF
+                 IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1
+              END DO
+              hbl(ji,jj) = zhbl_s
+              ibld(ji,jj) = jm
+          ELSE
+! stable
+              DO jk = imld(ji,jj), ibld(ji,jj)
+                 zdb = MAX( &
+                      & grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) )&
+                      &           - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ),&
+                      & 0.0 ) + &
+          &       2.0 * zvstr(ji,jj)**2 / zhbl_s
+                 ! Alan is thuis right? I have simply changed hbli to hbl
+                 zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) )
+                 zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * &
+            &                  zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) )
+                 zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj)
+                 zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_Dt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w(ji,jj,jm,Kmm) )
+!                    zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol)
+                 IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN
+                   zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol)
+                   lpyc(ji,jj) = .FALSE.
+                 ENDIF
+                 IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1
+              END DO
+          ENDIF   ! IF ( lconv )
+          hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,4,Kmm) )
+          ibld(ji,jj) = MAX(jm, 4 )
+        ELSE
+! change zero or one model level.
+          hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw(ji,jj,4,Kmm) )
+        ENDIF
+        zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm)
+     END_2D
+    END SUBROUTINE zdf_osm_timestep_hbl
+    SUBROUTINE zdf_osm_pycnocline_thickness( dh, zdh )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_osm_pycnocline_thickness  ***
+      !!            ***  ROUTINE zdf_osm_pycnocline_thickness  ***
       !!
       !! ** Purpose : Calculates thickness of the pycnocline
 …
       !!
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: dh, zdh     ! pycnocline thickness.
+       !
+      INTEGER :: jj, ji
+      INTEGER :: inhml
+      REAL(wp) :: zari, ztau, zdh_ref
+      REAL, PARAMETER :: a_ddh_2 = 3.5 ! also in pycnocline_depth
+    DO_2D( 0, 0, 0, 0 )
+      IF ( lshear(ji,jj) ) THEN
+         IF ( lconv(ji,jj) ) THEN
+           IF ( j_ddh(ji,jj) == 0 ) THEN
+! ddhdt for pycnocline determined in osm_calculate_dhdt
+             dh(ji,jj) = dh(ji,jj) + zddhdt(ji,jj) * rn_Dt
+           ELSE
+! Temporary (probably) Recalculate dh_ref to ensure dh doesn't go negative. Can't do this using zddhdt from calculate_dhdt
+             IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN
+               zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+             ELSE
+               zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+             ENDIF
+             ztau = MAX( zdb_bl(ji,jj) * ( zari * hbl(ji,jj) ) / ( a_ddh_2 * MAX(-zwb_ent(ji,jj), 1.e-12) ), 2.0 * rn_Dt )
+             dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zari * zhbl(ji,jj) * ( 1.0 - EXP( -rn_Dt / ztau ) )
+             IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj)
+           ENDIF
+         ELSE ! lconv
+! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL
+            ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln)
+            IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here
+               ! boundary layer deepening
+               IF ( zdb_bl(ji,jj) > 0._wp ) THEN
+                  ! pycnocline thickness set by stratification - use same relationship as for neutral conditions.
+                  zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) &
+                       & /  MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01  , 0.2 )
+                  zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj)
+      INTEGER,                            INTENT(in   ) ::   Kmm            ! Ocean time-level index
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdh            ! Pycnocline thickness
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   phml           ! ML depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdhdt          ! BL depth tendency
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl           ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent        ! Buoyancy entrainment flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_fk_b       ! MLE buoyancy flux averaged over OSBL
+      !!
+      INTEGER  ::   jj, ji
+      INTEGER  ::   inhml
+      REAL(wp) ::   zari, ztau, zdh_ref, zddhdt, zvel_max
+      REAL(wp) ::   ztmp   ! Auxiliary variable
+      !!
+      REAL, PARAMETER ::   pp_ddh = 2.5_wp, pp_ddh_2 = 3.5_wp   ! Also in pycnocline_depth
+      !!----------------------------------------------------------------------
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         !
+         IF ( l_shear(ji,jj) ) THEN
+            !
+            IF ( l_conv(ji,jj) ) THEN
+               !
+               IF ( av_db_bl(ji,jj) > 1e-15_wp ) THEN
+                  IF ( n_ddh(ji,jj) == 0 ) THEN
+                     zvel_max = ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**p2third / hbl(ji,jj)
+                     ! ddhdt for pycnocline determined in osm_calculate_dhdt
+                     zddhdt = -1.0_wp * pp_ddh * ( 1.0_wp - 1.6_wp * pdh(ji,jj) / phbl(ji,jj) ) * pwb_ent(ji,jj) /   &
+                        &     ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15 ) )
+                     zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * phbl(ji,jj) / MAX( sustar(ji,jj), 1e-8 ) ) * zddhdt
+                     ! Maximum limit for how thick the shear layer can grow relative to the thickness of the boundary layer
+                     dh(ji,jj) = MIN( dh(ji,jj) + zddhdt * rn_Dt, 0.625_wp * hbl(ji,jj) )
+                  ELSE   ! Need to recalculate because hbl has been updated
+                     IF ( ( swstrc(ji,jj) / svstr(ji,jj) )**3 <= 0.5_wp ) THEN
+                        ztmp = svstr(ji,jj)
+                     ELSE
+                        ztmp = swstrc(ji,jj)
+                     END IF
+                     zari = MIN( 1.5_wp * av_db_bl(ji,jj) / ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +        &
+                        &                                                   av_db_bl(ji,jj)**2 / MAX( 4.5_wp * ztmp**2,   &
+                        &                                                                           1e-12_wp ) ) ), 0.2_wp )
+                     ztau = MAX( av_db_bl(ji,jj) * ( zari * hbl(ji,jj) ) /   &
+                        &        ( pp_ddh_2 * MAX( -1.0_wp * pwb_ent(ji,jj), 1e-12_wp ) ), 2.0_wp * rn_Dt )
+                     dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) +   &
+                        &        zari * phbl(ji,jj) * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) )
+                     IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * phbl(ji,jj)
+                  END IF
                ELSE
+                  zdh_ref = 0.2 * hbl(ji,jj)
+                  ztau = MAX( MAX( hbl(ji,jj) / ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird, epsln), 2.0_wp * rn_Dt )
+                  dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) +   &
+                     &        0.2_wp * phbl(ji,jj) * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) )
+                  IF ( dh(ji,jj) > hbl(ji,jj) ) dh(ji,jj) = 0.2_wp * hbl(ji,jj)
+               END IF
+               !
+            ELSE   ! l_conv
+               ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL
+               ztau = hbl(ji,jj) / MAX(svstr(ji,jj), epsln)
+               IF ( pdhdt(ji,jj) >= 0.0_wp ) THEN   ! Probably shouldn't include wm here
+                  ! Boundary layer deepening
+                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN
+                     ! Pycnocline thickness set by stratification - use same relationship as for neutral conditions
+                     zari    = MIN( 4.5_wp * ( svstr(ji,jj)**2 ) / MAX( av_db_bl(ji,jj) * phbl(ji,jj), epsln ) + 0.01_wp, 0.2_wp )
+                     zdh_ref = MIN( zari, 0.2_wp ) * hbl(ji,jj)
+                  ELSE
+                     zdh_ref = 0.2_wp * hbl(ji,jj)
+                  ENDIF
+               ELSE   ! IF(dhdt < 0)
+                  zdh_ref = 0.2_wp * hbl(ji,jj)
+               ENDIF   ! IF (dhdt >= 0)
+               dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + zdh_ref * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) )
+               IF ( pdhdt(ji,jj) < 0.0_wp .AND. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref   ! Can be a problem with dh>hbl for
+               !                                                                                !    rapid collapse
+            ENDIF
+            !
+         ELSE   ! l_shear = .FALSE., calculate ddhdt here
+            !
+            IF ( l_conv(ji,jj) ) THEN
+               !
+               IF( ln_osm_mle ) THEN
+                  IF ( ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) < 0.0_wp ) THEN   ! OSBL is deepening. Note wb_fk_b is zero if
+                     !                                                                 !    ln_osm_mle=F
+                     IF ( av_db_bl(ji,jj) > 0.0_wp .AND. pdbdz_bl_ext(ji,jj) > 0.0_wp ) THEN
+                        IF ( ( swstrc(ji,jj) / MAX( svstr(ji,jj), epsln) )**3 <= 0.5_wp ) THEN   ! Near neutral stability
+                           ztmp = svstr(ji,jj)
+                        ELSE   ! Unstable
+                           ztmp = swstrc(ji,jj)
+                        END IF
+                        zari = MIN( 1.5_wp * av_db_bl(ji,jj) /                               &
+                           &        ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +   &
+                           &                          av_db_bl(ji,jj)**2 / MAX( 4.5_wp * ztmp**2 , 1e-12_wp ) ) ), 0.2_wp )
+                     ELSE
+                        zari = 0.2_wp
+                     END IF
+                  ELSE
+                     zari = 0.2_wp
+                  END IF
+                  ztau    = 0.2_wp * hbl(ji,jj) / MAX( epsln, ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird )
+                  zdh_ref = zari * hbl(ji,jj)
+               ELSE   ! ln_osm_mle
+                  IF ( av_db_bl(ji,jj) > 0.0_wp .AND. pdbdz_bl_ext(ji,jj) > 0.0_wp ) THEN
+                     IF ( ( swstrc(ji,jj) / MAX( svstr(ji,jj), epsln ) )**3 <= 0.5_wp ) THEN   ! Near neutral stability
+                        ztmp = svstr(ji,jj)
+                     ELSE   ! Unstable
+                        ztmp = swstrc(ji,jj)
+                     END IF
+                     zari    = MIN( 1.5_wp * av_db_bl(ji,jj) /                               &
+                        &           ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +   &
+                        &                             av_db_bl(ji,jj)**2 / MAX( 4.5_wp * ztmp**2 , 1e-12_wp ) ) ), 0.2_wp )
+                  ELSE
+                     zari    = 0.2_wp
+                  END IF
+                  ztau    = hbl(ji,jj) / MAX( epsln, ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird )
+                  zdh_ref = zari * hbl(ji,jj)
+               END IF   ! ln_osm_mle
+               dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + zdh_ref * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) )
+               !               IF ( pdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref
+               IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref
+               ! Alan: this hml is never defined or used
+            ELSE   ! IF (l_conv)
+               !
+               ztau = hbl(ji,jj) / MAX( svstr(ji,jj), epsln )
+               IF ( pdhdt(ji,jj) >= 0.0_wp ) THEN   ! Probably shouldn't include wm here
+                  ! Boundary layer deepening
+                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN
+                     ! Pycnocline thickness set by stratification - use same relationship as for neutral conditions.
+                     zari    = MIN( 4.5_wp * ( svstr(ji,jj)**2 ) / MAX( av_db_bl(ji,jj) * phbl(ji,jj), epsln ) + 0.01_wp , 0.2_wp )
+                     zdh_ref = MIN( zari, 0.2_wp ) * hbl(ji,jj)
+                  ELSE
+                     zdh_ref = 0.2_wp * hbl(ji,jj)
+                  END IF
+               ELSE   ! IF(dhdt < 0)
+                  zdh_ref = 0.2_wp * hbl(ji,jj)
+               END IF   ! IF (dhdt >= 0)
+               dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + zdh_ref * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) )
+               IF ( pdhdt(ji,jj) < 0.0_wp .AND. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref   ! Can be a problem with dh>hbl for
+               !                                                                                !    rapid collapse
+            END IF   ! IF (l_conv)
+            !
+         END IF   ! l_shear
+         !
+         hml(ji,jj)  = hbl(ji,jj) - dh(ji,jj)
+         inhml       = MAX( INT( dh(ji,jj) / MAX( e3t(ji,jj,nbld(ji,jj)-1,Kmm), 1e-3_wp ) ), 1 )
+         nmld(ji,jj) = MAX( nbld(ji,jj) - inhml, 3 )
+         phml(ji,jj) = gdepw(ji,jj,nmld(ji,jj),Kmm)
+         pdh(ji,jj)  = phbl(ji,jj) - phml(ji,jj)
+         !
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_pycnocline_thickness
+   SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles( Kmm, kp_ext, pdbdz, palpha, pdh,   &
+      &                                             phbl, pdbdz_bl_ext, phml, pdhdt )
+      !!---------------------------------------------------------------------
+      !!       ***  ROUTINE zdf_osm_pycnocline_buoyancy_profiles  ***
+      !!
+      !! ** Purpose : calculate pycnocline buoyancy profiles
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                                 INTENT(in   ) ::   Kmm            ! Ocean time-level index
+      INTEGER,  DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   kp_ext         ! External-level offsets
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(  out) ::   pdbdz          ! Gradients in the pycnocline
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(  out) ::   palpha
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdh            ! Pycnocline thickness
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phbl           ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phml           ! ML depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdhdt          ! Rates of change of hbl
+      !!
+      INTEGER  ::   jk, jj, ji
+      REAL(wp) ::   zbgrad
+      REAL(wp) ::   zgamma_b_nd, znd
+      REAL(wp) ::   zzeta_m
+      REAL(wp) ::   ztmp   ! Auxiliary variable
+      !!
+      REAL(wp), PARAMETER ::   pp_gamma_b = 2.25_wp
+      REAL(wp), PARAMETER ::   pp_large   = -1e10_wp
+      !!----------------------------------------------------------------------
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pdbdz(ji,jj,:) = pp_large
+         palpha(ji,jj)  = pp_large
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         !
+         IF ( nbld(ji,jj) + kp_ext(ji,jj) < mbkt(ji,jj) ) THEN
+            !
+            IF ( l_conv(ji,jj) ) THEN   ! Convective conditions
+               !
+               IF ( l_pyc(ji,jj) ) THEN
+                  !
+                  zzeta_m = 0.1_wp + 0.3_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )
+                  palpha(ji,jj) = 2.0_wp * ( 1.0_wp - ( 0.80_wp * zzeta_m + 0.5_wp * SQRT( 3.14159_wp / pp_gamma_b ) ) *   &
+                     &                                pdbdz_bl_ext(ji,jj) * pdh(ji,jj) / av_db_ml(ji,jj) ) /                &
+                     &            ( 0.723_wp + SQRT( 3.14159_wp / pp_gamma_b ) )
+                  palpha(ji,jj) = MAX( palpha(ji,jj), 0.0_wp )
+                  ztmp = 1.0_wp / MAX( pdh(ji,jj), epsln )
+                  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+                  ! Commented lines in this section are not needed in new code, once tested !
+                  ! can be removed                                                          !
+                  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+                  ! ztgrad = zalpha * av_dt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj)
+                  ! zsgrad = zalpha * av_ds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj)
+                  zbgrad = palpha(ji,jj) * av_db_ml(ji,jj) * ztmp + pdbdz_bl_ext(ji,jj)
+                  zgamma_b_nd = pdbdz_bl_ext(ji,jj) * pdh(ji,jj) / MAX( av_db_ml(ji,jj), epsln )
+                  DO jk = 2, nbld(ji,jj)
+                     znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) * ztmp
+                     IF ( znd <= zzeta_m ) THEN
+                        ! zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * av_dt_ml(ji,jj) * ztmp * &
+                        ! &        EXP( -6.0 * ( znd -zzeta_m )**2 )
+                        ! zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * av_ds_ml(ji,jj) * ztmp * &
+                        ! & EXP( -6.0 * ( znd -zzeta_m )**2 )
+                        pdbdz(ji,jj,jk) = pdbdz_bl_ext(ji,jj) + palpha(ji,jj) * av_db_ml(ji,jj) * ztmp * &
+                           & EXP( -6.0_wp * ( znd -zzeta_m )**2 )
+                     ELSE
+                        ! zdtdz(ji,jj,jk) =  ztgrad * EXP( -pp_gamma_b * ( znd - zzeta_m )**2 )
+                        ! zdsdz(ji,jj,jk) =  zsgrad * EXP( -pp_gamma_b * ( znd - zzeta_m )**2 )
+                        pdbdz(ji,jj,jk) =  zbgrad * EXP( -1.0_wp * pp_gamma_b * ( znd - zzeta_m )**2 )
+                     END IF
+                  END DO
+               END IF   ! If no pycnocline pycnocline gradients set to zero
+               !
+            ELSE   ! Stable conditions
+               ! If pycnocline profile only defined when depth steady of increasing.
+               IF ( pdhdt(ji,jj) > 0.0_wp ) THEN   ! Depth increasing, or steady.
+                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN
+                     IF ( shol(ji,jj) >= 0.5_wp ) THEN   ! Very stable - 'thick' pycnocline
+                        ztmp = 1.0_wp / MAX( phbl(ji,jj), epsln )
+                        zbgrad = av_db_bl(ji,jj) * ztmp
+                        DO jk = 2, nbld(ji,jj)
+                           znd = gdepw(ji,jj,jk,Kmm) * ztmp
+                           pdbdz(ji,jj,jk) = zbgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 )
+                        END DO
+                     ELSE   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form.
+                        ztmp = 1.0_wp / MAX( pdh(ji,jj), epsln )
+                        zbgrad = av_db_bl(ji,jj) * ztmp
+                        DO jk = 2, nbld(ji,jj)
+                           znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phml(ji,jj) ) * ztmp
+                           pdbdz(ji,jj,jk) = zbgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 )
+                        END DO
+                     END IF   ! IF (shol >=0.5)
+                  END IF      ! IF (av_db_bl> 0.)
+               END IF         ! IF (pdhdt >= 0) pdhdt < 0 not considered since pycnocline profile is zero and profile arrays are
+               !              !    intialized to zero
+               !
+            END IF            ! IF (l_conv)
+            !
+         END IF   ! IF ( nbld(ji,jj) < mbkt(ji,jj) )
+         !
+      END_2D
+      !
+      IF ( ln_dia_pyc_scl ) THEN   ! Output of pycnocline gradient profiles
+         CALL zdf_osm_iomput( "zdbdz_pyc", wmask(A2D(0),:) * pdbdz(A2D(0),:) )
+      END IF
+      !
+   END SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles
+   SUBROUTINE zdf_osm_diffusivity_viscosity( Kbb, Kmm, pdiffut, pviscos, phbl,   &
+      &                                      phml, pdh, pdhdt, pshear,           &
+      &                                      pwb_ent, pwb_min )
+      !!---------------------------------------------------------------------
+      !!           ***  ROUTINE zdf_osm_diffusivity_viscosity  ***
+      !!
+      !! ** Purpose : Determines the eddy diffusivity and eddy viscosity
+      !!              profiles in the mixed layer and the pycnocline.
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                                 INTENT(in   ) ::   Kbb, Kmm       ! Ocean time-level indices
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(inout) ::   pdiffut        ! t-diffusivity
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(inout) ::   pviscos        ! Viscosity
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phbl           ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phml           ! ML depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdh            ! Pycnocline depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdhdt          ! BL depth tendency
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pshear         ! Shear production
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pwb_ent        ! Buoyancy entrainment flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pwb_min
+      !!
+      INTEGER ::   ji, jj, jk   ! Loop indices
+      !! Scales used to calculate eddy diffusivity and viscosity profiles
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdifml_sc,    zvisml_sc
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdifpyc_n_sc, zdifpyc_s_sc
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zvispyc_n_sc, zvispyc_s_sc
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zbeta_d_sc,   zbeta_v_sc
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zb_coup,      zc_coup_vis,  zc_coup_dif
+      !!
+      REAL(wp) ::   zvel_sc_pyc, zvel_sc_ml, zstab_fac, zz_b
+      REAL(wp) ::   za_cubic, zb_d_cubic, zc_d_cubic, zd_d_cubic,   &   ! Coefficients in cubic polynomial specifying diffusivity
+         &                    zb_v_cubic, zc_v_cubic, zd_v_cubic        ! and viscosity in pycnocline
+      REAL(wp) ::   zznd_ml, zznd_pyc, ztmp
+      REAL(wp) ::   zmsku, zmskv
+      !!
+      REAL(wp), PARAMETER ::   pp_dif_ml     = 0.8_wp,  pp_vis_ml  = 0.375_wp
+      REAL(wp), PARAMETER ::   pp_dif_pyc    = 0.15_wp, pp_vis_pyc = 0.142_wp
+      REAL(wp), PARAMETER ::   pp_vispyc_shr = 0.15_wp
+      !!----------------------------------------------------------------------
+      !
+      zb_coup(:,:) = 0.0_wp
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_conv(ji,jj) ) THEN
+            !
+            zvel_sc_pyc = ( 0.15_wp * svstr(ji,jj)**3 + swstrc(ji,jj)**3 + 4.25_wp * pshear(ji,jj) * phbl(ji,jj) )**pthird
+            zvel_sc_ml  = ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird
+            zstab_fac   = ( phml(ji,jj) / zvel_sc_ml *   &
+               &            ( 1.4_wp - 0.4_wp / ( 1.0_wp + EXP(-3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )**1.25_wp ) )**2
+            !
+            zdifml_sc(ji,jj) = pp_dif_ml * phml(ji,jj) * zvel_sc_ml
+            zvisml_sc(ji,jj) = pp_vis_ml * zdifml_sc(ji,jj)
+            !
+            IF ( l_pyc(ji,jj) ) THEN
+               zdifpyc_n_sc(ji,jj) = pp_dif_pyc * zvel_sc_ml * pdh(ji,jj)
+               zvispyc_n_sc(ji,jj) = 0.09_wp * zvel_sc_pyc * ( 1.0_wp - phbl(ji,jj) / pdh(ji,jj) )**2 *   &
+                  &                  ( 0.005_wp  * ( av_u_ml(ji,jj) - av_u_bl(ji,jj) )**2 +     &
+                  &                    0.0075_wp * ( av_v_ml(ji,jj) - av_v_bl(ji,jj) )**2 ) /   &
+                  &                  pdh(ji,jj)
+               zvispyc_n_sc(ji,jj) = pp_vis_pyc * zvel_sc_ml * pdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac
+               !
+               IF ( l_shear(ji,jj) .AND. n_ddh(ji,jj) /= 2 ) THEN
+                  ztmp = pp_vispyc_shr * ( pshear(ji,jj) * phbl(ji,jj) )**pthird * phbl(ji,jj)
+                  zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + ztmp
+                  zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + ztmp
                ENDIF
+            ELSE     ! IF(dhdt < 0)
+               zdh_ref = 0.2 * hbl(ji,jj)
+            ENDIF    ! IF (dhdt >= 0)
+            dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) )
+            IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref       ! can be a problem with dh>hbl for rapid collapse
+            ! Alan: this hml is never defined or used -- do we need it?
+               !
+               zdifpyc_s_sc(ji,jj) = pwb_ent(ji,jj) + 0.0025_wp * zvel_sc_pyc * ( phbl(ji,jj) / pdh(ji,jj) - 1.0_wp ) *   &
+                  &                                   ( av_b_ml(ji,jj) - av_b_bl(ji,jj) )
+               zvispyc_s_sc(ji,jj) = 0.09_wp * ( pwb_min(ji,jj) + 0.0025_wp * zvel_sc_pyc *                 &
+                  &                                               ( phbl(ji,jj) / pdh(ji,jj) - 1.0_wp ) *   &
+                  &                                               ( av_b_ml(ji,jj) - av_b_bl(ji,jj) ) )
+               zdifpyc_s_sc(ji,jj) = 0.09_wp * zdifpyc_s_sc(ji,jj) * zstab_fac
+               zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac
+               !
+               zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5_wp * zdifpyc_n_sc(ji,jj) )
+               zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5_wp * zvispyc_n_sc(ji,jj) )
+               zbeta_d_sc(ji,jj) = 1.0_wp - ( ( zdifpyc_n_sc(ji,jj) + 1.4_wp * zdifpyc_s_sc(ji,jj) ) /   &
+                  &                           ( zdifml_sc(ji,jj) + epsln ) )**p2third
+               zbeta_v_sc(ji,jj) = 1.0_wp - 2.0_wp * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln )
+            ELSE
+               zdifpyc_n_sc(ji,jj) = pp_dif_pyc * zvel_sc_ml * pdh(ji,jj)   ! ag 19/03
+               zdifpyc_s_sc(ji,jj) = 0.0_wp   ! ag 19/03
+               zvispyc_n_sc(ji,jj) = pp_vis_pyc * zvel_sc_ml * pdh(ji,jj)   ! ag 19/03
+               zvispyc_s_sc(ji,jj) = 0.0_wp   ! ag 19/03
+               IF(l_coup(ji,jj) ) THEN   ! ag 19/03
+                  ! code from SUBROUTINE tke_tke zdftke.F90; uses bottom drag velocity rCdU_bot(ji,jj) = -Cd|ub|
+                  !     already calculated at T-points in SUBROUTINE zdf_drg from zdfdrg.F90
+                  !  Gives friction velocity sqrt bottom drag/rho_0 i.e. u* = SQRT(rCdU_bot*ub)
+                  ! wet-cell averaging ..
+                  zmsku = 0.5_wp * ( 2.0_wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
+                  zmskv = 0.5_wp * ( 2.0_wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )
+                  zb_coup(ji,jj) = 0.4_wp * SQRT(-1.0_wp * rCdU_bot(ji,jj) *   &
+                     &             SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2   &
+                     &                  + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  ) )
+                  zz_b = -1.0_wp * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)   ! ag 19/03
+                  zc_coup_vis(ji,jj) = -0.5_wp * ( 0.5_wp * zvisml_sc(ji,jj) / phml(ji,jj) - zb_coup(ji,jj) ) /   &
+                     &                 ( phml(ji,jj) + zz_b )   ! ag 19/03
+                  zz_b = -1.0_wp * phml(ji,jj) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)   ! ag 19/03
+                  zbeta_v_sc(ji,jj) = 1.0_wp - 2.0_wp * ( zb_coup(ji,jj) * zz_b + zc_coup_vis(ji,jj) * zz_b**2 ) /   &
+                     &                                  zvisml_sc(ji,jj)   ! ag 19/03
+                  zbeta_d_sc(ji,jj) = 1.0_wp - ( ( zb_coup(ji,jj) * zz_b + zc_coup_vis(ji,jj) * zz_b**2 ) /   &
+                     &                           zdifml_sc(ji,jj) )**p2third
+                  zc_coup_dif(ji,jj) = 0.5_wp * ( -zdifml_sc(ji,jj) / phml(ji,jj) * ( 1.0_wp - zbeta_d_sc(ji,jj) )**1.5_wp +   &
+                     &                 1.5_wp * ( zdifml_sc(ji,jj) / phml(ji,jj) ) * zbeta_d_sc(ji,jj) *   &
+                     &                          SQRT( 1.0_wp - zbeta_d_sc(ji,jj) ) - zb_coup(ji,jj) ) / zz_b   ! ag 19/03
+               ELSE   ! ag 19/03
+                  zbeta_d_sc(ji,jj) = 1.0_wp - ( ( zdifpyc_n_sc(ji,jj) + 1.4_wp * zdifpyc_s_sc(ji,jj) ) /   &
+                     &                           ( zdifml_sc(ji,jj) + epsln ) )**p2third   ! ag 19/03
+                  zbeta_v_sc(ji,jj) = 1.0_wp - 2.0_wp * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) /   &
+                     &                         ( zvisml_sc(ji,jj) + epsln )   ! ag 19/03
+               ENDIF   ! ag 19/03
+            ENDIF      ! ag 19/03
+         ELSE
+            zdifml_sc(ji,jj) = svstr(ji,jj) * phbl(ji,jj) * MAX( EXP ( -1.0_wp * ( shol(ji,jj) / 0.6_wp )**2 ), 0.2_wp)
+            zvisml_sc(ji,jj) = zdifml_sc(ji,jj)
+         END IF
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_conv(ji,jj) ) THEN
+            DO jk = 2, nmld(ji,jj)   ! Mixed layer diffusivity
+               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj)
+               pdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zbeta_d_sc(ji,jj) * zznd_ml )**1.5
+               pviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zbeta_v_sc(ji,jj) * zznd_ml ) *   &
+                  &                ( 1.0_wp - 0.5_wp * zznd_ml**2 )
+            END DO
+            !
+            ! Coupling to bottom
+            !
+            IF ( l_coup(ji,jj) ) THEN                                                         ! ag 19/03
+               DO jk = mbkt(ji,jj), nmld(ji,jj), -1                                           ! ag 19/03
+                  zz_b = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) )   ! ag 19/03
+                  pviscos(ji,jj,jk) = zb_coup(ji,jj) * zz_b + zc_coup_vis(ji,jj) * zz_b**2    ! ag 19/03
+                  pdiffut(ji,jj,jk) = zb_coup(ji,jj) * zz_b + zc_coup_dif(ji,jj) * zz_b**2    ! ag 19/03
+               END DO                                                                         ! ag 19/03
+            ENDIF                                                                             ! ag 19/03
+            ! Pycnocline
+            IF ( l_pyc(ji,jj) ) THEN
+               ! Diffusivity and viscosity profiles in the pycnocline given by
+               ! cubic polynomial. Note, if l_pyc TRUE can't be coupled to seabed.
+               za_cubic = 0.5_wp
+               zb_d_cubic = -1.75_wp * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj)
+               zd_d_cubic = ( pdh(ji,jj) * zdifml_sc(ji,jj) / phml(ji,jj) * SQRT( 1.0_wp - zbeta_d_sc(ji,jj) ) *   &
+                  &           ( 2.5_wp * zbeta_d_sc(ji,jj) - 1.0_wp ) - 0.85_wp * zdifpyc_s_sc(ji,jj) ) /            &
+                  &           MAX( zdifpyc_n_sc(ji,jj), 1.0e-8_wp )
+               zd_d_cubic = zd_d_cubic - zb_d_cubic - 2.0_wp * ( 1.0_wp - za_cubic  - zb_d_cubic )
+               zc_d_cubic = 1.0_wp - za_cubic - zb_d_cubic - zd_d_cubic
+               zb_v_cubic = -1.75_wp * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj)
+               zd_v_cubic = ( 0.5_wp * zvisml_sc(ji,jj) * pdh(ji,jj) / phml(ji,jj) - 0.85_wp * zvispyc_s_sc(ji,jj) ) /   &
+                  &           MAX( zvispyc_n_sc(ji,jj), 1.0e-8_wp )
+               zd_v_cubic = zd_v_cubic - zb_v_cubic - 2.0_wp * ( 1.0_wp - za_cubic - zb_v_cubic )
+               zc_v_cubic = 1.0_wp - za_cubic - zb_v_cubic - zd_v_cubic
+               DO jk = nmld(ji,jj) , nbld(ji,jj)
+                  zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / MAX(pdh(ji,jj), 1.0e-6_wp )
+                  ztmp = ( 1.75_wp * zznd_pyc - 0.15_wp * zznd_pyc**2 - 0.2_wp * zznd_pyc**3 )
+                  !
+                  pdiffut(ji,jj,jk) = zdifpyc_n_sc(ji,jj) *   &
+                     &                ( za_cubic + zb_d_cubic * zznd_pyc + zc_d_cubic * zznd_pyc**2 + zd_d_cubic * zznd_pyc**3 )
+                  !
+                  pdiffut(ji,jj,jk) = pdiffut(ji,jj,jk) + zdifpyc_s_sc(ji,jj) * ztmp
+                  pviscos(ji,jj,jk) = zvispyc_n_sc(ji,jj) *   &
+                     &                ( za_cubic + zb_v_cubic * zznd_pyc + zc_v_cubic * zznd_pyc**2 + zd_v_cubic * zznd_pyc**3 )
+                  pviscos(ji,jj,jk) = pviscos(ji,jj,jk) + zvispyc_s_sc(ji,jj) * ztmp
+               END DO
+   !                  IF ( pdhdt(ji,jj) > 0._wp ) THEN
+   !                     zdiffut(ji,jj,nbld(ji,jj)+1) = MAX( 0.5 * pdhdt(ji,jj) * e3w(ji,jj,nbld(ji,jj)+1,Kmm), 1.0e-6 )
+   !                     zviscos(ji,jj,nbld(ji,jj)+1) = MAX( 0.5 * pdhdt(ji,jj) * e3w(ji,jj,nbld(ji,jj)+1,Kmm), 1.0e-6 )
+   !                  ELSE
+   !                     zdiffut(ji,jj,nbld(ji,jj)) = 0._wp
+   !                     zviscos(ji,jj,nbld(ji,jj)) = 0._wp
+   !                  ENDIF
+            ENDIF
+         ELSE
+            ! Stable conditions
+            DO jk = 2, nbld(ji,jj)
+               zznd_ml = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj)
+               pdiffut(ji,jj,jk) = 0.75_wp * zdifml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zznd_ml )**1.5_wp
+               pviscos(ji,jj,jk) = 0.375_wp * zvisml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zznd_ml ) * ( 1.0_wp - zznd_ml**2 )
+            END DO
+            !
+            IF ( pdhdt(ji,jj) > 0.0_wp ) THEN
+               pdiffut(ji,jj,nbld(ji,jj)) = MAX( pdhdt(ji,jj), 1.0e-6_wp) * e3w(ji, jj, nbld(ji,jj), Kmm)
+               pviscos(ji,jj,nbld(ji,jj)) = pdiffut(ji,jj,nbld(ji,jj))
+            ENDIF
+         ENDIF   ! End if ( l_conv )
+         !
+      END_2D
+      CALL zdf_osm_iomput( "pb_coup", tmask(A2D(0),1) * zb_coup(A2D(0)) )   ! BBL-coupling velocity scale
+      !
+   END SUBROUTINE zdf_osm_diffusivity_viscosity
+   SUBROUTINE zdf_osm_fgr_terms( Kmm, kp_ext, phbl, phml, pdh,                              &
+      &                          pdhdt, pshear, pdtdz_bl_ext, pdsdz_bl_ext, pdbdz_bl_ext,   &
+      &                          pdiffut, pviscos )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE zdf_osm_fgr_terms ***
+      !!
+      !! ** Purpose : Compute non-gradient terms in flux-gradient relationship
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                                 INTENT(in   ) ::   Kmm            ! Time-level index
+      INTEGER,  DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   kp_ext         ! Offset for external level
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phbl           ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phml           ! ML depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdh            ! Pycnocline depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdhdt          ! BL depth tendency
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pshear         ! Shear production
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdtdz_bl_ext   ! External temperature gradients
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdsdz_bl_ext   ! External salinity gradients
+      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(in   ) ::   pdiffut        ! t-diffusivity
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(in   ) ::   pviscos        ! Viscosity
+      !!
+      REAL(wp), DIMENSION(A2D(nn_hls-1))     ::   zalpha_pyc   !
+      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk) ::   zdbdz_pyc    ! Parametrised gradient of buoyancy in the pycnocline
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   z3ddz_pyc_1, z3ddz_pyc_2   ! Pycnocline gradient/shear profiles
+      !!
+      INTEGER                            ::   ji, jj, jk, jkm_bld, jkf_mld, jkm_mld   ! Loop indices
+      INTEGER                            ::   istat                                   ! Memory allocation status
+      REAL(wp)                           ::   zznd_d, zznd_ml, zznd_pyc, znd          ! Temporary non-dimensional depths
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_wth_1,zsc_ws_1                      ! Temporary scales
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_uw_1, zsc_uw_2                      ! Temporary scales
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_vw_1, zsc_vw_2                      ! Temporary scales
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   ztau_sc_u                               ! Dissipation timescale at base of WML
+      REAL(wp)                           ::   zbuoy_pyc_sc, zdelta_pyc                !
+      REAL(wp)                           ::   zl_c,zl_l,zl_eps                        ! Used to calculate turbulence length scale
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   za_cubic, zb_cubic                      ! Coefficients in cubic polynomial specifying
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zc_cubic, zd_cubic                      !    diffusivity in pycnocline
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwt_pyc_sc_1, zws_pyc_sc_1              !
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zzeta_pyc                               !
+      REAL(wp)                           ::   zomega, zvw_max                         !
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zuw_bse,zvw_bse                         ! Momentum, heat, and salinity fluxes
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwth_ent,zws_ent                        !    at the top of the pycnocline
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_wth_pyc, zsc_ws_pyc                 ! Scales for pycnocline transport term
+      REAL(wp)                           ::   ztmp                                    !
+      REAL(wp)                           ::   ztgrad, zsgrad, zbgrad                  ! Variables used to calculate pycnocline
+      !!                                                                              !    gradients
+      REAL(wp)                           ::   zugrad, zvgrad                          ! Variables for calculating pycnocline shear
+      REAL(wp)                           ::   zdtdz_pyc                               ! Parametrized gradient of temperature in
+      !!                                                                              !    pycnocline
+      REAL(wp)                           ::   zdsdz_pyc                               ! Parametrised gradient of salinity in
+      !!                                                                              !    pycnocline
+      REAL(wp)                           ::   zdudz_pyc                               ! u-shear across the pycnocline
+      REAL(wp)                           ::   zdvdz_pyc                               ! v-shear across the pycnocline
+      !!----------------------------------------------------------------------
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Pycnocline gradients for scalars and velocity
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      CALL zdf_osm_pycnocline_buoyancy_profiles( Kmm, kp_ext, zdbdz_pyc, zalpha_pyc, pdh,    &
+         &                                       phbl, pdbdz_bl_ext, phml, pdhdt )
+      !
+      ! Auxiliary indices
+      ! -----------------
+      jkm_bld = 0
+      jkf_mld = jpk
+      jkm_mld = 0
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( nbld(ji,jj) > jkm_bld ) jkm_bld = nbld(ji,jj)
+         IF ( nmld(ji,jj) < jkf_mld ) jkf_mld = nmld(ji,jj)
+         IF ( nmld(ji,jj) > jkm_mld ) jkm_mld = nmld(ji,jj)
+      END_2D
+      !
+      ! Stokes term in scalar flux, flux-gradient relationship
+      ! ------------------------------------------------------
+      WHERE ( l_conv(A2D(nn_hls-1)) )
+         zsc_wth_1(:,:) = swstrl(A2D(nn_hls-1))**3 * swth0(A2D(nn_hls-1)) /   &
+            &             ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln )
+         zsc_ws_1(:,:)  = swstrl(A2D(nn_hls-1))**3 * sws0(A2D(nn_hls-1))  /   &
+            &             ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln )
+      ELSEWHERE
+         zsc_wth_1(:,:) = 2.0_wp * swthav(A2D(nn_hls-1))
+         zsc_ws_1(:,:)  = 2.0_wp * swsav(A2D(nn_hls-1))
+      ENDWHERE
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) )
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( jk <= nmld(ji,jj) ) THEN
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35_wp * EXP( -1.0_wp * zznd_d ) *   &
+                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) * zsc_wth_1(ji,jj)
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35_wp * EXP( -1.0_wp * zznd_d ) *   &
+                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) * zsc_ws_1(ji,jj)
+            END IF
+         ELSE   ! Stable conditions
+            IF ( jk <= nbld(ji,jj) ) THEN
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 2.15_wp * EXP( -0.85_wp * zznd_d ) *   &
+                  &                                ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) * zsc_wth_1(ji,jj)
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 2.15_wp * EXP( -0.85_wp * zznd_d ) *   &
+                  &                                ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) * zsc_ws_1(ji,jj)
+            END IF
+         END IF   ! Check on l_conv
+      END_3D
+      !
+      IF ( ln_dia_osm ) THEN
+         CALL zdf_osm_iomput( "ghamu_00", wmask(A2D(0),:) * ghamu(A2D(0),:) )
+         CALL zdf_osm_iomput( "ghamv_00", wmask(A2D(0),:) * ghamv(A2D(0),:) )
+      END IF
+      !
+      ! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use
+      ! svstr since term needs to go to zero as swstrl goes to zero)
+      ! ---------------------------------------------------------------------
+      WHERE ( l_conv(A2D(nn_hls-1)) )
+         zsc_uw_1(:,:) = ( swstrl(A2D(nn_hls-1))**3 +                                                &
+            &              0.5_wp * swstrc(A2D(nn_hls-1))**3 )**pthird * sustke(A2D(nn_hls-1)) /   &
+            &              MAX( ( 1.0_wp - 1.0_wp * 6.5_wp * sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ) ), 0.2_wp )
+         zsc_uw_2(:,:) = ( swstrl(A2D(nn_hls-1))**3 +                                                &
+            &              0.5_wp * swstrc(A2D(nn_hls-1))**3 )**pthird * sustke(A2D(nn_hls-1)) /   &
+            &              MIN( sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ) + epsln, 0.12_wp )
+         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * phml(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1))**3 *   &
+            &            MIN( sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ), 0.12_wp ) /                    &
+            &            ( ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 )**( 2.0_wp / 3.0_wp ) + epsln )
+      ELSEWHERE
+         zsc_uw_1(:,:) = sustar(A2D(nn_hls-1))**2
+         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * phbl(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1))**3 *   &
+            &            MIN( sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ), 0.12_wp ) / ( svstr(A2D(nn_hls-1))**2 + epsln )
+      ENDWHERE
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) )
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( jk <= nmld(ji,jj) ) THEN
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + ( -0.05_wp   * EXP( -0.4_wp * zznd_d ) * zsc_uw_1(ji,jj) +     &
+                  &                                  0.00125_wp * EXP( -1.0_wp * zznd_d ) * zsc_uw_2(ji,jj) ) *   &
+                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) )
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65_wp *  0.15_wp * EXP( -1.0_wp * zznd_d ) *                 &
+                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) * zsc_vw_1(ji,jj)
+            END IF
+         ELSE   ! Stable conditions
+            IF ( jk <= nbld(ji,jj) ) THEN   ! Corrected to nbld
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75_wp * 1.3_wp * EXP( -0.5_wp * zznd_d ) *             &
+                  &                                ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) * zsc_uw_1(ji,jj)
+            END IF
+         END IF
+      END_3D
+      !
+      ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio
+      ! (X0.3) and pressure (X0.5)]
+      ! ----------------------------------------------------------------------
+      WHERE ( l_conv(A2D(nn_hls-1)) )
+         zsc_wth_1(:,:) = swbav(A2D(nn_hls-1)) * swth0(A2D(nn_hls-1)) * ( 1.0_wp + EXP( 0.2_wp * shol(A2D(nn_hls-1)) ) ) *   &
+            &             phml(A2D(nn_hls-1)) / ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln )
+         zsc_ws_1(:,:)  = swbav(A2D(nn_hls-1)) * sws0(A2D(nn_hls-1))  * ( 1.0_wp + EXP( 0.2_wp * shol(A2D(nn_hls-1)) ) ) *   &
+            &             phml(A2D(nn_hls-1)) / ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln )
+      ELSEWHERE
+         zsc_wth_1(:,:) = 0.0_wp
+         zsc_ws_1(:,:)  = 0.0_wp
+      ENDWHERE
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) )
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( jk <= nmld(ji,jj) ) THEN
+               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj)
+               ! Calculate turbulent time scale
+               zl_c   = 0.9_wp * ( 1.0_wp - EXP( -5.0_wp * ( zznd_ml + zznd_ml**3 / 3.0_wp ) ) ) *                         &
+                  &     ( 1.0_wp - EXP( -15.0_wp * ( 1.2_wp - zznd_ml ) ) )
+               zl_l   = 2.0_wp * ( 1.0_wp - EXP( -2.0_wp * ( zznd_ml + zznd_ml**3 / 3.0_wp ) ) ) *                         &
+                  &     ( 1.0_wp - EXP( -8.0_wp  * ( 1.15_wp - zznd_ml ) ) ) * ( 1.0_wp + dstokes(ji,jj) / phml (ji,jj) )
+               zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0_wp + EXP( -3.0_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )**( 3.0_wp / 2.0_wp )
+               ! Non-gradient buoyancy terms
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3_wp * 0.4_wp * zsc_wth_1(ji,jj) * zl_eps / ( 0.15_wp + zznd_ml )
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3_wp * 0.4_wp *  zsc_ws_1(ji,jj) * zl_eps / ( 0.15_wp + zznd_ml )
+            END IF
+         ELSE   ! Stable conditions
+            IF ( jk <= nbld(ji,jj) ) THEN
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj)
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj)
+            END IF
+         END IF
+      END_3D
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) ) THEN
+            ztau_sc_u(ji,jj)    = phml(ji,jj) / ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird *                             &
+               &                ( 1.4_wp - 0.4_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )**1.5_wp )
+            zwth_ent(ji,jj)     = -0.003_wp * ( 0.15_wp * svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird *   &
+               &                ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_dt_ml(ji,jj)
+            zws_ent(ji,jj)      = -0.003_wp * ( 0.15_wp * svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird *   &
+               &                ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_ds_ml(ji,jj)
+            IF ( dh(ji,jj) < 0.2_wp * hbl(ji,jj) ) THEN
+               zbuoy_pyc_sc        = 2.0_wp * MAX( av_db_ml(ji,jj), 0.0_wp ) / pdh(ji,jj)
+               zdelta_pyc          = ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird /   &
+                  &                       SQRT( MAX( zbuoy_pyc_sc, ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**p2third / pdh(ji,jj)**2 ) )
+               zwt_pyc_sc_1(ji,jj) = 0.325_wp * ( zalpha_pyc(ji,jj) * av_dt_ml(ji,jj) / pdh(ji,jj) + pdtdz_bl_ext(ji,jj) ) *   &
+                  &                     zdelta_pyc**2 / pdh(ji,jj)
+               zws_pyc_sc_1(ji,jj) = 0.325_wp * ( zalpha_pyc(ji,jj) * av_ds_ml(ji,jj) / pdh(ji,jj) + pdsdz_bl_ext(ji,jj) ) *   &
+                  &                     zdelta_pyc**2 / pdh(ji,jj)
+               zzeta_pyc(ji,jj)    = 0.15_wp - 0.175_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )
+            END IF
+         END IF
+      END_2D
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld )
+         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) .AND. ( jk <= nbld(ji,jj) ) ) THEN
+            zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / pdh(ji,jj)
+            ghamt(ji,jj,jk) = ghamt(ji,jj,jk) -                                                                                &
+               &              0.045_wp * ( ( zwth_ent(ji,jj) * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) *                 &
+               &                         MAX( ( 1.75_wp * zznd_pyc -0.15_wp * zznd_pyc**2 - 0.2_wp * zznd_pyc**3 ), 0.0_wp )
+            ghams(ji,jj,jk) = ghams(ji,jj,jk) -                                                                                &
+               &              0.045_wp * ( ( zws_ent(ji,jj)  * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) *                 &
+               &                         MAX( ( 1.75_wp * zznd_pyc -0.15_wp * zznd_pyc**2 - 0.2_wp * zznd_pyc**3 ), 0.0_wp )
+            IF ( dh(ji,jj) < 0.2_wp * hbl(ji,jj) .AND. nbld(ji,jj) - nmld(ji,jj) > 3 ) THEN
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05_wp  * zwt_pyc_sc_1(ji,jj) *                              &
+                  &                                EXP( -0.25_wp * ( zznd_pyc / zzeta_pyc(ji,jj) )**2 ) *        &
+                  &                                pdh(ji,jj) / ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05_wp  * zws_pyc_sc_1(ji,jj) *                              &
+                  &                                EXP( -0.25_wp * ( zznd_pyc / zzeta_pyc(ji,jj) )**2 ) *        &
+                  &                                pdh(ji,jj) / ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird
+            END IF
+         END IF   ! End of pycnocline
+      END_3D
+      !
+      IF ( ln_dia_osm ) THEN
+         CALL zdf_osm_iomput( "zwth_ent", tmask(A2D(0),1) * zwth_ent(A2D(0)) )   ! Upward turb. temperature entrainment flux
+         CALL zdf_osm_iomput( "zws_ent",  tmask(A2D(0),1) * zws_ent(A2D(0))  )   ! Upward turb. salinity entrainment flux
+      END IF
+      !
+      zsc_vw_1(:,:) = 0.0_wp
+      WHERE ( l_conv(A2D(nn_hls-1)) )
+         zsc_uw_1(:,:) = -1.0_wp * swb0(A2D(nn_hls-1)) * sustar(A2D(nn_hls-1))**2 * phml(A2D(nn_hls-1)) /   &
+            &            ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln )
+         zsc_uw_2(:,:) =           swb0(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1))    * phml(A2D(nn_hls-1)) /   &
+            &            ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln )**( 2.0_wp / 3.0_wp )
+      ELSEWHERE
+         zsc_uw_1(:,:) = 0.0_wp
+      ENDWHERE
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) )
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( jk <= nmld(ji,jj) ) THEN
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3_wp * 0.5_wp *   &
+                  &                                ( zsc_uw_1(ji,jj) + 0.125_wp * EXP( -0.5_wp * zznd_d ) *       &
+                  &                                  (   1.0_wp - EXP( -0.5_wp * zznd_d ) ) * zsc_uw_2(ji,jj) )
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
+            END IF
+         ELSE   ! Stable conditions
+            IF ( jk <= nbld(ji,jj) ) THEN
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj)
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj)
+            END IF
          ENDIF
+      ELSE   ! lshear
+! for lshear = .FALSE. calculate ddhdt here
+          IF ( lconv(ji,jj) ) THEN
+            IF( ln_osm_mle ) THEN
+               IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0._wp ) THEN
+                  ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F
+                  IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN
+                     IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN  ! near neutral stability
+                        zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+                     ELSE                                                     ! unstable
+                        zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+                     ENDIF
+                     ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird)
+                     zdh_ref = zari * hbl(ji,jj)
+      END_3D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) ) THEN
+            IF ( n_ddh(ji,jj) == 0 ) THEN
+               ! Place holding code. Parametrization needs checking for these conditions.
+               zomega = ( 0.15_wp * swstrl(ji,jj)**3 + swstrc(ji,jj)**3 + 4.75_wp * ( pshear(ji,jj) * phbl(ji,jj) ) )**pthird
+               zuw_bse(ji,jj) = -0.0035_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_du_ml(ji,jj)
+               zvw_bse(ji,jj) = -0.0075_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_dv_ml(ji,jj)
+            ELSE
+               zomega = ( 0.15_wp * swstrl(ji,jj)**3 + swstrc(ji,jj)**3 + 4.75_wp * ( pshear(ji,jj) * phbl(ji,jj) ) )**pthird
+               zuw_bse(ji,jj) = -0.0035_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_du_ml(ji,jj)
+               zvw_bse(ji,jj) = -0.0075_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_dv_ml(ji,jj)
+            ENDIF
+            zb_cubic(ji,jj) = pdh(ji,jj) / phbl(ji,jj) * suw0(ji,jj) - ( 2.0_wp + pdh(ji,jj) / phml(ji,jj) ) * zuw_bse(ji,jj)
+            za_cubic(ji,jj) = zuw_bse(ji,jj) - zb_cubic(ji,jj)
+            zvw_max = 0.7_wp * ff_t(ji,jj) * ( sustke(ji,jj) * dstokes(ji,jj) + 0.7_wp * sustar(ji,jj) * phml(ji,jj) )
+            zd_cubic(ji,jj) = zvw_max * pdh(ji,jj) / phml(ji,jj) - ( 2.0_wp + pdh(ji,jj) / phml(ji,jj) ) * zvw_bse(ji,jj)
+            zc_cubic(ji,jj) = zvw_bse(ji,jj) - zd_cubic(ji,jj)
+         END IF
+      END_2D
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jkf_mld, jkm_bld )   ! Need ztau_sc_u to be available. Change to array.
+         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) .AND. ( jk >= nmld(ji,jj) ) .AND. ( jk <= nbld(ji,jj) ) ) THEN
+            zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / pdh(ji,jj)
+            ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.045_wp * ( ztau_sc_u(ji,jj)**2 ) * zuw_bse(ji,jj) *                 &
+               &                                ( za_cubic(ji,jj) * zznd_pyc**2 + zb_cubic(ji,jj) * zznd_pyc**3 ) *   &
+               &                                ( 0.75_wp + 0.25_wp * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk)
+            ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.045_wp * ( ztau_sc_u(ji,jj)**2 ) * zvw_bse(ji,jj) *                 &
+               &                                ( zc_cubic(ji,jj) * zznd_pyc**2 + zd_cubic(ji,jj) * zznd_pyc**3 ) *   &
+               &                                ( 0.75_wp + 0.25_wp * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk)
+         END IF   ! l_conv .AND. l_pyc
+      END_3D
+      !
+      IF ( ln_dia_osm ) THEN
+         CALL zdf_osm_iomput( "ghamu_0",    wmask(A2D(0),:) * ghamu(A2D(0),:)  )
+         CALL zdf_osm_iomput( "zsc_uw_1_0", tmask(A2D(0),1) * zsc_uw_1(A2D(0)) )
+      END IF
+      !
+      ! Transport term in flux-gradient relationship [note : includes ROI ratio
+      ! (X0.3) ]
+      ! -----------------------------------------------------------------------
+      WHERE ( l_conv(A2D(nn_hls-1)) )
+         zsc_wth_1(:,:) = swth0(A2D(nn_hls-1)) / ( 1.0_wp - 0.56_wp * EXP( shol(A2D(nn_hls-1)) ) )
+         zsc_ws_1(:,:)  = sws0(A2D(nn_hls-1))  / ( 1.0_wp - 0.56_wp * EXP( shol(A2D(nn_hls-1)) ) )
+         WHERE ( l_pyc(A2D(nn_hls-1)) )   ! Pycnocline scales
+            zsc_wth_pyc(:,:) = -0.003_wp * swstrc(A2D(nn_hls-1)) * ( 1.0_wp - pdh(A2D(nn_hls-1)) / phbl(A2D(nn_hls-1)) ) *   &
+               &               av_dt_ml(A2D(nn_hls-1))
+            zsc_ws_pyc(:,:)  = -0.003_wp * swstrc(A2D(nn_hls-1)) * ( 1.0_wp - pdh(A2D(nn_hls-1)) / phbl(A2D(nn_hls-1)) ) *   &
+               &               av_ds_ml(A2D(nn_hls-1))
+         END WHERE
+      ELSEWHERE
+         zsc_wth_1(:,:) = 2.0_wp * swthav(A2D(nn_hls-1))
+         zsc_ws_1(:,:)  =          sws0(A2D(nn_hls-1))
+      END WHERE
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, MAX( jkm_mld, jkm_bld ) )
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( ( jk > 1 ) .AND. ( jk <= nmld(ji,jj) ) ) THEN
+               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3_wp * zsc_wth_1(ji,jj) *                                  &
+                  &                                ( -2.0_wp + 2.75_wp * ( ( 1.0_wp + 0.6_wp * zznd_ml**4 ) -   &
+                  &                                                        EXP( -6.0_wp * zznd_ml ) ) ) *       &
+                  &                                ( 1.0_wp - EXP( -15.0_wp * ( 1.0_wp - zznd_ml ) ) )
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3_wp * zsc_ws_1(ji,jj) *                                   &
+                  &                                ( -2.0_wp + 2.75_wp * ( ( 1.0_wp + 0.6_wp * zznd_ml**4 ) -   &
+                  &                                EXP( -6.0_wp * zznd_ml ) ) ) * ( 1.0_wp - EXP( -15.0_wp * ( 1.0_wp - zznd_ml ) ) )
+            END IF
+            !
+            ! may need to comment out lpyc block
+            IF ( l_pyc(ji,jj) .AND. ( jk >= nmld(ji,jj) ) .AND. ( jk <= nbld(ji,jj) ) ) THEN   ! Pycnocline
+               zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / pdh(ji,jj)
+               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0_wp * zsc_wth_pyc(ji,jj) *   &
+                  &                                ( 0.48_wp - EXP( -1.5_wp * ( zznd_pyc - 0.3_wp )**2 ) )
+               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0_wp * zsc_ws_pyc(ji,jj)  *   &
+                  &                                ( 0.48_wp - EXP( -1.5_wp * ( zznd_pyc - 0.3_wp )**2 ) )
+            END IF
+         ELSE
+            IF( pdhdt(ji,jj) > 0. ) THEN
+               IF ( ( jk > 1 ) .AND. ( jk <= nbld(ji,jj) ) ) THEN
+                  zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+                  znd    = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj)
+                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3_wp * ( -4.06_wp * EXP( -2.0_wp * zznd_d ) * ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) +   &
+.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_wth_1(ji,jj)
+                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3_wp * ( -4.06_wp * EXP( -2.0_wp * zznd_d ) * ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) +   &
+.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_ws_1(ji,jj)
+               END IF
+            ENDIF
+         ENDIF
+      END_3D
+      !
+      WHERE ( l_conv(A2D(nn_hls-1)) )
+         zsc_uw_1(:,:) = sustar(A2D(nn_hls-1))**2
+         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1)) * phml(A2D(nn_hls-1))
+      ELSEWHERE
+         zsc_uw_1(:,:) = sustar(A2D(nn_hls-1))**2
+         zsc_uw_2(:,:) = ( 2.25_wp - 3.0_wp * ( 1.0_wp - EXP( -1.25_wp * 2.0_wp ) ) ) * ( 1.0_wp - EXP( -4.0_wp * 2.0_wp ) ) *   &
+            &            zsc_uw_1(:,:)
+         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1)) * phbl(A2D(nn_hls-1))
+         zsc_vw_2(:,:) = -0.11_wp * SIN( 3.14159_wp * ( 2.0_wp + 0.4_wp ) ) * EXP( -1.0_wp * ( 1.5_wp + 2.0_wp )**2 ) *   &
+            &            zsc_vw_1(:,:)
+      ENDWHERE
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) )
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( jk <= nmld(ji,jj) ) THEN
+               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj)
+               zznd_d  = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +   &
+                  &              0.3_wp * ( -2.0_wp + 2.5_wp * ( 1.0_wp + 0.1_wp * zznd_ml**4 ) - EXP( -8.0_wp * zznd_ml ) ) *   &
+                  &              zsc_uw_1(ji,jj)
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) +   &
+                  &              0.3_wp * 0.1_wp * ( EXP( -1.0_wp * zznd_d ) + EXP( -5.0_wp * ( 1.0_wp - zznd_ml ) ) ) *   &
+                  &              zsc_vw_1(ji,jj)
+            END IF
+         ELSE
+            IF ( jk <= nbld(ji,jj) ) THEN
+               znd    = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj)
+               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj)
+               IF ( zznd_d <= 2.0_wp ) THEN
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5_wp * 0.3_wp *                                              &
+                     &                                ( 2.25_wp - 3.0_wp * ( 1.0_wp - EXP( -1.25_wp * zznd_d ) ) *   &
+                     &                                  ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) ) * zsc_uw_1(ji,jj)
+               ELSE
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5_wp * 0.3_wp *   &
+                     &                                ( 1.0_wp - EXP( -5.0_wp * ( 1.0_wp - znd ) ) ) * zsc_uw_2(ji,jj)
+               ENDIF
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0.3_wp * 0.15_wp * SIN( 3.14159_wp * ( 0.65_wp * zznd_d ) ) *   &
+                  &                                EXP( -0.25_wp * zznd_d**2 ) * zsc_vw_1(ji,jj)
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0.3_wp * 0.15_wp * EXP( -5.0 * ( 1.0 - znd ) ) *   &
+                  &                                ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj)
+            END IF
+         END IF
+      END_3D
+      !
+      IF ( ln_dia_osm ) THEN
+         CALL zdf_osm_iomput( "ghamu_f",    wmask(A2D(0),:) * ghamu(A2D(0),:)  )
+         CALL zdf_osm_iomput( "ghamv_f",    wmask(A2D(0),:) * ghamv(A2D(0),:)  )
+         CALL zdf_osm_iomput( "zsc_uw_1_f", tmask(A2D(0),1) * zsc_uw_1(A2D(0)) )
+         CALL zdf_osm_iomput( "zsc_vw_1_f", tmask(A2D(0),1) * zsc_vw_1(A2D(0)) )
+         CALL zdf_osm_iomput( "zsc_uw_2_f", tmask(A2D(0),1) * zsc_uw_2(A2D(0)) )
+         CALL zdf_osm_iomput( "zsc_vw_2_f", tmask(A2D(0),1) * zsc_vw_2(A2D(0)) )
+      END IF
+      !
+      ! Make surface forced velocity non-gradient terms go to zero at the base
+      ! of the mixed layer.
+      !
+      ! Make surface forced velocity non-gradient terms go to zero at the base
+      ! of the boundary layer.
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld )
+         IF ( ( .NOT. l_conv(ji,jj) ) .AND. ( jk <= nbld(ji,jj) ) ) THEN
+            znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / phbl(ji,jj)   ! ALMG to think about
+            IF ( znd >= 0.0_wp ) THEN
+               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0_wp - EXP( -10.0_wp * znd**2 ) )
+               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0_wp - EXP( -10.0_wp * znd**2 ) )
+            ELSE
+               ghamu(ji,jj,jk) = 0.0_wp
+               ghamv(ji,jj,jk) = 0.0_wp
+            ENDIF
+         END IF
+      END_3D
+      !
+      ! Pynocline contributions
+      !
+      IF ( ln_dia_pyc_scl .OR. ln_dia_pyc_shr ) THEN   ! Allocate arrays for output of pycnocline gradient/shear profiles
+         ALLOCATE( z3ddz_pyc_1(A2D(nn_hls),jpk), z3ddz_pyc_2(A2D(nn_hls),jpk), STAT=istat )
+         IF ( istat /= 0 ) CALL ctl_stop( 'zdf_osm: failed to allocate temporary arrays' )
+         z3ddz_pyc_1(:,:,:) = 0.0_wp
+         z3ddz_pyc_2(:,:,:) = 0.0_wp
+      END IF
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld )
+         IF ( l_conv (ji,jj) ) THEN
+            ! Unstable conditions. Shouldn;t be needed with no pycnocline code.
+            !                  zugrad = 0.7 * av_du_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / &
+            !                       &      ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * &
+            !                      &      MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 ))
+            !Alan is this right?
+            !                  zvgrad = ( 0.7 * av_dv_ml(ji,jj) + &
+            !                       &    2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / &
+            !                       &          ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird  + epsln ) &
+            !                       &      )/ (zdh(ji,jj)  + epsln )
+            !                  DO jk = 2, nbld(ji,jj) - 1 + ibld_ext
+            !                     znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v
+            !                     IF ( znd <= 0.0 ) THEN
+            !                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd )
+            !                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd )
+            !                     ELSE
+            !                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd )
+            !                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd )
+            !                     ENDIF
+            !                  END DO
+         ELSE   ! Stable conditions
+            IF ( nbld(ji,jj) + kp_ext(ji,jj) < mbkt(ji,jj) ) THEN
+               ! Pycnocline profile only defined when depth steady of increasing.
+               IF ( pdhdt(ji,jj) > 0.0_wp ) THEN   ! Depth increasing, or steady.
+                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN
+                     IF ( shol(ji,jj) >= 0.5_wp ) THEN   ! Very stable - 'thick' pycnocline
+                        ztmp = 1.0_wp / MAX( phbl(ji,jj), epsln )
+                        ztgrad = av_dt_bl(ji,jj) * ztmp
+                        zsgrad = av_ds_bl(ji,jj) * ztmp
+                        zbgrad = av_db_bl(ji,jj) * ztmp
+                        IF ( jk <= nbld(ji,jj) ) THEN
+                           znd = gdepw(ji,jj,jk,Kmm) * ztmp
+                           zdtdz_pyc =  ztgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 )
+                           zdsdz_pyc =  zsgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 )
+                           ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + pdiffut(ji,jj,jk) * zdtdz_pyc
+                           ghams(ji,jj,jk) = ghams(ji,jj,jk) + pdiffut(ji,jj,jk) * zdsdz_pyc
+                           IF ( ln_dia_pyc_scl ) THEN
+                              z3ddz_pyc_1(ji,jj,jk) = zdtdz_pyc
+                              z3ddz_pyc_2(ji,jj,jk) = zdsdz_pyc
+                           END IF
+                        END IF
+                     ELSE   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form.
+                        ztmp = 1.0_wp / MAX( pdh(ji,jj), epsln )
+                        ztgrad = av_dt_bl(ji,jj) * ztmp
+                        zsgrad = av_ds_bl(ji,jj) * ztmp
+                        zbgrad = av_db_bl(ji,jj) * ztmp
+                        IF ( jk <= nbld(ji,jj) ) THEN
+                           znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phml(ji,jj) ) * ztmp
+                           zdtdz_pyc =  ztgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 )
+                           zdsdz_pyc =  zsgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 )
+                           ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + pdiffut(ji,jj,jk) * zdtdz_pyc
+                           ghams(ji,jj,jk) = ghams(ji,jj,jk) + pdiffut(ji,jj,jk) * zdsdz_pyc
+                           IF ( ln_dia_pyc_scl ) THEN
+                              z3ddz_pyc_1(ji,jj,jk) = zdtdz_pyc
+                              z3ddz_pyc_2(ji,jj,jk) = zdsdz_pyc
+                           END IF
+                        END IF
+                     ENDIF   ! IF (shol >=0.5)
+                  ENDIF      ! IF (av_db_bl> 0.)
+               ENDIF         ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are
+               !             !    intialized to zero
+            END IF
+         END IF
+      END_3D
+      IF ( ln_dia_pyc_scl ) THEN   ! Output of pycnocline gradient profiles
+         CALL zdf_osm_iomput( "zdtdz_pyc", wmask(A2D(0),:) * z3ddz_pyc_1(A2D(0),:) )
+         CALL zdf_osm_iomput( "zdsdz_pyc", wmask(A2D(0),:) * z3ddz_pyc_2(A2D(0),:) )
+      END IF
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld )
+         IF ( .NOT. l_conv (ji,jj) ) THEN
+            IF ( nbld(ji,jj) + kp_ext(ji,jj) < mbkt(ji,jj) ) THEN
+               zugrad = 3.25_wp * av_du_bl(ji,jj) / phbl(ji,jj)
+               zvgrad = 2.75_wp * av_dv_bl(ji,jj) / phbl(ji,jj)
+               IF ( jk <= nbld(ji,jj) ) THEN
+                  znd = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj)
+                  IF ( znd < 1.0 ) THEN
+                     zdudz_pyc = zugrad * EXP( -40.0_wp * ( znd - 1.0_wp )**2 )
                   ELSE
+                     ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird)
+                     zdh_ref = 0.2 * hbl(ji,jj)
+                     zdudz_pyc = zugrad * EXP( -20.0_wp * ( znd - 1.0_wp )**2 )
                   ENDIF
+               ELSE
+                  ztau = 0.2 * hbl(ji,jj) /  MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird)
+                  zdh_ref = 0.2 * hbl(ji,jj)
+               ENDIF
+            ELSE ! ln_osm_mle
+               IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN
+                  IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN  ! near neutral stability
+                     zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+                  ELSE                                                     ! unstable
+                     zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 )
+                  ENDIF
+                  ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird)
+                  zdh_ref = zari * hbl(ji,jj)
+               ELSE
+                  ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird)
+                  zdh_ref = 0.2 * hbl(ji,jj)
+               ENDIF
+            END IF  ! ln_osm_mle
+            dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) )
+!               IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref
+            IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref
+            ! Alan: this hml is never defined or used
+         ELSE   ! IF (lconv)
+            ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln)
+            IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here
+               ! boundary layer deepening
+               IF ( zdb_bl(ji,jj) > 0._wp ) THEN
+                  ! pycnocline thickness set by stratification - use same relationship as for neutral conditions.
+                  zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) &
+                       & /  MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01  , 0.2 )
+                  zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj)
+               ELSE
+                  zdh_ref = 0.2 * hbl(ji,jj)
+               ENDIF
+            ELSE     ! IF(dhdt < 0)
+               zdh_ref = 0.2 * hbl(ji,jj)
+            ENDIF    ! IF (dhdt >= 0)
+            dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) )
+            IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref       ! can be a problem with dh>hbl for rapid collapse
+         ENDIF       ! IF (lconv)
+      ENDIF  ! lshear
+      hml(ji,jj) = hbl(ji,jj) - dh(ji,jj)
+      inhml = MAX( INT( dh(ji,jj) / MAX(e3t(ji,jj,ibld(ji,jj),Kmm), 1.e-3) ) , 1 )
+      imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3)
+      zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm)
+      zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj)
+    END_2D
+    END SUBROUTINE zdf_osm_pycnocline_thickness
+   SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_osm_horizontal_gradients  ***
+      !!
+      !! ** Purpose :   Calculates horizontal gradients of buoyancy for use with Fox-Kemper parametrization.
+                  zdvdz_pyc = zvgrad * EXP( -20.0_wp * ( znd - 0.85_wp )**2 )
+                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + pviscos(ji,jj,jk) * zdudz_pyc
+                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + pviscos(ji,jj,jk) * zdvdz_pyc
+                  IF ( ln_dia_pyc_shr ) THEN
+                     z3ddz_pyc_1(ji,jj,jk) = zdudz_pyc
+                     z3ddz_pyc_2(ji,jj,jk) = zdvdz_pyc
+                  END IF
+               END IF
+            END IF
+         END IF
+      END_3D
+      IF ( ln_dia_pyc_shr ) THEN   ! Output of pycnocline shear profiles
+         CALL zdf_osm_iomput( "zdudz_pyc", wmask(A2D(0),:) * z3ddz_pyc_1(A2D(0),:) )
+         CALL zdf_osm_iomput( "zdvdz_pyc", wmask(A2D(0),:) * z3ddz_pyc_2(A2D(0),:) )
+      END IF
+      IF ( ln_dia_osm ) THEN
+         CALL zdf_osm_iomput( "ghamu_b", wmask(A2D(0),:) * ghamu(A2D(0),:) )
+         CALL zdf_osm_iomput( "ghamv_b", wmask(A2D(0),:) * ghamv(A2D(0),:) )
+      END IF
+      IF ( ln_dia_pyc_scl .OR. ln_dia_pyc_shr ) THEN   ! Deallocate arrays used for output of pycnocline gradient/shear profiles
+         DEALLOCATE( z3ddz_pyc_1, z3ddz_pyc_2 )
+      END IF
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         ghamt(ji,jj,nbld(ji,jj)) = 0.0_wp
+         ghams(ji,jj,nbld(ji,jj)) = 0.0_wp
+         ghamu(ji,jj,nbld(ji,jj)) = 0.0_wp
+         ghamv(ji,jj,nbld(ji,jj)) = 0.0_wp
+      END_2D
+      !
+      IF ( ln_dia_osm ) THEN
+         CALL zdf_osm_iomput( "ghamu_1", wmask(A2D(0),:) * ghamu(A2D(0),:)   )
+         CALL zdf_osm_iomput( "ghamv_1", wmask(A2D(0),:) * ghamv(A2D(0),:)   )
+         CALL zdf_osm_iomput( "zviscos", wmask(A2D(0),:) * pviscos(A2D(0),:) )
+      END IF
+      !
+   END SUBROUTINE zdf_osm_fgr_terms
+   SUBROUTINE zdf_osm_zmld_horizontal_gradients( Kmm, pmld, pdtdx, pdtdy, pdsdx,   &
+      &                                          pdsdy, pdbds_mle )
+      !!----------------------------------------------------------------------
+      !!          ***  ROUTINE zdf_osm_zmld_horizontal_gradients  ***
+      !!
+      !! ** Purpose : Calculates horizontal gradients of buoyancy for use with
+      !!              Fox-Kemper parametrization
       !!
       !! ** Method  :
 …
       !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008
       !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
+      REAL(wp), DIMENSION(jpi,jpj)     :: dbdx_mle, dbdy_mle ! MLE horiz gradients at u & v points
+      REAL(wp), DIMENSION(jpi,jpj)     :: zdbds_mle ! Magnitude of horizontal buoyancy gradient.
+      REAL(wp), DIMENSION(jpi,jpj)     :: zmld ! ==  estimated FK BLD used for MLE horiz gradients  == !
+      REAL(wp), DIMENSION(jpi,jpj)     :: zdtdx, zdtdy, zdsdx, zdsdy
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   ii, ij, ik, ikmax   ! local integers
+      REAL(wp)                         :: zc
+      REAL(wp)                         :: zN2_c           ! local buoyancy difference from 10m value
+      REAL(wp), DIMENSION(jpi,jpj)     :: ztm, zsm, zLf_NH, zLf_MH
+      REAL(wp), DIMENSION(jpi,jpj,jpts):: ztsm_midu, ztsm_midv, zabu, zabv
+      REAL(wp), DIMENSION(jpi,jpj)     :: zmld_midu, zmld_midv
+!!----------------------------------------------------------------------
+      !
+      !                                      !==  MLD used for MLE  ==!
+      mld_prof(:,:)  = nlb10               ! Initialization to the number of w ocean point
+      zmld(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2
+      zN2_c = grav * rn_osm_mle_rho_c * r1_rho0   ! convert density criteria into N^2 criteria
+      DO_3D( 1, 1, 1, 1, nlb10, jpkm1 )
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                            INTENT(in   ) ::   Kmm          ! Time-level index
+      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(  out) ::   pmld         ! == Estimated FK BLD used for MLE horizontal gradients == !
+      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdtdx        ! Horizontal gradient for Fox-Kemper parametrization
+      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdtdy        ! Horizontal gradient for Fox-Kemper parametrization
+      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdsdx        ! Horizontal gradient for Fox-Kemper parametrization
+      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdsdy        ! Horizontal gradient for Fox-Kemper parametrization
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdbds_mle    ! Magnitude of horizontal buoyancy gradient
+      !!
+      INTEGER                               ::   ji, jj, jk   ! Dummy loop indices
+      INTEGER,  DIMENSION(A2D(nn_hls))      ::   jk_mld_prof  ! Base level of MLE layer
+      INTEGER                               ::   ikt, ikmax   ! Local integers
+      REAL(wp)                              ::   zc
+      REAL(wp)                              ::   zN2_c        ! Local buoyancy difference from 10m value
+      REAL(wp), DIMENSION(A2D(nn_hls))      ::   ztm
+      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zsm
+      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   ztsm_midu
+      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   ztsm_midv
+      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   zabu
+      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   zabv
+      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zmld_midu
+      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zmld_midv
+      !!----------------------------------------------------------------------
+      !
+      ! ==  MLD used for MLE  ==!
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         jk_mld_prof(ji,jj) = nlb10    ! Initialization to the number of w ocean point
+         pmld(ji,jj)        = 0.0_wp   ! Here hmlp used as a dummy variable, integrating vertically N^2
+      END_2D
+      zN2_c = grav * rn_osm_mle_rho_c * r1_rho0   ! Convert density criteria into N^2 criteria
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 )
          ikt = mbkt(ji,jj)
          zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm)
          IF( zmld(ji,jj) < zN2_c )   mld_prof(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
+         pmld(ji,jj) = pmld(ji,jj) + MAX( rn2b(ji,jj,jk), 0.0_wp ) * e3w(ji,jj,jk,Kmm)
+         IF( pmld(ji,jj) < zN2_c ) jk_mld_prof(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
       END_3D
+      DO_2D( 1, 1, 1, 1 )
+         mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj))
+         zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm)
+      END_2D
+      ! ensure mld_prof .ge. ibld
+      !
+      ikmax = MIN( MAXVAL( mld_prof(:,:) ), jpkm1 )                  ! max level of the computation
+      !
+      ztm(:,:) = 0._wp
+      zsm(:,:) = 0._wp
+      DO_3D( 1, 1, 1, 1, 1, ikmax )
+         zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         jk_mld_prof(ji,jj) = MAX( jk_mld_prof(ji,jj), nbld(ji,jj) )   ! Ensure jk_mld_prof .ge. nbld
+         pmld(ji,jj)     = gdepw(ji,jj,jk_mld_prof(ji,jj),Kmm)
+      END_2D
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         mld_prof(ji,jj) = jk_mld_prof(ji,jj)
+      END_2D
+      !
+      ikmax = MIN( MAXVAL( jk_mld_prof(A2D(nn_hls)) ), jpkm1 )   ! Max level of the computation
+      ztm(:,:) = 0.0_wp
+      zsm(:,:) = 0.0_wp
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax )
+         zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, jk_mld_prof(ji,jj) - jk ), 1  ), KIND=wp )   ! zc being 0 outside the ML
+         !                                                                                        !    t-points
          ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm)
          zsm(ji,jj) = zsm(ji,jj) + zc * ts(ji,jj,jk,jp_sal,Kmm)
       END_3D
+      ! average temperature and salinity.
+      ztm(:,:) = ztm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) )
+      zsm(:,:) = zsm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) )
+      ! calculate horizontal gradients at u & v points
+      DO_2D( 1, 0, 0, 0 )
+         zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
+         zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
+         zmld_midu(ji,jj) = 0.25_wp * (zmld(ji+1,jj) + zmld( ji,jj))
+         ztsm_midu(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji+1,jj) + ztm( ji,jj) )
+         ztsm_midu(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji+1,jj) + zsm( ji,jj) )
+      END_2D
+      DO_2D( 0, 0, 1, 0 )
+         zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
+         zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
+         zmld_midv(ji,jj) = 0.25_wp * (zmld(ji,jj+1) + zmld( ji,jj))
+         ztsm_midv(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji,jj+1) + ztm( ji,jj) )
+         ztsm_midv(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji,jj+1) + zsm( ji,jj) )
+      END_2D
+      CALL eos_rab(ztsm_midu, zmld_midu, zabu, Kmm)
+      CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm)
+      DO_2D( 1, 0, 0, 0 )
+         dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal))
+      END_2D
+      DO_2D( 0, 0, 1, 0 )
+         dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal))
+      END_2D
+      DO_2D( 0, 0, 0, 0 )
+        ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf
+        zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) &
+             & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) )
+      END_2D
+ END SUBROUTINE zdf_osm_zmld_horizontal_gradients
+  SUBROUTINE zdf_osm_mle_parameters( mld_prof, hmle, zhmle, zvel_mle, zdiff_mle )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_osm_mle_parameters  ***
+      !!
+      !! ** Purpose :   Timesteps the mixed layer eddy depth, hmle and calculates the mixed layer eddy fluxes for buoyancy, heat and salinity.
+      ! Average temperature and salinity
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         ztm(ji,jj) = ztm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), pmld(ji,jj) )
+         zsm(ji,jj) = zsm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), pmld(ji,jj) )
+      END_2D
+      ! Calculate horizontal gradients at u & v points
+      zmld_midu(:,:)   =  0.0_wp
+      ztsm_midu(:,:,:) = 10.0_wp
+      DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pdtdx(ji,jj)            = ( ztm(ji+1,jj) - ztm(ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
+         pdsdx(ji,jj)            = ( zsm(ji+1,jj) - zsm(ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj)
+         zmld_midu(ji,jj)        = 0.25_wp * ( pmld(ji+1,jj) + pmld(ji,jj))
+         ztsm_midu(ji,jj,jp_tem) =  0.5_wp * ( ztm( ji+1,jj)  + ztm( ji,jj) )
+         ztsm_midu(ji,jj,jp_sal) =  0.5_wp * ( zsm( ji+1,jj)  + zsm( ji,jj) )
+      END_2D
+      zmld_midv(:,:)   =  0.0_wp
+      ztsm_midv(:,:,:) = 10.0_wp
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 )
+         pdtdy(ji,jj)            = ( ztm(ji,jj+1) - ztm(ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
+         pdsdy(ji,jj)            = ( zsm(ji,jj+1) - zsm(ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj)
+         zmld_midv(ji,jj)        = 0.25_wp * ( pmld(ji,jj+1) + pmld( ji,jj) )
+         ztsm_midv(ji,jj,jp_tem) =  0.5_wp * ( ztm( ji,jj+1)  + ztm( ji,jj) )
+         ztsm_midv(ji,jj,jp_sal) =  0.5_wp * ( zsm( ji,jj+1)  + zsm( ji,jj) )
+      END_2D
+      CALL eos_rab( ztsm_midu, zmld_midu, zabu, Kmm )
+      CALL eos_rab( ztsm_midv, zmld_midv, zabv, Kmm )
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 )
+         dbdx_mle(ji,jj) = grav * ( pdtdx(ji,jj) * zabu(ji,jj,jp_tem) - pdsdx(ji,jj) * zabu(ji,jj,jp_sal) )
+      END_2D
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 )
+         dbdy_mle(ji,jj) = grav * ( pdtdy(ji,jj) * zabv(ji,jj,jp_tem) - pdsdy(ji,jj) * zabv(ji,jj,jp_sal) )
+      END_2D
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         pdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,  jj) * dbdx_mle(ji,  jj) + dbdy_mle(ji,jj  ) * dbdy_mle(ji,jj  ) +   &
+            &                                dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) )
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_zmld_horizontal_gradients
+   SUBROUTINE zdf_osm_osbl_state_fk( Kmm, pwb_fk, phbl, phmle, pwb_ent,   &
+      &                              pdbds_mle )
+      !!---------------------------------------------------------------------
+      !!               ***  ROUTINE zdf_osm_osbl_state_fk  ***
+      !!
+      !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is
+      !!              returned in the logicals l_pyc, l_flux and ldmle. Used
+      !!              with Fox-Kemper scheme.
+      !!                l_pyc  :: determines whether pycnocline flux-grad
+      !!                          relationship needs to be determined
+      !!                l_flux :: determines whether effects of surface flux
+      !!                          extend below the base of the OSBL
+      !!                ldmle  :: determines whether the layer with MLE is
+      !!                          increasing with time or if base is relaxing
+      !!                          towards hbl
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                            INTENT(in   ) ::   Kmm         ! Time-level index
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pwb_fk
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl        ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phmle       ! MLE depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent     ! Buoyancy entrainment flux
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbds_mle   ! Magnitude of horizontal buoyancy gradient
+      !!
+      INTEGER                            ::   ji, jj, jk        ! Dummy loop indices
+      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   znd_param
+      REAL(wp)                           ::   zthermal, zbeta
+      REAL(wp)                           ::   zbuoy
+      REAL(wp)                           ::   ztmp
+      REAL(wp)                           ::   zpe_mle_layer
+      REAL(wp)                           ::   zpe_mle_ref
+      REAL(wp)                           ::   zdbdz_mle_int
+      !!----------------------------------------------------------------------
+      !
+      znd_param(:,:) = 0.0_wp
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf
+         pwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * pdbds_mle(ji,jj) * pdbds_mle(ji,jj)
+      END_2D
+      !
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         !
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( phmle(ji,jj) > 1.2_wp * phbl(ji,jj) ) THEN
+               av_t_mle(ji,jj) = ( av_t_mle(ji,jj) * phmle(ji,jj) - av_t_bl(ji,jj) * phbl(ji,jj) ) / ( phmle(ji,jj) - phbl(ji,jj) )
+               av_s_mle(ji,jj) = ( av_s_mle(ji,jj) * phmle(ji,jj) - av_s_bl(ji,jj) * phbl(ji,jj) ) / ( phmle(ji,jj) - phbl(ji,jj) )
+               av_b_mle(ji,jj) = ( av_b_mle(ji,jj) * phmle(ji,jj) - av_b_bl(ji,jj) * phbl(ji,jj) ) / ( phmle(ji,jj) - phbl(ji,jj) )
+               zdbdz_mle_int = ( av_b_bl(ji,jj) - ( 2.0_wp * av_b_mle(ji,jj) - av_b_bl(ji,jj) ) ) / ( phmle(ji,jj) - phbl(ji,jj) )
+               ! Calculate potential energies of actual profile and reference profile
+               zpe_mle_layer = 0.0_wp
+               zpe_mle_ref   = 0.0_wp
+               zthermal = rab_n(ji,jj,1,jp_tem)
+               zbeta    = rab_n(ji,jj,1,jp_sal)
+               DO jk = nbld(ji,jj), mld_prof(ji,jj)
+                  zbuoy         = grav * ( zthermal * ts(ji,jj,jk,jp_tem,Kmm) - zbeta * ts(ji,jj,jk,jp_sal,Kmm) )
+                  zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
+                  zpe_mle_ref   = zpe_mle_ref   + ( av_b_bl(ji,jj) - zdbdz_mle_int * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) ) *   &
+                     &                            gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
+               END DO
+               ! Non-dimensional parameter to diagnose the presence of thermocline
+               znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) /   &
+                  &               ( MAX( pwb_fk(ji,jj), 1e-10 ) * phmle(ji,jj) )
+            END IF
+         END IF
+         !
+      END_2D
+      !
+      ! Diagnosis
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         !
+         IF ( l_conv(ji,jj) ) THEN
+            IF ( -2.0_wp * pwb_fk(ji,jj) / pwb_ent(ji,jj) > 0.5_wp ) THEN
+               IF ( phmle(ji,jj) > 1.2_wp * phbl(ji,jj) ) THEN   ! MLE layer growing
+                  IF ( znd_param (ji,jj) > 100.0_wp ) THEN   ! Thermocline present
+                     l_flux(ji,jj) = .FALSE.
+                     l_mle(ji,jj)  = .FALSE.
+                  ELSE   ! Thermocline not present
+                     l_flux(ji,jj) = .TRUE.
+                     l_mle(ji,jj)  = .TRUE.
+                  ENDIF  ! znd_param > 100
+                  !
+                  IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh ) THEN
+                     l_pyc(ji,jj) = .FALSE.
+                  ELSE
+                     l_pyc(ji,jj) = .TRUE.
+                  ENDIF
+               ELSE   ! MLE layer restricted to OSBL or just below
+                  IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh ) THEN   ! Weak stratification MLE layer can grow
+                     l_pyc(ji,jj)  = .FALSE.
+                     l_flux(ji,jj) = .TRUE.
+                     l_mle(ji,jj)  = .TRUE.
+                  ELSE   ! Strong stratification
+                     l_pyc(ji,jj)  = .TRUE.
+                     l_flux(ji,jj) = .FALSE.
+                     l_mle(ji,jj)  = .FALSE.
+                  END IF   ! av_db_bl < rn_mle_thresh_bl and
+               END IF   ! phmle > 1.2 phbl
+            ELSE
+               l_pyc(ji,jj)  = .TRUE.
+               l_flux(ji,jj) = .FALSE.
+               l_mle(ji,jj)  = .FALSE.
+               IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh ) l_pyc(ji,jj) = .FALSE.
+            END IF   !  -2.0 * pwb_fk(ji,jj) / pwb_ent > 0.5
+         ELSE   ! Stable Boundary Layer
+            l_pyc(ji,jj)  = .FALSE.
+            l_flux(ji,jj) = .FALSE.
+            l_mle(ji,jj)  = .FALSE.
+         END IF   ! l_conv
+         !
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_osbl_state_fk
+   SUBROUTINE zdf_osm_mle_parameters( Kmm, pmld, phmle, pvel_mle, pdiff_mle,   &
+      &                               pdbds_mle, phbl, pwb0tot )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE zdf_osm_mle_parameters  ***
+      !!
+      !! ** Purpose : Timesteps the mixed layer eddy depth, hmle and calculates
+      !!              the mixed layer eddy fluxes for buoyancy, heat and
+      !!              salinity.
       !!
       !! ** Method  :
 …
       !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008
       !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
+      INTEGER, DIMENSION(jpi,jpj)      :: mld_prof
+      REAL(wp), DIMENSION(jpi,jpj)     :: hmle, zhmle, zwb_fk, zvel_mle, zdiff_mle
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   ii, ij, ik, jkb, jkb1  ! local integers
+      INTEGER , DIMENSION(jpi,jpj)     :: inml_mle
+      REAL(wp) ::  ztmp, zdbdz, zdtdz, zdsdz, zthermal,zbeta, zbuoy, zdb_mle
+   ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE.
+      DO_2D( 0, 0, 0, 0 )
+       IF ( lconv(ji,jj) ) THEN
+          ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf
+   ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt.
+          zvel_mle(ji,jj) = zdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1)
+          zdiff_mle(ji,jj) = 5.e-4_wp * rn_osm_mle_ce * ztmp * zdbds_mle(ji,jj) * zhmle(ji,jj)**2
+       ENDIF
+      END_2D
+   ! Timestep mixed layer eddy depth.
+      DO_2D( 0, 0, 0, 0 )
+        IF ( lmle(ji,jj) ) THEN  ! MLE layer growing.
+! Buoyancy gradient at base of MLE layer.
+           zthermal = rab_n(ji,jj,1,jp_tem)
+           zbeta    = rab_n(ji,jj,1,jp_sal)
+           jkb = mld_prof(ji,jj)
+           jkb1 = MIN(jkb + 1, mbkt(ji,jj))
+!
+           zbuoy = grav * ( zthermal * ts(ji,jj,mld_prof(ji,jj)+2,jp_tem,Kmm) - zbeta * ts(ji,jj,mld_prof(ji,jj)+2,jp_sal,Kmm) )
+           zdb_mle = zb_bl(ji,jj) - zbuoy
+! Timestep hmle.
+           hmle(ji,jj) = hmle(ji,jj) + zwb0(ji,jj) * rn_Dt / zdb_mle
+        ELSE
+           IF ( zhmle(ji,jj) > zhbl(ji,jj) ) THEN
+              hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau
+           ELSE
+              hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt /rn_osm_mle_tau
+           ENDIF
+        ENDIF
+        hmle(ji,jj) = MIN(hmle(ji,jj), ht(ji,jj))
+       IF(ln_osm_hmle_limit) hmle(ji,jj) = MIN(hmle(ji,jj), MAX(rn_osm_hmle_limit,1.2*hbl(ji,jj)) )
+      END_2D
+      mld_prof = 4
+      DO_3D( 0, 0, 0, 0, 5, jpkm1 )
+      IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                            INTENT(in   ) ::   Kmm         ! Time-level index
+      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(in   ) ::   pmld        ! == Estimated FK BLD used for MLE horiz gradients == !
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   phmle       ! MLE depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pvel_mle    ! Velocity scale for dhdt with stable ML and FK
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdiff_mle   ! Extra MLE vertical diff
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbds_mle   ! Magnitude of horizontal buoyancy gradient
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl        ! BL depth
+      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb0tot     ! Total surface buoyancy flux including insolation
+      !!
+      INTEGER  ::   ji, jj, jk   ! Dummy loop indices
+      REAL(wp) ::   ztmp
+      REAL(wp) ::   zdbdz
+      REAL(wp) ::   zdtdz
+      REAL(wp) ::   zdsdz
+      REAL(wp) ::   zthermal
+      REAL(wp) ::   zbeta
+      REAL(wp) ::   zbuoy
+      REAL(wp) ::   zdb_mle
+      !!----------------------------------------------------------------------
+      !
+      ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_conv(ji,jj) ) THEN
+            ztmp =  r1_ft(ji,jj) * MIN( 111e3_wp, e1u(ji,jj) ) / rn_osm_mle_lf
+            ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt
+            pvel_mle(ji,jj)  = pdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1)
+            pdiff_mle(ji,jj) = 5e-4_wp * rn_osm_mle_ce * ztmp * pdbds_mle(ji,jj) * phmle(ji,jj)**2
+         END IF
+      END_2D
+      ! Timestep mixed layer eddy depth
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         IF ( l_mle(ji,jj) ) THEN   ! MLE layer growing
+            ! Buoyancy gradient at base of MLE layer
+            zthermal = rab_n(ji,jj,1,jp_tem)
+            zbeta    = rab_n(ji,jj,1,jp_sal)
+            zbuoy = grav * ( zthermal * ts(ji,jj,mld_prof(ji,jj)+2,jp_tem,Kmm) -   &
+               &             zbeta    * ts(ji,jj,mld_prof(ji,jj)+2,jp_sal,Kmm) )
+            zdb_mle = av_b_bl(ji,jj) - zbuoy
+            ! Timestep hmle
+            hmle(ji,jj) = hmle(ji,jj) + pwb0tot(ji,jj) * rn_Dt / zdb_mle
+         ELSE
+            IF ( phmle(ji,jj) > phbl(ji,jj) ) THEN
+               hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau
+            ELSE
+               hmle(ji,jj) = hmle(ji,jj) - 10.0_wp * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau
+            END IF
+         END IF
+         hmle(ji,jj) = MAX( MIN( hmle(ji,jj), ht(ji,jj) ), gdepw(ji,jj,4,Kmm) )
+         IF ( ln_osm_hmle_limit ) hmle(ji,jj) = MIN( hmle(ji,jj), rn_osm_hmle_limit*hbl(ji,jj) )
+         hmle(ji,jj) = pmld(ji,jj)   ! For now try just set hmle to pmld
+      END_2D
+      !
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 )
+         IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN( mbkt(ji,jj), jk )
       END_3D
+      DO_2D( 0, 0, 0, 0 )
+         zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm)
+      END_2D
+END SUBROUTINE zdf_osm_mle_parameters
+END SUBROUTINE zdf_osm
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         phmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm)
+      END_2D
+      !
+   END SUBROUTINE zdf_osm_mle_parameters
    SUBROUTINE zdf_osm_init( Kmm )
+     !!----------------------------------------------------------------------
+     !!                  ***  ROUTINE zdf_osm_init  ***
+     !!
+     !! ** Purpose :   Initialization of the vertical eddy diffivity and
+     !!      viscosity when using a osm turbulent closure scheme
+     !!
+     !! ** Method  :   Read the namosm namelist and check the parameters
+     !!      called at the first timestep (nit000)
+     !!
+     !! ** input   :   Namlist namosm
+     !!----------------------------------------------------------------------
+     INTEGER, INTENT(in)   ::   Kmm       ! time level
+     INTEGER  ::   ios            ! local integer
+     INTEGER  ::   ji, jj, jk     ! dummy loop indices
+     REAL z1_t2
+     !!
+     NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave &
+          & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd &
+          & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave &
+          & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter
+! Namelist for Fox-Kemper parametrization.
+      NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat,&
+           & rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit
+     !!----------------------------------------------------------------------
+     !
+     READ  ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901)
+  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' )
+     READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 )
+  IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' )
+     IF(lwm) WRITE ( numond, namzdf_osm )
+     IF(lwp) THEN                    ! Control print
+        WRITE(numout,*)
+        WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation'
+        WRITE(numout,*) '~~~~~~~~~~~~'
+        WRITE(numout,*) '   Namelist namzdf_osm : set osm mixing parameters'
+        WRITE(numout,*) '     Use  rn_osm_la                                ln_use_osm_la = ', ln_use_osm_la
+        WRITE(numout,*) '     Use  MLE in OBL, i.e. Fox-Kemper param        ln_osm_mle = ', ln_osm_mle
+        WRITE(numout,*) '     Turbulent Langmuir number                     rn_osm_la   = ', rn_osm_la
+        WRITE(numout,*) '     Stokes drift reduction factor                 rn_zdfosm_adjust_sd   = ', rn_zdfosm_adjust_sd
+        WRITE(numout,*) '     Initial hbl for 1D runs                       rn_osm_hbl0   = ', rn_osm_hbl0
+        WRITE(numout,*) '     Depth scale of Stokes drift                   rn_osm_dstokes = ', rn_osm_dstokes
+        WRITE(numout,*) '     horizontal average flag                       nn_ave      = ', nn_ave
+        WRITE(numout,*) '     Stokes drift                                  nn_osm_wave = ', nn_osm_wave
+        SELECT CASE (nn_osm_wave)
+        CASE(0)
+           WRITE(numout,*) '     calculated assuming constant La#=0.3'
+        CASE(1)
+           WRITE(numout,*) '     calculated from Pierson Moskowitz wind-waves'
+        CASE(2)
+           WRITE(numout,*) '     calculated from ECMWF wave fields'
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_osm_init  ***
+      !!
+      !! ** Purpose :   Initialization of the vertical eddy diffivity and
+      !!      viscosity when using a osm turbulent closure scheme
+      !!
+      !! ** Method  :   Read the namosm namelist and check the parameters
+      !!      called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namlists namzdf_osm and namosm_mle
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   Kmm   ! Time level
+      !!
+      INTEGER  ::   ios            ! Local integer
+      INTEGER  ::   ji, jj, jk     ! Dummy loop indices
+      REAL(wp) ::   z1_t2
+      !!
+      REAL(wp), PARAMETER ::   pp_large = -1e10_wp
+      !!
+      NAMELIST/namzdf_osm/ ln_use_osm_la,    rn_osm_la,      rn_osm_dstokes,      nn_ave,                nn_osm_wave,        &
+         &                 ln_dia_osm,       rn_osm_hbl0,    rn_zdfosm_adjust_sd, ln_kpprimix,           rn_riinfty,         &
+         &                 rn_difri,         ln_convmix,     rn_difconv,          nn_osm_wave,           nn_osm_SD_reduce,   &
+         &                 ln_osm_mle,       rn_osm_hblfrac, rn_osm_bl_thresh,    ln_zdfosm_ice_shelter
+      !! Namelist for Fox-Kemper parametrization
+      NAMELIST/namosm_mle/ nn_osm_mle,       rn_osm_mle_ce,     rn_osm_mle_lf,  rn_osm_mle_time,  rn_osm_mle_lat,   &
+         &                 rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit
+      !!----------------------------------------------------------------------
+      !
+      READ  ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901)
+   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' )
+      READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 )
+   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' )
+      IF(lwm) WRITE ( numond, namzdf_osm )
+      IF(lwp) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_osm : set osm mixing parameters'
+         WRITE(numout,*) '      Use  rn_osm_la                                     ln_use_osm_la         = ', ln_use_osm_la
+         WRITE(numout,*) '      Use  MLE in OBL, i.e. Fox-Kemper param             ln_osm_mle            = ', ln_osm_mle
+         WRITE(numout,*) '      Turbulent Langmuir number                          rn_osm_la             = ', rn_osm_la
+         WRITE(numout,*) '      Stokes drift reduction factor                      rn_zdfosm_adjust_sd   = ', rn_zdfosm_adjust_sd
+         WRITE(numout,*) '      Initial hbl for 1D runs                            rn_osm_hbl0           = ', rn_osm_hbl0
+         WRITE(numout,*) '      Depth scale of Stokes drift                        rn_osm_dstokes        = ', rn_osm_dstokes
+         WRITE(numout,*) '      Horizontal average flag                            nn_ave                = ', nn_ave
+         WRITE(numout,*) '      Stokes drift                                       nn_osm_wave           = ', nn_osm_wave
+         SELECT CASE (nn_osm_wave)
+         CASE(0)
+            WRITE(numout,*) '      Calculated assuming constant La#=0.3'
+         CASE(1)
+            WRITE(numout,*) '      Calculated from Pierson Moskowitz wind-waves'
+         CASE(2)
+            WRITE(numout,*) '      Calculated from ECMWF wave fields'
          END SELECT
+        WRITE(numout,*) '     Stokes drift reduction                        nn_osm_SD_reduce', nn_osm_SD_reduce
+        WRITE(numout,*) '     fraction of hbl to average SD over/fit'
+        WRITE(numout,*) '     exponential with nn_osm_SD_reduce = 1 or 2    rn_osm_hblfrac =  ', rn_osm_hblfrac
+        SELECT CASE (nn_osm_SD_reduce)
+        CASE(0)
+           WRITE(numout,*) '     No reduction'
+        CASE(1)
+           WRITE(numout,*) '     Average SD over upper rn_osm_hblfrac of BL'
+        CASE(2)
+           WRITE(numout,*) '     Fit exponential to slope rn_osm_hblfrac of BL'
+        END SELECT
+        WRITE(numout,*) '     reduce surface SD and depth scale under ice   ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter
+        WRITE(numout,*) '     Output osm diagnostics                       ln_dia_osm  = ',  ln_dia_osm
+        WRITE(numout,*) '         Threshold used to define BL              rn_osm_bl_thresh  = ', rn_osm_bl_thresh, 'm^2/s'
+        WRITE(numout,*) '     Use KPP-style shear instability mixing       ln_kpprimix = ', ln_kpprimix
+        WRITE(numout,*) '     local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty
+        WRITE(numout,*) '     maximum shear diffusivity at Rig = 0    (m2/s) rn_difri = ', rn_difri
+        WRITE(numout,*) '     Use large mixing below BL when unstable       ln_convmix = ', ln_convmix
+        WRITE(numout,*) '     diffusivity when unstable below BL     (m2/s) rn_difconv = ', rn_difconv
+     ENDIF
+     !                              ! Check wave coupling settings !
+     !                         ! Further work needed - see ticket #2447 !
+     IF( nn_osm_wave == 2 ) THEN
+        IF (.NOT. ( ln_wave .AND. ln_sdw )) &
+           & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' )
+     END IF
+     !                              ! allocate zdfosm arrays
+     IF( zdf_osm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' )
+     IF( ln_osm_mle ) THEN
+! Initialise Fox-Kemper parametrization
+         WRITE(numout,*) '      Stokes drift reduction                             nn_osm_SD_reduce      = ', nn_osm_SD_reduce
+         WRITE(numout,*) '      Fraction of hbl to average SD over/fit'
+         WRITE(numout,*) '      Exponential with nn_osm_SD_reduce = 1 or 2         rn_osm_hblfrac        = ', rn_osm_hblfrac
+         SELECT CASE (nn_osm_SD_reduce)
+         CASE(0)
+            WRITE(numout,*) '     No reduction'
+         CASE(1)
+            WRITE(numout,*) '     Average SD over upper rn_osm_hblfrac of BL'
+         CASE(2)
+            WRITE(numout,*) '     Fit exponential to slope rn_osm_hblfrac of BL'
+         END SELECT
+         WRITE(numout,*) '     Reduce surface SD and depth scale under ice         ln_zdfosm_ice_shelter = ', ln_zdfosm_ice_shelter
+         WRITE(numout,*) '     Output osm diagnostics                              ln_dia_osm            = ', ln_dia_osm
+         WRITE(numout,*) '         Threshold used to define BL                     rn_osm_bl_thresh      = ', rn_osm_bl_thresh,   &
+            &            'm^2/s'
+         WRITE(numout,*) '     Use KPP-style shear instability mixing              ln_kpprimix           = ', ln_kpprimix
+         WRITE(numout,*) '     Local Richardson Number limit for shear instability rn_riinfty            = ', rn_riinfty
+         WRITE(numout,*) '     Maximum shear diffusivity at Rig = 0 (m2/s)         rn_difri              = ', rn_difri
+         WRITE(numout,*) '     Use large mixing below BL when unstable             ln_convmix            = ', ln_convmix
+         WRITE(numout,*) '     Diffusivity when unstable below BL (m2/s)           rn_difconv            = ', rn_difconv
+      ENDIF
+      !
+      !                              ! Check wave coupling settings !
+      !                         ! Further work needed - see ticket #2447 !
+      IF ( nn_osm_wave == 2 ) THEN
+         IF (.NOT. ( ln_wave .AND. ln_sdw )) &
+            & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' )
+      END IF
+      !
+      ! Flags associated with diagnostic output
+      IF ( ln_dia_osm .AND. ( iom_use("zdudz_pyc") .OR. iom_use("zdvdz_pyc") ) )                            ln_dia_pyc_shr = .TRUE.
+      IF ( ln_dia_osm .AND. ( iom_use("zdtdz_pyc") .OR. iom_use("zdsdz_pyc") .OR. iom_use("zdbdz_pyc" ) ) ) ln_dia_pyc_scl = .TRUE.
+      !
+      ! Allocate zdfosm arrays
+      IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' )
+      !
+      IF( ln_osm_mle ) THEN   ! Initialise Fox-Kemper parametrization
          READ  ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903)
+      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namosm_mle in reference namelist')
+      IF( ios /= 0 ) CALL ctl_nam( ios, 'namosm_mle in reference namelist' )
          READ  ( numnam_cfg, namosm_mle, IOSTAT = ios, ERR = 904 )
       IF( ios >  0 )   CALL ctl_nam ( ios , 'namosm_mle in configuration namelist')
+      IF( ios >  0 ) CALL ctl_nam( ios, 'namosm_mle in configuration namelist' )
          IF(lwm) WRITE ( numond, namosm_mle )
          IF(lwp) THEN                     ! Namelist print
+         !
+         IF(lwp) THEN   ! Namelist print
             WRITE(numout,*)
             WRITE(numout,*) 'zdf_osm_init : initialise mixed layer eddy (MLE)'
             WRITE(numout,*) '~~~~~~~~~~~~~'
             WRITE(numout,*) '   Namelist namosm_mle : '
+            WRITE(numout,*) '         MLE type: =0 standard Fox-Kemper ; =1 new formulation        nn_osm_mle    = ', nn_osm_mle
+            WRITE(numout,*) '         magnitude of the MLE (typical value: 0.06 to 0.08)           rn_osm_mle_ce    = ', rn_osm_mle_ce
+            WRITE(numout,*) '         scale of ML front (ML radius of deformation) (nn_osm_mle=0)      rn_osm_mle_lf     = ', rn_osm_mle_lf, 'm'
+            WRITE(numout,*) '         maximum time scale of MLE                    (nn_osm_mle=0)      rn_osm_mle_time   = ', rn_osm_mle_time, 's'
+            WRITE(numout,*) '         reference latitude (degrees) of MLE coef.    (nn_osm_mle=1)      rn_osm_mle_lat    = ', rn_osm_mle_lat, 'deg'
+            WRITE(numout,*) '         Density difference used to define ML for FK              rn_osm_mle_rho_c  = ', rn_osm_mle_rho_c
+            WRITE(numout,*) '         Threshold used to define MLE for FK                      rn_osm_mle_thresh  = ', rn_osm_mle_thresh, 'm^2/s'
+            WRITE(numout,*) '         Timescale for OSM-FK                                         rn_osm_mle_tau  = ', rn_osm_mle_tau, 's'
+            WRITE(numout,*) '         switch to limit hmle                                      ln_osm_hmle_limit  = ', ln_osm_hmle_limit
+            WRITE(numout,*) '         fraction of zmld to limit hmle to if ln_osm_hmle_limit =.T.  rn_osm_hmle_limit = ', rn_osm_hmle_limit
+         ENDIF         !
+     ENDIF
+            WRITE(numout,*) '      MLE type: =0 standard Fox-Kemper ; =1 new formulation   nn_osm_mle        = ', nn_osm_mle
+            WRITE(numout,*) '      Magnitude of the MLE (typical value: 0.06 to 0.08)      rn_osm_mle_ce     = ', rn_osm_mle_ce
+            WRITE(numout,*) '      Scale of ML front (ML radius of deform.) (nn_osm_mle=0) rn_osm_mle_lf     = ', rn_osm_mle_lf,    &
+               &            'm'
+            WRITE(numout,*) '      Maximum time scale of MLE                (nn_osm_mle=0) rn_osm_mle_time   = ',   &
+               &            rn_osm_mle_time, 's'
+            WRITE(numout,*) '      Reference latitude (deg) of MLE coef.    (nn_osm_mle=1) rn_osm_mle_lat    = ', rn_osm_mle_lat,   &
+               &            'deg'
+            WRITE(numout,*) '      Density difference used to define ML for FK             rn_osm_mle_rho_c  = ', rn_osm_mle_rho_c
+            WRITE(numout,*) '      Threshold used to define MLE for FK                     rn_osm_mle_thresh = ',   &
+               &            rn_osm_mle_thresh, 'm^2/s'
+            WRITE(numout,*) '      Timescale for OSM-FK                                    rn_osm_mle_tau    = ', rn_osm_mle_tau, 's'
+            WRITE(numout,*) '      Switch to limit hmle                                    ln_osm_hmle_limit = ', ln_osm_hmle_limit
+            WRITE(numout,*) '      hmle limit (fraction of zmld) (ln_osm_hmle_limit = .T.) rn_osm_hmle_limit = ', rn_osm_hmle_limit
+         END IF
+      END IF
+      !
       IF(lwp) THEN
          WRITE(numout,*)
          IF( ln_osm_mle ) THEN
+         IF ( ln_osm_mle ) THEN
             WRITE(numout,*) '   ==>>>   Mixed Layer Eddy induced transport added to OSMOSIS BL calculation'
             IF( nn_osm_mle == 0 )   WRITE(numout,*) '              Fox-Kemper et al 2010 formulation'
 …
          ELSE
             WRITE(numout,*) '   ==>>>   Mixed Layer induced transport NOT added to OSMOSIS BL calculation'
          ENDIF
       ENDIF
+      !
       IF( ln_osm_mle ) THEN                ! MLE initialisation
+         END IF
+      END IF
+      !
+      IF( ln_osm_mle ) THEN   ! MLE initialisation
+         !
          rb_c = grav * rn_osm_mle_rho_c /rho0        ! Mixed Layer buoyancy criteria
+         rb_c = grav * rn_osm_mle_rho_c / rho0   ! Mixed Layer buoyancy criteria
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 '
          IF(lwp) WRITE(numout,*) '      associated ML density criteria defined in zdfmxl = ', rn_osm_mle_rho_c, 'kg/m3'
+         !
+         IF( nn_osm_mle == 0 ) THEN           ! MLE array allocation & initialisation            !
+!
+         ELSEIF( nn_osm_mle == 1 ) THEN           ! MLE array allocation & initialisation
+            rc_f = rn_osm_mle_ce/ (  5.e3_wp * 2._wp * omega * SIN( rad * rn_osm_mle_lat )  )
+            !
+         ENDIF
+         !                                ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case)
+         z1_t2 = 2.e-5
+         DO_2D( 1, 1, 1, 1 )
+            r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2)
+         IF( nn_osm_mle == 1 ) THEN
+            rc_f = rn_osm_mle_ce / ( 5e3_wp * 2.0_wp * omega * SIN( rad * rn_osm_mle_lat ) )
+         END IF
+         ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case)
+         z1_t2 = 2e-5_wp
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            r1_ft(ji,jj) = MIN( 1.0_wp / ( ABS( ff_t(ji,jj)) + epsln ), ABS( ff_t(ji,jj) ) / z1_t2**2 )
          END_2D
          ! z1_t2 = 1._wp / ( rn_osm_mle_time * rn_osm_mle_timeji,jj )
          ! r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  )
+         !
+      ENDIF
+     call osm_rst( nit000, Kmm,  'READ' ) !* read or initialize hbl, dh, hmle
+     IF( ln_zdfddm) THEN
+        IF(lwp) THEN
+           WRITE(numout,*)
+           WRITE(numout,*) '    Double diffusion mixing on temperature and salinity '
+           WRITE(numout,*) '    CAUTION : done in routine zdfosm, not in routine zdfddm '
+        ENDIF
+     ENDIF
+     !set constants not in namelist
+     !-----------------------------
+     IF(lwp) THEN
+        WRITE(numout,*)
+     ENDIF
+     IF (nn_osm_wave == 0) THEN
+        dstokes(:,:) = rn_osm_dstokes
+     END IF
+     ! Horizontal average : initialization of weighting arrays
+     ! -------------------
+     SELECT CASE ( nn_ave )
+     CASE ( 0 )                ! no horizontal average
+        IF(lwp) WRITE(numout,*) '          no horizontal average on avt'
+        IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !'
+        ! weighting mean arrays etmean
+        !           ( 1  1 )
+        ! avt = 1/4 ( 1  1 )
+        !
+        etmean(:,:,:) = 0.e0
+        DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+           etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
+                &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
+                &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  )
+        END_3D
+     CASE ( 1 )                ! horizontal average
+        IF(lwp) WRITE(numout,*) '          horizontal average on avt'
+        ! weighting mean arrays etmean
+        !           ( 1/2  1  1/2 )
+        ! avt = 1/8 ( 1    2  1   )
+        !           ( 1/2  1  1/2 )
+        etmean(:,:,:) = 0.e0
+        DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+           etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
+                & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
+                &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   &
+                &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) &
+                &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   &
+                &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) )
+        END_3D
+     CASE DEFAULT
+        WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave
+        CALL ctl_stop( ctmp1 )
+     END SELECT
+     ! Initialization of vertical eddy coef. to the background value
+     ! -------------------------------------------------------------
+     DO jk = 1, jpk
+        avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+     END DO
+     ! zero the surface flux for non local term and osm mixed layer depth
+     ! ------------------------------------------------------------------
+     ghamt(:,:,:) = 0.
+     ghams(:,:,:) = 0.
+     ghamu(:,:,:) = 0.
+     ghamv(:,:,:) = 0.
+     !
+      END IF
+      !
+      CALL osm_rst( nit000, Kmm,  'READ' )   ! Read or initialize hbl, dh, hmle
+      !
+      IF ( ln_zdfddm ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '    Double diffusion mixing on temperature and salinity '
+            WRITE(numout,*) '    CAUTION : done in routine zdfosm, not in routine zdfddm '
+         END IF
+      END IF
+      !
+      ! Set constants not in namelist
+      ! -----------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+      END IF
+      !
+      dstokes(:,:) = pp_large
+      IF (nn_osm_wave == 0) THEN
+         dstokes(:,:) = rn_osm_dstokes
+      END IF
+      !
+      ! Horizontal average : initialization of weighting arrays
+      ! -------------------
+      SELECT CASE ( nn_ave )
+      CASE ( 0 )                ! no horizontal average
+         IF(lwp) WRITE(numout,*) '          no horizontal average on avt'
+         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !'
+         ! Weighting mean arrays etmean
+         !           ( 1  1 )
+         ! avt = 1/4 ( 1  1 )
+         !
+         etmean(:,:,:) = 0.0_wp
+         !
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+            etmean(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1.0_wp, umask(ji-1,jj,  jk) + umask(ji,jj,jk) +   &
+               &                                              vmask(ji,  jj-1,jk) + vmask(ji,jj,jk) )
+         END_3D
+      CASE ( 1 )                ! horizontal average
+         IF(lwp) WRITE(numout,*) '          horizontal average on avt'
+         ! Weighting mean arrays etmean
+         !           ( 1/2  1  1/2 )
+         ! avt = 1/8 ( 1    2  1   )
+         !           ( 1/2  1  1/2 )
+         etmean(:,:,:) = 0.0_wp
+         !
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+            etmean(ji,jj,jk) = tmask(ji, jj,jk) / MAX( 1.0_wp, 2.0_wp *   tmask(ji,jj,jk) +                               &
+               &                                               0.5_wp * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk) +     &
+               &                                                          tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) +   &
+               &                                               1.0_wp * ( tmask(ji-1,jj,  jk) + tmask(ji,  jj+1,jk) +     &
+               &                                                          tmask(ji,  jj-1,jk) + tmask(ji+1,jj,  jk) ) )
+         END_3D
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave
+         CALL ctl_stop( ctmp1 )
+      END SELECT
+      !
+      ! Initialization of vertical eddy coef. to the background value
+      ! -------------------------------------------------------------
+      DO jk = 1, jpk
+         avt(:,:,jk) = avtb(jk) * tmask(:,:,jk)
+      END DO
+      !
+      ! Zero the surface flux for non local term and osm mixed layer depth
+      ! ------------------------------------------------------------------
+      ghamt(:,:,:) = 0.0_wp
+      ghams(:,:,:) = 0.0_wp
+      ghamu(:,:,:) = 0.0_wp
+      ghamv(:,:,:) = 0.0_wp
+      !
+      IF ( ln_dia_osm ) THEN   ! Initialise auxiliary arrays for diagnostic output
+         osmdia2d(:,:)   = 0.0_wp
+         osmdia3d(:,:,:) = 0.0_wp
+      END IF
+      !
    END SUBROUTINE zdf_osm_init
    SUBROUTINE osm_rst( kt, Kmm, cdrw )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE osm_rst  ***
+     !!
+     !! ** Purpose :   Read or write BL fields in restart file
+     !!
+     !! ** Method  :   use of IOM library. If the restart does not contain
+     !!                required fields, they are recomputed from stratification
+     !!----------------------------------------------------------------------
+     INTEGER         , INTENT(in) ::   kt     ! ocean time step index
+     INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index (middle)
+     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+     INTEGER ::   id1, id2, id3   ! iom enquiry index
+     INTEGER  ::   ji, jj, jk     ! dummy loop indices
+     INTEGER  ::   iiki, ikt ! local integer
+     REAL(wp) ::   zhbf           ! tempory scalars
+     REAL(wp) ::   zN2_c           ! local scalar
+     REAL(wp) ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth
+     INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top)
+     !!----------------------------------------------------------------------
+     !
+     !!-----------------------------------------------------------------------------
+     ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return
+     !!-----------------------------------------------------------------------------
+     IF( TRIM(cdrw) == 'READ'.AND. ln_rstart) THEN
+        id1 = iom_varid( numror, 'wn'   , ldstop = .FALSE. )
+        IF( id1 > 0 ) THEN                       ! 'wn' exists; read
+           CALL iom_get( numror, jpdom_auto, 'wn', ww )
+           WRITE(numout,*) ' ===>>>> :  wn read from restart file'
+        ELSE
+           ww(:,:,:) = 0._wp
+           WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially'
+        END IF
+        id1 = iom_varid( numror, 'hbl'   , ldstop = .FALSE. )
+        id2 = iom_varid( numror, 'dh'   , ldstop = .FALSE. )
+        IF( id1 > 0 .AND. id2 > 0) THEN                       ! 'hbl' exists; read and return
+           CALL iom_get( numror, jpdom_auto, 'hbl' , hbl  )
+           CALL iom_get( numror, jpdom_auto, 'dh', dh )
+           WRITE(numout,*) ' ===>>>> :  hbl & dh read from restart file'
+           IF( ln_osm_mle ) THEN
+              id3 = iom_varid( numror, 'hmle'   , ldstop = .FALSE. )
+              IF( id3 > 0) THEN
+                 CALL iom_get( numror, jpdom_auto, 'hmle' , hmle )
+                 WRITE(numout,*) ' ===>>>> :  hmle read from restart file'
+              ELSE
+                 WRITE(numout,*) ' ===>>>> :  hmle not found, set to hbl'
+                 hmle(:,:) = hbl(:,:)            ! Initialise MLE depth.
+              END IF
+           END IF
+           RETURN
+        ELSE                      ! 'hbl' & 'dh' not in restart file, recalculate
+           WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification'
+        END IF
+     END IF
+     !!-----------------------------------------------------------------------------
+     ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return
+     !!-----------------------------------------------------------------------------
+     IF( TRIM(cdrw) == 'WRITE') THEN     !* Write hbl into the restart file, then return
+        IF(lwp) WRITE(numout,*) '---- osm-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'wn'     , ww  )
+         CALL iom_rstput( kt, nitrst, numrow, 'hbl'    , hbl )
+         CALL iom_rstput( kt, nitrst, numrow, 'dh'     , dh  )
+         IF( ln_osm_mle ) THEN
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE osm_rst  ***
+      !!
+      !! ** Purpose :   Read or write BL fields in restart file
+      !!
+      !! ** Method  :   use of IOM library. If the restart does not contain
+      !!                required fields, they are recomputed from stratification
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kt     ! Ocean time step index
+      INTEGER         , INTENT(in   ) ::   Kmm    ! Ocean time level index (middle)
+      CHARACTER(len=*), INTENT(in   ) ::   cdrw   ! "READ"/"WRITE" flag
+      !!
+      INTEGER  ::   id1, id2, id3                 ! iom enquiry index
+      INTEGER  ::   ji, jj, jk                    ! Dummy loop indices
+      INTEGER  ::   iiki, ikt                     ! Local integer
+      REAL(wp) ::   zhbf                          ! Tempory scalars
+      REAL(wp) ::   zN2_c                         ! Local scalar
+      REAL(wp) ::   rho_c = 0.01_wp               ! Density criterion for mixed layer depth
+      INTEGER, DIMENSION(jpi,jpj) ::   imld_rst   ! Level of mixed-layer depth (pycnocline top)
+      !!----------------------------------------------------------------------
+      !
+      !!-----------------------------------------------------------------------------
+      ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return
+      !!-----------------------------------------------------------------------------
+      IF( TRIM(cdrw) == 'READ' .AND. ln_rstart) THEN
+         id1 = iom_varid( numror, 'wn', ldstop = .FALSE. )
+         IF( id1 > 0 ) THEN   ! 'wn' exists; read
+            CALL iom_get( numror, jpdom_auto, 'wn', ww )
+            WRITE(numout,*) ' ===>>>> :  wn read from restart file'
+         ELSE
+            ww(:,:,:) = 0.0_wp
+            WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially'
+         END IF
+         !
+         id1 = iom_varid( numror, 'hbl', ldstop = .FALSE. )
+         id2 = iom_varid( numror, 'dh',  ldstop = .FALSE. )
+         IF( id1 > 0 .AND. id2 > 0 ) THEN   ! 'hbl' exists; read and return
+            CALL iom_get( numror, jpdom_auto, 'hbl', hbl  )
+            CALL iom_get( numror, jpdom_auto, 'dh',  dh   )
+            hml(:,:) = hbl(:,:) - dh(:,:)   ! Initialise ML depth
+            WRITE(numout,*) ' ===>>>> :  hbl & dh read from restart file'
+            IF( ln_osm_mle ) THEN
+               id3 = iom_varid( numror, 'hmle', ldstop = .FALSE. )
+               IF( id3 > 0 ) THEN
+                  CALL iom_get( numror, jpdom_auto, 'hmle', hmle )
+                  WRITE(numout,*) ' ===>>>> :  hmle read from restart file'
+               ELSE
+                  WRITE(numout,*) ' ===>>>> :  hmle not found, set to hbl'
+                  hmle(:,:) = hbl(:,:)   ! Initialise MLE depth
+               END IF
+            END IF
+            RETURN
+         ELSE   ! 'hbl' & 'dh' not in restart file, recalculate
+            WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification'
+         END IF
+      END IF
+      !
+      !!-----------------------------------------------------------------------------
+      ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return
+      !!-----------------------------------------------------------------------------
+      IF ( TRIM(cdrw) == 'WRITE' ) THEN
+         IF(lwp) WRITE(numout,*) '---- osm-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'wn',  ww  )
+         CALL iom_rstput( kt, nitrst, numrow, 'hbl', hbl )
+         CALL iom_rstput( kt, nitrst, numrow, 'dh',  dh  )
+         IF ( ln_osm_mle ) THEN
             CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle )
          END IF
+        RETURN
+     END IF
+     !!-----------------------------------------------------------------------------
+     ! Getting hbl, no restart file with hbl, so calculate from surface stratification
+     !!-----------------------------------------------------------------------------
+     IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification'
+     ! w-level of the mixing and mixed layers
+     CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm )
+     CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm)
+     imld_rst(:,:)  = nlb10         ! Initialization to the number of w ocean point
+     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2
+     zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria
+     !
+     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2
+     DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+        ikt = mbkt(ji,jj)
+        hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm)
+        IF( hbl(ji,jj) < zN2_c )   imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
+     END_3D
+     !
+     DO_2D( 1, 1, 1, 1 )
+        iiki = MAX(4,imld_rst(ji,jj))
+        hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm  )    ! Turbocline depth
+        dh (ji,jj) = e3t(ji,jj,iiki-1,Kmm  )     ! Turbocline depth
+     END_2D
+     WRITE(numout,*) ' ===>>>> : hbl computed from stratification'
+     IF( ln_osm_mle ) THEN
+        hmle(:,:) = hbl(:,:)            ! Initialise MLE depth.
+        WRITE(numout,*) ' ===>>>> : hmle set = to hbl'
+     END IF
+     ww(:,:,:) = 0._wp
+     WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially'
+         RETURN
+      END IF
+      !
+      !!-----------------------------------------------------------------------------
+      ! Getting hbl, no restart file with hbl, so calculate from surface stratification
+      !!-----------------------------------------------------------------------------
+      IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification'
+      ! w-level of the mixing and mixed layers
+      CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm )
+      CALL bn2( ts(:,:,:,:,Kmm), rab_n, rn2, Kmm )
+      imld_rst(:,:) = nlb10            ! Initialization to the number of w ocean point
+      hbl(:,:) = 0.0_wp                ! Here hbl used as a dummy variable, integrating vertically N^2
+      zN2_c = grav * rho_c * r1_rho0   ! Convert density criteria into N^2 criteria
+      !
+      hbl(:,:)  = 0.0_wp   ! Here hbl used as a dummy variable, integrating vertically N^2
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+         ikt = mbkt(ji,jj)
+         hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0.0_wp ) * e3w(ji,jj,jk,Kmm)
+         IF ( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
+      END_3D
+      !
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         iiki = MAX( 4, imld_rst(ji,jj) )
+         hbl(ji,jj) = gdepw(ji,jj,iiki,Kmm  )   ! Turbocline depth
+         dh(ji,jj)  = e3t(ji,jj,iiki-1,Kmm  )   ! Turbocline depth
+         hml(ji,jj) = hbl(ji,jj) - dh(ji,jj)
+      END_2D
+      !
+      WRITE(numout,*) ' ===>>>> : hbl computed from stratification'
+      !
+      IF( ln_osm_mle ) THEN
+         hmle(:,:) = hbl(:,:)            ! Initialise MLE depth.
+         WRITE(numout,*) ' ===>>>> : hmle set = to hbl'
+      END IF
+      !
+      ww(:,:,:) = 0.0_wp
+      WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially'
+      !
    END SUBROUTINE osm_rst
    SUBROUTINE tra_osm( kt, Kmm, pts, Krhs )
       !!----------------------------------------------------------------------
 …
       !!
       !! ** Method  :   ???
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt          ! Time step index
+      INTEGER                                  , INTENT(in   ) ::   Kmm, Krhs   ! Time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts         ! Active tracers and RHS of tracer equation
+      !!
+      INTEGER                                 ::   ji, jj, jk
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in)    :: kt        ! time step index
+      INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation
+      !
+      INTEGER :: ji, jj, jk
+      !
+      IF( kt == nit000 ) THEN
+         IF( ntile == 0 .OR. ntile == 1 ) THEN                    ! Do only on the first tile
+      !
+      IF ( kt == nit000 ) THEN
+         IF ( ntile == 0 .OR. ntile == 1 ) THEN   ! Do only on the first tile
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) 'tra_osm : OSM non-local tracer fluxes'
             IF(lwp) WRITE(numout,*) '~~~~~~~   '
+         ENDIF
+      ENDIF
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
+      ENDIF
+         END IF
+      END IF
+      !
+      IF ( l_trdtra ) THEN   ! Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
+      END IF
+      !
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )
          pts(ji,jj,jk,jp_tem,Krhs) =  pts(ji,jj,jk,jp_tem,Krhs)                      &
 …
             &                    - ghams(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
       END_3D
+      ! save the non-local tracer flux trends for diagnostics
+      IF( l_trdtra )   THEN
+      !
+      IF ( l_trdtra ) THEN   ! Save the non-local tracer flux trends for diagnostics
          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_osm, ztrdt )
          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_osm, ztrds )
          DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
       ENDIF
       IF(sn_cfctl%l_prtctl) THEN
+         DEALLOCATE( ztrdt, ztrds )
+      END IF
+      !
+      IF ( sn_cfctl%l_prtctl ) THEN
          CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' osm  - Ta: ', mask1=tmask,   &
          &             tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       ENDIF
+            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      END IF
+      !
    END SUBROUTINE tra_osm
+   SUBROUTINE trc_osm( kt )          ! Dummy routine
+   SUBROUTINE trc_osm( kt )   ! Dummy routine
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE trc_osm  ***
 …
       !!
       !! ** Method  :   ???
+      !!----------------------------------------------------------------------
+      !
+      !!
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) :: kt
+      !!----------------------------------------------------------------------
+      !
       WRITE(*,*) 'trc_osm: Not written yet', kt
+      !
    END SUBROUTINE trc_osm
    SUBROUTINE dyn_osm( kt, Kmm, puu, pvv, Krhs )
 …
       !!
       !! ** Method  :   ???
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT( in )  ::  kt          ! ocean time step index
+      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation
+      !
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                             , INTENT(in   ) ::   kt          ! Ocean time step index
+      INTEGER                             , INTENT(in   ) ::   Kmm, Krhs   ! Ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv    ! Ocean velocities and RHS of momentum equation
+      !!
       INTEGER :: ji, jj, jk   ! dummy loop indices
       !!----------------------------------------------------------------------
+      !
       IF( kt == nit000 ) THEN
+      IF ( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'dyn_osm : OSM non-local velocity'
          IF(lwp) WRITE(numout,*) '~~~~~~~   '
+      ENDIF
+      !code saving tracer trends removed, replace with trdmxl_oce
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! add non-local u and v fluxes
+         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs)                      &
+            &                 - (  ghamu(ji,jj,jk  )  &
+            &                    - ghamu(ji,jj,jk+1) ) / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs)                      &
+            &                 - (  ghamv(ji,jj,jk  )  &
+            &                    - ghamv(ji,jj,jk+1) ) / e3v(ji,jj,jk,Kmm)
+      END IF
+      !
+      ! Code saving tracer trends removed, replace with trdmxl_oce
+      !
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Add non-local u and v fluxes
+         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs) - ( ghamu(ji,jj,jk  ) -   &
+            &                                         ghamu(ji,jj,jk+1) ) / e3u(ji,jj,jk,Kmm)
+         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs) - ( ghamv(ji,jj,jk  ) -   &
+            &                                         ghamv(ji,jj,jk+1) ) / e3v(ji,jj,jk,Kmm)
       END_3D
+      !
       ! code for saving tracer trends removed
+      ! Code for saving tracer trends removed
+      !
    END SUBROUTINE dyn_osm
+   SUBROUTINE zdf_osm_iomput_2d( cdname, posmdia2d )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE zdf_osm_iomput_2d  ***
+      !!
+      !! ** Purpose :   Wrapper for subroutine iom_put that accepts 2D arrays
+      !!                with and without halo
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*),         INTENT(in   ) ::   cdname
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   posmdia2d
+      !!----------------------------------------------------------------------
+      !
+      IF ( ln_dia_osm .AND. iom_use( cdname ) ) THEN
+         IF ( SIZE( posmdia2d, 1 ) == ntei-ntsi+1 .AND. SIZE( posmdia2d, 2 ) == ntej-ntsj+1 ) THEN   ! Halo absent
+            osmdia2d(A2D(0)) = posmdia2d(:,:)
+            CALL iom_put( cdname, osmdia2d(A2D(nn_hls)) )
+         ELSE   ! Halo present
+            CALL iom_put( cdname, osmdia2d )
+         END IF
+      END IF
+      !
+   END SUBROUTINE zdf_osm_iomput_2d
+   SUBROUTINE zdf_osm_iomput_3d( cdname, posmdia3d )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE zdf_osm_iomput_3d  ***
+      !!
+      !! ** Purpose :   Wrapper for subroutine iom_put that accepts 3D arrays
+      !!                with and without halo
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*),           INTENT(in   ) ::   cdname
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   posmdia3d
+      !!----------------------------------------------------------------------
+      !
+      IF ( ln_dia_osm .AND. iom_use( cdname ) ) THEN
+         IF ( SIZE( posmdia3d, 1 ) == ntei-ntsi+1 .AND. SIZE( posmdia3d, 2 ) == ntej-ntsj+1 ) THEN   ! Halo absent
+            osmdia3d(A2D(0),:) = posmdia3d(:,:,:)
+            CALL iom_put( cdname, osmdia3d(A2D(nn_hls),:) )
+         ELSE   ! Halo present
+            CALL iom_put( cdname, osmdia3d )
+         END IF
+      END IF
+      !
+   END SUBROUTINE zdf_osm_iomput_3d
    !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfphy.F90

-                      r14433
+                      r14958
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
+   ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled)
+   USE domtile
    USE zdf_oce        ! vertical physics: shared variables
    USE zdfdrg         ! vertical physics: top/bottom drag coef.
 …
    INTEGER, PARAMETER ::   np_OSM = 5   ! OSMOSIS-OBL closure scheme for Kz
+   LOGICAL ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC))
+   LOGICAL, PUBLIC ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC))
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm_k_n !: "Now" avm_k used for calculation of zsh2 with tiling
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
 …
       ENDIF
       !                                ! shear production term flag
+      IF( ln_zdfcst ) THEN   ;   l_zdfsh2 = .FALSE.
+      ELSE                   ;   l_zdfsh2 = .TRUE.
+      ENDIF
+      IF( ln_zdfcst .OR. ln_zdfosm ) THEN   ;   l_zdfsh2 = .FALSE.
+      ELSE                                  ;   l_zdfsh2 = .TRUE.
+      ENDIF
+      IF( ln_tile .AND. l_zdfsh2 ) ALLOCATE( avm_k_n(jpi,jpj,jpk) )
       !                          !== Mass Flux Convectiive algorithm  ==!
       IF( ln_zdfmfc )   CALL zdf_mfc_init       ! Convection computed with eddy diffusivity mass flux
 …
+      !
       INTEGER ::   ji, jj, jk   ! dummy loop indice
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsh2   ! shear production
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zsh2   ! shear production
       !! ---------------------------------------------------------------------
+      !
 …
       IF ( ln_drgice_imp) THEN
          IF ( ln_isfcav ) THEN
+            rCdU_top(:,:) = rCdU_top(:,:) + ssmask(:,:) * tmask(:,:,1) * rCdU_ice(:,:)
+            DO_2D_OVR( 1, 1, 1, 1 )
+               rCdU_top(ji,jj) = rCdU_top(ji,jj) + ssmask(ji,jj) * tmask(ji,jj,1) * rCdU_ice(ji,jj)
+            END_2D
          ELSE
+            rCdU_top(:,:) = rCdU_ice(:,:)
+            DO_2D_OVR( 1, 1, 1, 1 )
+               rCdU_top(ji,jj) = rCdU_ice(ji,jj)
+            END_2D
          ENDIF
       ENDIF
 #endif
+      !
+      CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level
+      !
       !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k)
+      !
+      IF( l_zdfsh2 )   &         !* shear production at w-points (energy conserving form)
+         CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in
+            &                     zsh2    )     ! ==>> out : shear production
+      ! NOTE: [tiling] the closure schemes (zdf_tke etc) will update avm_k. With tiling, the calculation of zsh2 on adjacent tiles then uses both updated (next timestep) and non-updated (current timestep) values of avm_k. To preserve results, we save a read-only copy of the "now" avm_k to use in the calculation of zsh2.
+      IF( l_zdfsh2 ) THEN        !* shear production at w-points (energy conserving form)
+         IF( ln_tile ) THEN
+            IF( ntile == 1 ) avm_k_n(:,:,:) = avm_k(:,:,:)     ! Preserve "now" avm_k for calculation of zsh2
+            CALL zdf_sh2( Kbb, Kmm, avm_k_n, &     ! <<== in
+               &                     zsh2    )     ! ==>> out : shear production
+         ELSE
+            CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in
+               &                     zsh2    )     ! ==>> out : shear production
+         ENDIF
+      ENDIF
+      !
       SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points
 …
       CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz
       CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz
 !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value)
 !         ! avt_k and avm_k set one for all at initialisation phase
+   !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value)
+   !         ! avt_k and avm_k set one for all at initialisation phase
 !!gm         avt(2:jpim1,2:jpjm1,1:jpkm1) = rn_avt0 * wmask(2:jpim1,2:jpjm1,1:jpkm1)
 !!gm         avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1)
 …
+      !
       !                                         !* start from turbulent closure values
+      avt(:,:,2:jpkm1) = avt_k(:,:,2:jpkm1)
+      avm(:,:,2:jpkm1) = avm_k(:,:,2:jpkm1)
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+         avt(ji,jj,jk) = avt_k(ji,jj,jk)
+         avm(ji,jj,jk) = avm_k(ji,jj,jk)
+      END_3D
+      !
       IF( ln_rnf_mouth ) THEN                   !* increase diffusivity at rivers mouths
          DO jk = 2, nkrnf
             avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * wmask(:,:,jk)
          END DO
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, nkrnf )
+            avt(ji,jj,jk) = avt(ji,jj,jk) + 2._wp * rn_avt_rnf * rnfmsk(ji,jj) * wmask(ji,jj,jk)
+         END_3D
       ENDIF
+      !
 …
                         CALL zdf_ddm( kt, Kmm,  avm, avt, avs )
       ELSE                                            ! same mixing on all tracers
+         avs(2:jpim1,2:jpjm1,1:jpkm1) = avt(2:jpim1,2:jpjm1,1:jpkm1)
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+            avs(ji,jj,jk) = avt(ji,jj,jk)
+         END_3D
       ENDIF
+      !
 …
 #if defined key_agrif
       ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)
+      IF( l_zdfsh2 )   CALL Agrif_avm
+      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+         IF( l_zdfsh2 )   CALL Agrif_avm
+      ENDIF
 #endif
       !                                         !* Lateral boundary conditions (sign unchanged)
+      IF( l_zdfsh2 ) THEN
+         CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   &
+            &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
+      ELSE
+         CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
+      ENDIF
+      !
+      IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases)
+         IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag
+         ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                       ! bottom drag only
+         ENDIF
+      ENDIF
+      !
+      CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level
+      !
+      IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file
+         IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' )
+         IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' )
+         IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' )
+         ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated
+      IF(nn_hls==1) THEN
+         IF( l_zdfsh2 ) THEN
+            CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   &
+                  &                 avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
+         ELSE
+            CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
+         ENDIF
+         !
+         IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases)
+            IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag
+            ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                           ! bottom drag only
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      CALL zdf_mxl_turb( kt, Kmm )                   !* turbocline depth
+      !
+      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
+         IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file
+            IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' )
+            IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' )
+            IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' )
+            ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated
+         ENDIF
       ENDIF
+      !

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfric.F90

-                      r14072
+                      r14958
       !!              PFJ Lermusiaux 2001.
       !!----------------------------------------------------------------------
       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time-step
       INTEGER                   , INTENT(in   ) ::   Kmm            ! ocean time level index
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points)
+      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time-step
+      INTEGER                             , INTENT(in   ) ::   Kmm            ! ocean time level index
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term
+      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points)
       !!
       INTEGER  ::   ji, jj, jk                  ! dummy loop indices
       REAL(wp) ::   zcfRi, zav, zustar, zhek    ! local scalars
       REAL(wp), DIMENSION(jpi,jpj) ::   zh_ekm  ! 2D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zh_ekm  ! 2D workspace
       !!----------------------------------------------------------------------
+      !
       !                       !==  avm and avt = F(Richardson number)  ==!
       DO_3D( 1, 0, 1, 0, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri)
+      DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri)
          zcfRi = 1._wp / (  1._wp + rn_alp * MAX(  0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) )  )
          zav   = rn_avmri * zcfRi**nn_ric
 …
       IF( ln_mldw ) THEN      !==  set a minimum value in the Ekman layer  ==!
+         !
          DO_2D( 0, 0, 0, 0 )             !* Ekman depth
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             zustar = SQRT( taum(ji,jj) * r1_rho0 )
             zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth
             zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range
          END_2D
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer
             IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN
                p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfsh2.F90

-                      r14072
+                      r14958
       !! References :   Bruchard, OM 2002
       !! ---------------------------------------------------------------------
       INTEGER                    , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points)
       REAL(wp), DIMENSION(:,:,:) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points)
+      INTEGER                              , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices
+      REAL(wp), DIMENSION(:,:,:)           , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points)
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop arguments
       REAL(wp), DIMENSION(jpi,jpj) ::   zsh2u, zsh2v   ! 2D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zsh2u, zsh2v   ! 2D workspace
       !!--------------------------------------------------------------------
+      !
       DO jk = 2, jpkm1                 !* Shear production at uw- and vw-points (energy conserving form)
          IF ( cpl_sdrftx .AND. ln_stshear )  THEN       ! Surface Stokes Drift available  ===>>>  shear + stokes drift contibution
             DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) )        &
                   &         * ( uu (ji,jj,jk-1,Kmm) -   uu (ji,jj,jk,Kmm)    &
 …
             END_2D
          ELSE
             DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form)
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )     !* 2 x shear production at uw- and vw-points (energy conserving form)
                zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) &
                   &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) &
 …
             END_2D
          ENDIF
          DO_2D( 0, 0, 0, 0 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked)
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked)
             p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   &
                &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdfswm.F90

r13295	r14958
63	63	!
64	64	zcoef = 1._wp * 0.353553_wp
65		DO_3D~~( 0, 0, 0, 0~~, 2, jpkm1 )
	65	DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
66	66	zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk)
67	67	!

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/ZDF/zdftke.F90

-                      r14072
+                      r14958
       !!              Bruchard OM 2002
       !!----------------------------------------------------------------------
       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step
       INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
+      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time step
+      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term
+      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
       !!----------------------------------------------------------------------
+      !
 …
       USE zdf_oce , ONLY : en   ! ocean vertical physics
       !!
       INTEGER                    , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_sh2          ! shear production term
       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points)
+      INTEGER                              , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in   ) ::   p_sh2          ! shear production term
+      REAL(wp), DIMENSION(:,:,:)           , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points)
+      !
       INTEGER ::   ji, jj, jk                  ! dummy loop arguments
 …
       REAL(wp) ::   zzd_up, zzd_lw             !   -      -
       REAL(wp) ::   ztaui, ztauj, z1_norm
       INTEGER , DIMENSION(jpi,jpj)     ::   imlc
       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3, zWlc2
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw
+      INTEGER , DIMENSION(A2D(nn_hls))     ::   imlc
+      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zice_fra, zhlc, zus3, zWlc2
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zpelc, zdiag, zd_up, zd_lw
       !!--------------------------------------------------------------------
+      !
 …
       SELECT CASE ( nn_eice )
       CASE( 0 )   ;   zice_fra(:,:) = 0._wp
       CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp )
       CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:)
       CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp )
+      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(A2D(nn_hls)) * 10._wp )
+      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(A2D(nn_hls))
+      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp )
       END SELECT
+      !
 …
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
       DO_2D( 0, 0, 0, 0 )
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
          en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) )
          zdiag(ji,jj,1) = 1._wp/en(ji,jj,1)
 …
       IF( .NOT.ln_drg_OFF ) THEN    !== friction used as top/bottom boundary condition on TKE
+         !
          DO_2D( 0, 0, 0, 0 )        ! bottom friction
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )        ! bottom friction
             zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
             zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )
 …
          END_2D
          IF( ln_isfcav ) THEN
             DO_2D( 0, 0, 0, 0 )     ! top friction
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     ! top friction
                zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
                zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )
 …
 !!gm  ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s
 !!gm  ! so we will overestimate the LC velocity....   !!gm I will do the work if !LC have an effect !
             DO_2D( 0, 0, 0, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
 !!XC                  zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )  )
                   zWlc2(ji,jj) = 0.5_wp *  ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )
 …
 !  Projection of Stokes drift in the wind stress direction
+!
             DO_2D( 0, 0, 0, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   ztaui   = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) )
                   ztauj   = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) )
 …
                   zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2
             END_2D
-         CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. )
+!
          ELSE                          ! Surface Stokes drift deduced from surface stress
             !                                ! Wlc = u_s   with u_s = 0.016*U_10m, the surface stokes drift  (Axell 2002, Eq.44)
 …
             !                                ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag )
             zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )      ! to convert stress in 10m wind using a constant drag
             DO_2D( 1, 1, 1, 1 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zWlc2(ji,jj) = zcof * taum(ji,jj)
             END_2D
 …
          !                       !* Depth of the LC circulation  (Axell 2002, Eq.47)
          !                             !- LHS of Eq.47
+         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm)
+         DO jk = 2, jpk
+            zpelc(:,:,jk)  = zpelc(:,:,jk-1) +   &
+               &        MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm)
+         END DO
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+            zpelc(ji,jj,1) =  MAX( rn2b(ji,jj,1), 0._wp ) * gdepw(ji,jj,1,Kmm) * e3w(ji,jj,1,Kmm)
+         END_2D
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpk )
+            zpelc(ji,jj,jk)  = zpelc(ji,jj,jk-1) +   &
+               &          MAX( rn2b(ji,jj,jk), 0._wp ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
+         END_3D
+         !
          !                             !- compare LHS to RHS of Eq.47
          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land)
          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )
+         imlc(:,:) = mbkt(A2D(nn_hls)) + 1       ! Initialization to the number of w ocean point (=2 over land)
+         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )
             IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) )   imlc(ji,jj) = jk
          END_3D
          !                               ! finite LC depth
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm)
          END_2D
+         !
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
          DO_2D( 0, 0, 0, 0 )
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             zus = SQRT( 2. * zWlc2(ji,jj) )             ! Stokes drift
             zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok
          END_2D
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en
             IF ( zus3(ji,jj) /= 0._wp ) THEN
                IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN
 …
+      !
       IF( nn_pdl == 1 ) THEN          !* Prandtl number = F( Ri )
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             !                             ! local Richardson number
             IF (rn2b(ji,jj,jk) <= 0.0_wp) then
 …
       ENDIF
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* Matrix and right hand side in en
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* Matrix and right hand side in en
          zcof   = zfact1 * tmask(ji,jj,jk)
          !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical
 …
          CASE ( 0 ) ! Dirichlet BC
             DO_2D( 0, 0, 0, 0 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0)
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0)
                IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp
                en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) )  * tmask(ji,jj,1)
 …
          CASE ( 1 ) ! Neumann BC
             DO_2D( 0, 0, 0, 0 )
+            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp
                en(ji,jj,2)    = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm)
 …
+      !
       !                          !* Matrix inversion from level 2 (tke prescribed at level 1)
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
          zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
       END_3D
 …
 !         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
 !      END_2D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
       END_3D
       DO_2D( 0, 0, 0, 0 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
          en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
       END_2D
       DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 )
+      DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 )
          en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
       END_3D
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! set the minimum value of tke
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! set the minimum value of tke
          en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
       END_3D
 …
+      !
       IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   &
                &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
          END_3D
       ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction)
          DO_2D( 0, 0, 0, 0 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             jk = nmln(ji,jj)
             en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   &
 …
          END_2D
       ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
             zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
 …
       REAL(wp) ::   zdku,   zdkv, zsqen       !   -      -
       REAL(wp) ::   zemxl, zemlm, zemlp, zmaxice       !   -      -
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zmxlm, zmxld   ! 3D workspace
       !!--------------------------------------------------------------------
+      !
 …
             zraug = vkarmn * 2.e5_wp / ( rho0 * grav )
 #if ! defined key_si3 && ! defined key_cice
             DO_2D( 0, 0, 0, 0 )                  ! No sea-ice
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                  ! No sea-ice
                zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1)
             END_2D
 …
+            !
             CASE( 0 )                      ! No scaling under sea-ice
                DO_2D( 0, 0, 0, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1)
                END_2D
+               !
             CASE( 1 )                      ! scaling with constant sea-ice thickness
                DO_2D( 0, 0, 0, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
                      &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1)
 …
+               !
             CASE( 2 )                      ! scaling with mean sea-ice thickness
                DO_2D( 0, 0, 0, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
 #if defined key_si3
                   zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
 …
+               !
             CASE( 3 )                      ! scaling with max sea-ice thickness
                DO_2D( 0, 0, 0, 0 )
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                   zmaxice = MAXVAL( h_i(ji,jj,:) )
                   zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
 …
 #endif
+            !
             DO_2D( 0, 0, 0, 0 )
+            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
                zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) )
             END_2D
 …
       ENDIF
+      !
       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
          zrn2 = MAX( rn2(ji,jj,jk), rsmall )
          zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
 …
       ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm)
       CASE ( 0 )           ! bounded by the distance to surface and bottom
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk),   &
             &            gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) )
 …
+         !
       CASE ( 1 )           ! bounded by the vertical scale factor
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) )
             zmxlm(ji,jj,jk) = zemxl
 …
+         !
       CASE ( 2 )           ! |dk[xml]| bounded by e3t :
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! from the surface to the bottom :
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! from the surface to the bottom :
             zmxlm(ji,jj,jk) =   &
                &    MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) )
          END_3D
          DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface :
+         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface :
             zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) )
             zmxlm(ji,jj,jk) = zemxl
 …
+         !
       CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! from the surface to the bottom : lup
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )        ! from the surface to the bottom : lup
             zmxld(ji,jj,jk) =    &
                &    MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) )
          END_3D
          DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown
+         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown
             zmxlm(ji,jj,jk) =   &
                &    MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) )
          END_3D
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
             zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
 …
       !                     !  Vertical eddy viscosity and diffusivity  (avm and avt)
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points
+      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points
          zsqen = SQRT( en(ji,jj,jk) )
          zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
 …
+      !
       IF( nn_pdl == 1 ) THEN          !* Prandtl number case: update avt
          DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
          END_3D
 …
+      !
       !                               !* Check of some namelist values
       IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' )
       IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' )
       IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' )
+      IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1, 2 or 3' )
+      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1' )
+      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0 or 1' )
       IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
+      !
 …
          rn_mxl0 = rmxl_min
       ENDIF
-      IF( nn_etau == 2  )   CALL zdf_mxl( nit000, Kmm )      ! Initialization of nmln
       !                               !* depth of penetration of surface tke
       IF( nn_etau /= 0 ) THEN

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/do_loop_substitute.h90

-                      r14215
+                      r14958
 #endif
+#define DO_2D(L, R, B, T) DO jj = ntsj-(B), ntej+(T)   ;   DO ji = ntsi-(L), ntei+(R)
+#define A1Di(H) ntsi-H:ntei+H
+#define A1Dj(H) ntsj-H:ntej+H
+#define DO_2D(L, R, B, T) DO jj = ntsj-(B), ntej+(T) ; DO ji = ntsi-(L), ntei+(R)
+#define DO_2D_OVR(L, R, B, T) DO_2D(L-(L+R)*nthl, R-(R+L)*nthr, B-(B+T)*nthb, T-(T+B)*ntht)
+#define A1Di(H) ntsi-(H):ntei+(H)
+#define A1Dj(H) ntsj-(H):ntej+(H)
 #define A2D(H) A1Di(H),A1Dj(H)
 #define A1Di_T(T) (ntsi-nn_hls-1)*T+1:
 …
 #define KJPT  :
+#define DO_3D(L, R, B, T, ks, ke) DO jk = ks, ke   ;   DO_2D(L, R, B, T)
+#define DO_3D(L, R, B, T, ks, ke) DO jk = ks, ke ; DO_2D(L, R, B, T)
+#define DO_3D_OVR(L, R, B, T, ks, ke) DO jk = ks, ke ; DO_2D_OVR(L, R, B, T)
+#define DO_3DS(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki   ;   DO_2D(L, R, B, T)
+#define DO_3DS(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki ; DO_2D(L, R, B, T)
+#define DO_3DS_OVR(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki ; DO_2D_OVR(L, R, B, T)
 #define END_2D   END DO   ;   END DO

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/module_example.F90

-                      r14433
+                      r14958
       !!--------------------------------------------------------------------
+      !
       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
 …
       IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' )
       !                              ! Parameter control
       IF( ln_tile .AND. ntile > 0 ) CALL ctl_stop( 'exa_mpl_init: tiling is not supported in this module by default, see manual for how to adapt your code' )
+      IF( ln_tile ) CALL ctl_stop( 'exa_mpl_init: tiling is not supported in this module by default, see manual for how to adapt your code' )
       IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   )
       IF( nn_opt == 2 )   CALL ctl_stop( 'STOP',  'exa_mpl_init: this work and option yyy may cause problems'  )
 …
 CONTAINS
    SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )              ! Empty routine
+      REAL::   ptab(:,:)
+      INTEGER :: kt
+      REAL::   pvar1, pvar2, ptab(:,:)
       WRITE(*,*) 'exa_mpl: You should not have seen this print! error?', kt, pvar1, pvar2, ptab(1,1)
    END SUBROUTINE exa_mpl

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/nemogcm.F90

-                      r14433
+                      r14958
       CALL mpp_init
+#if defined key_loop_fusion
+      IF( nn_hls == 1 ) THEN
+         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' )
+      ENDIF
+#endif
       CALL halo_mng_init()
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/par_oce.F90

r14688	r14958
72	72	INTEGER, PUBLIC :: ntei !: end of internal part of tile domain
73	73	INTEGER, PUBLIC :: ntej !
	74	INTEGER, PUBLIC :: nthl, nthr !: Modifier on DO loop macro bound offset (left, right)
	75	INTEGER, PUBLIC :: nthb, ntht !: " " (bottom, top)
74	76
75	77	!!---------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/step.F90

-                      r14553
+                      r14958
       !  VERTICAL PHYSICS
+      ! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy
+      IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp )
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] ZDF tiling loop
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
                          CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
       !  LATERAL  PHYSICS
 …
                          CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density
          IF( ln_zps .AND. .NOT. ln_isfcav)                                    &
+      IF( ln_zps .AND. .NOT. ln_isfcav)                                    &
             &            CALL zps_hde    ( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
             &                                          rhd, gru , grv    )       ! of t, s, rd at the last ocean level
          IF( ln_zps .AND.       ln_isfcav)                                                &
+      IF( ln_zps .AND.       ln_isfcav)                                                &
             &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
             &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level
 …
                          vv(:,:,:,Nrhs) = 0._wp
+      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
+               &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment
+      IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends
+#if defined key_agrif
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+         IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
+                  &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment
+         IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends
+#if defined key_agrif
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
       IF(.NOT. Agrif_Root())  &
                &         CALL Agrif_Sponge_dyn        ! momentum sponge
+#endif
+                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS
+                         CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS
+                         CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing
+      IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS
+                         CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure
+                         CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1, continued)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+#endif
+                            CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS
+                            CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS
+                            CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing
+         IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS
+                            CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
+                            CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient
                                                       ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well
       IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated
+                            CALL div_hor       ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case)
+         IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component)
+      ENDIF
+                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion
+         IF( ln_tile ) CALL dom_tile_start      ! [tiling] DYN tiling loop (2- div_hor only)
+         DO jtile = 1, nijtile
+            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+                             CALL div_hor       ( kstp, Nbb, Nnn )               ! Horizontal divergence  (2nd call in time-split case)
+         END DO
+         IF( ln_tile ) CALL dom_tile_stop
+         IF(.NOT. ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component)
+      ENDIF
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (3- dyn_zdf only)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+                               CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
       IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated
                             CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! Nnn cross-level velocity
 …
       ! Active tracers
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! Loop over tile domains
+      DO jtile = 1, nijtile
+         IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
+            ts(ji,jj,jk,:,Nrhs) = 0._wp                                   ! set tracer trends to zero
+         END_3D
+                         ts(:,:,:,:,Nrhs) = 0._wp         ! set tracer trends to zero
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (1)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
          IF(  lk_asminc .AND. ln_asmiau .AND. &
 …
          IF( ln_bdy     )   CALL bdy_tra_dmp( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends
       END DO
+      IF( ln_tile ) CALL dom_tile_stop
 #if defined key_agrif
       IF(.NOT. Agrif_Root() )   THEN
-         IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
                             CALL Agrif_Sponge_tra        ! tracers sponge
       ENDIF
 …
       ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling)
+      DO jtile = 1, nijtile
+         IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (2)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
                             CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS
 …
          IF( ln_zdfnpc  )   CALL tra_npc    ( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection
       END DO
+      IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Revert to tile over full domain
+      IF( ln_tile ) CALL dom_tile_stop
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Set boundary conditions, time filter and swap time levels

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/stpmlf.F90

-                      r14553
+                      r14958
 #  include "do_loop_substitute.h90"
 #  include "domzgr_substitute.h90"
-#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
 …
       !  VERTICAL PHYSICS
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] ZDF tiling loop
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
                          CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
       !  LATERAL  PHYSICS
 …
                          CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density
          IF( ln_zps .AND. .NOT. ln_isfcav)                                    &
+      IF( ln_zps .AND. .NOT. ln_isfcav)                                    &
             &            CALL zps_hde    ( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
             &                                          rhd, gru , grv    )       ! of t, s, rd at the last ocean level
          IF( ln_zps .AND.       ln_isfcav)                                                &
+      IF( ln_zps .AND.       ln_isfcav)                                                &
             &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
             &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level
 …
                          vv(:,:,:,Nrhs) = 0._wp
+      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
+               &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment
+      IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends
+#if defined key_agrif
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+         IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
+                  &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment
+         IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends
+#if defined key_agrif
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
       IF(.NOT. Agrif_Root())  &
                &         CALL Agrif_Sponge_dyn        ! momentum sponge
+#endif
+                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS
+                         CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS
+                         CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing
+      IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS
+                         CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure
+                         CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient
+      IF( ln_dynspg_ts ) THEN      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs)
+                                   ! as well as vertical scale factors and vertical velocity need to be updated
+                            CALL div_hor    ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case)
+         IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )   ! update ssh/h_0 ratio at t,u,v,f pts
+      ENDIF
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1, continued)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+#endif
+                            CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS
+                            CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS
+                            CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing
+         IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS
+                            CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
+                            CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (2)
+      DO jtile = 1, nijtile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+         IF( ln_dynspg_ts ) THEN      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs)
+                                      ! as well as vertical scale factors and vertical velocity need to be updated
+                            CALL div_hor    ( kstp, Nbb, Nnn )                  ! Horizontal divergence  (2nd call in time-split case)
+            IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )   ! update ssh/h_0 ratio at t,u,v,f pts
+         ENDIF
                             CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion
+      END DO
+      IF( ln_tile ) CALL dom_tile_stop
       IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated
                             CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! Nnn cross-level velocity
 …
       ! Active tracers
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! Loop over tile domains
+                         ts(:,:,:,:,Nrhs) = 0._wp         ! set tracer trends to zero
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (1)
       DO jtile = 1, nijtile
+         IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
+            ts(ji,jj,jk,:,Nrhs) = 0._wp                                   ! set tracer trends to zero
+         END_3D
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
          IF(  lk_asminc .AND. ln_asmiau .AND. &
 …
          IF( ln_bdy     )   CALL bdy_tra_dmp( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends
       END DO
+      IF( ln_tile ) CALL dom_tile_stop
 #if defined key_agrif
       IF(.NOT. Agrif_Root() ) THEN
-         IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
                             CALL Agrif_Sponge_tra        ! tracers sponge
       ENDIF
 …
       ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling)
+      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (2)
       DO jtile = 1, nijtile
          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
                             CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS
 …
          IF( ln_zdfnpc  )   CALL tra_npc    ( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection
       END DO
+      IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Revert to tile over full domain
+      IF( ln_tile ) CALL dom_tile_stop
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Set boundary conditions, time filter and swap time levels
 …
                        &          , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. )
+      !
+      ! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy
+      IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp )
+      ! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1]
+      IF( nn_hls == 2 .AND. .NOT. lk_linssh ) THEN
+         CALL lbc_lnk( 'finalize_lbc', r3u(:,:,Kaa), 'U', 1._wp, r3v(:,:,Kaa), 'V', 1._wp, &
+            &                          r3u_f(:,:),   'U', 1._wp, r3v_f(:,:),   'V', 1._wp )
+      ENDIF
       !                                        !* BDY open boundaries
       IF( ln_bdy )   THEN

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OCE/timing.F90

r14229	r14958
109	109
110	110	s_timer%l_tdone = .FALSE.
111		IF( ~~ntile == 0~~ .OR. ntile == 1 ) s_timer%niter = s_timer%niter + 1 ! All tiles count as one iteration
	111	IF( .NOT. l_istiled .OR. ntile == 1 ) s_timer%niter = s_timer%niter + 1 ! All tiles count as one iteration
112	112	s_timer%t_cpu = 0.
113	113	s_timer%t_clock = 0.

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/OFF/nemogcm.F90

-                      r14433
+                      r14958
       CALL mpp_init
+#if defined key_loop_fusion
+      IF( nn_hls == 1 ) THEN
+         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' )
+      ENDIF
+#endif
       CALL halo_mng_init()
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/SAS/nemogcm.F90

-                      r14433
+                      r14958
       CALL mpp_init
+#if defined key_loop_fusion
+      IF( nn_hls == 1 ) THEN
+         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' )
+      ENDIF
+#endif
       CALL halo_mng_init()
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/SWE/nemogcm.F90

-                      r14433
+                      r14958
       CALL mpp_init
+#if defined key_loop_fusion
+      IF( nn_hls == 1 ) THEN
+         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' )
+      ENDIF
+#endif
       CALL halo_mng_init()
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/SWE/stprk3.F90

r14433	r14958
172	172	!
173	173	CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. )
	174	IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.)
174	175	!
175	176	! !== Swap time levels ==!
…	…
237	238	!
238	239	CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. )
	240	IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.)
239	241	!
240	242	! !== Swap time levels ==!
…	…
300	302	!
301	303	CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. )
	304	IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.)
302	305	!
303	306	! !== Swap time levels ==!

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/TOP/AGE/trcnam_age.F90

r12377	r14958
53	53	ln_trc_cbc(jp_age) = .false.
54	54	ln_trc_obc(jp_age) = .false.
	55	ln_trc_ais(jp_age) = .false.
55	56	!
56	57	READ ( numnat_ref, namage, IOSTAT = ios, ERR = 901)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/TOP/C14/trcnam_c14.F90

r12377	r14958
60	60	ln_trc_cbc(jp_c14) = .false.
61	61	ln_trc_obc(jp_c14) = .false.
	62	ln_trc_ais(jp_c14) = .false.
62	63	!
63	64	READ ( numtrc_ref, namc14_typ, IOSTAT = ios, ERR = 901)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/TOP/CFC/trcnam_cfc.F90

r12377	r14958
77	77	ln_trc_cbc(jn) = .false.
78	78	ln_trc_obc(jn) = .false.
	79	ln_trc_ais(jn) = .false.
79	80	ENDIF
80	81	!

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/TOP/TRP/trcadv.F90

-                      r14544
+                      r14958
    USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
    USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
-   USE traadv_fct_lf  ! FCT      scheme           (tra_adv_fct  routine - loop fusion version)
    USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
-   USE traadv_mus_lf  ! MUSCL    scheme           (tra_adv_mus  routine - loop fusion version)
    USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
    USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
 …
+      !
       CASE ( np_CEN )                                 ! Centered : 2nd / 4th order
-         IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.)
          CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
       CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order
-         IF (nn_hls.EQ.2) THEN
-            CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.)
-            CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.)
-#if defined key_loop_fusion
-            CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
-#else
             CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
-#endif
-         ELSE
-            CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
-         END IF
       CASE ( np_MUS )                                 ! MUSCL
+         IF (nn_hls.EQ.2) THEN
+            CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.)
+#if defined key_loop_fusion
+            CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
+#else
+            CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
+#endif
+         ELSE
+            CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
+         END IF
+            CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
       CASE ( np_UBS )                                 ! UBS
-         IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.)
          CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           )
       CASE ( np_QCK )                                 ! QUICKEST
-         IF (nn_hls.EQ.2) THEN
-            CALL lbc_lnk( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)
-            CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.)
-         END IF
          CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     )
+      !

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/TOP/TRP/trcldf.F90

-                      r14086
+                      r14958
       zahv(:,:,:) = rldf * ahtv(:,:,:)
       !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain
       DO_3D( 1, 1, 1, 1, 1, jpk )
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
          IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
             zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000.
 …
            &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 )
       CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral)
-         IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1.)
          CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
            &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/TOP/trcdta.F90

-                      r14086
+                      r14958
                WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
             ENDIF
             DO_2D( 1, 1, 1, 1 )                 ! vertical interpolation of T & S
+            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                 ! vertical interpolation of T & S
                DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
                   zl = gdept_0(ji,jj,jk)
 …
             ! zps-coordinate (partial steps) interpolation at the last ocean level
             IF( ln_zps ) THEN
                 DO_2D( 1, 1, 1, 1 )
+                DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                    ik = mbkt(ji,jj)
                    IF( ik > 1 ) THEN

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/CANAL/EXPREF/namelist_cfg

-                      r14433
+                      r14958
       cn_domcfg_out = "domain_cfg" ! newly created domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================
 !!            ***  Surface Boundary Condition namelists  ***          !!

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/CPL_OASIS/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)
       !                         !       from the bathymetry at runtime.
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/DOME/EXPREF/1_namelist_cfg

r14254	r14958
42	42	cn_domcfg = "DOME_domcfg" ! domain configuration filename
43	43	!
	44	/
	45	!-----------------------------------------------------------------------
	46	&namtile ! parameters of the tiling
	47	!-----------------------------------------------------------------------
44	48	/
45	49	!-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/DOME/EXPREF/namelist_cfg

r14254	r14958
30	30	cn_domcfg = "DOME_domcfg" ! domain configuration filename
31	31	!
	32	/
	33	!-----------------------------------------------------------------------
	34	&namtile ! parameters of the tiling
	35	!-----------------------------------------------------------------------
32	36	/
33	37	!-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/DONUT/EXPREF/namelist_cfg

-                      r14226
+                      r14958
       !                    !  (=F) user defined configuration           (F => create/check namusr_def)
       cn_domcfg = "donut_cfg"  ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ICB/EXPREF/namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
 &namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
 !-----------------------------------------------------------------------
+/

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ICE_ADV1D/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
       cn_domcfg = "ICE_ADV1D_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ICE_ADV2D/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
       cn_domcfg = "ICE_ADV2D_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ICE_AGRIF/EXPREF/1_namelist_cfg

-                      r14229
+                      r14958
       !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
       cn_domcfg = "ICE_AGRIF_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ICE_AGRIF/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
       cn_domcfg = "ICE_AGRIF_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ICE_RHEO/EXPREF/namelist_cfg

-                      r14229
+                      r14958
    ln_read_cfg = .false.    !  (=T) read the domain configuration file
       !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !!======================================================================

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ISOMIP+/EXPREF/namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
    ln_read_cfg = .true.   !  (=T) read the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ISOMIP+/MY_SRC/dtatsd.F90

-                      r14090
+                      r14958
       INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
       INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
-      INTEGER ::   itile
       REAL(wp)::   zl, zi                             ! local scalars
       REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace
       !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
+         itile = ntile
+         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
+         IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. )             ! Use full domain
          SELECT CASE(cddta)
 …
          END SELECT
          IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain
+         IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. )            ! Revert to tile domain
       ENDIF
+      !
 …
       IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
+         !
          IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
             IF( kt == nit000 .AND. lwp )THEN
                WRITE(numout,*)
 …
          ENDIF
+         !
          DO_2D( 1, 1, 1, 1 )                  ! vertical interpolation of T & S
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                  ! vertical interpolation of T & S
             DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
                zl = gdept_0(ji,jj,jk)
 …
+         !
          IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
             DO_2D( 1, 1, 1, 1 )
+            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                ik = mbkt(ji,jj)
                IF( ik > 1 ) THEN

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ISOMIP+/MY_SRC/eosbn2.F90

-                      r14135
+                      r14958
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            !
             zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
 …
       CASE( np_seos )                !==  simplified EOS  ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
             zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
             zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
 …
       CASE( np_leos )                !==  linear ISOMIP EOS  ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
             zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp)
             zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp
 …
             END DO
+            !
             DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+               !
                ! compute density (2*nn_sto_eos) times:
 …
          ! Non-stochastic equation of state
          ELSE
             DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+               !
                zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
 …
       CASE( np_seos )                !==  simplified EOS  ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
             zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
             zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
 …
       CASE( np_leos )                !==  linear ISOMIP EOS  ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
             zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp)
             zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp
 …
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
             zh  = pdep(ji,jj) * r1_Z0                                  ! depth
 …
       CASE( np_seos )                !==  simplified EOS  ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
             zt    = pts  (ji,jj,jp_tem)  - 10._wp
 …
       CASE( np_leos )                !==  ISOMIP EOS  ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
             zt    = pts  (ji,jj,jp_tem)  - (-1._wp)
 …
    SUBROUTINE eos_insitu_pot_2d( pts, prhop )
+      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      !                                                     ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !!
+      CALL eos_insitu_pot_2d_t( pts, is_tile(pts), prhop, is_tile(prhop) )
+   END SUBROUTINE eos_insitu_pot_2d
+   SUBROUTINE eos_insitu_pot_2d_t( pts, ktts, prhop, ktrhop )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE eos_insitu_pot  ***
 …
       !!
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      INTEGER                              , INTENT(in   ) ::   ktts, ktrhop
+      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
       !                                                                ! 2 : salinity               [psu]
       REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      REAL(wp), DIMENSION(A2D_T(ktrhop)   ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !
       INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
 …
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
             DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+               !
                zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
 …
       CASE( np_seos )                !==  simplified EOS  ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             zt  = pts  (ji,jj,jp_tem) - 10._wp
             zs  = pts  (ji,jj,jp_sal) - 35._wp
 …
       CASE( np_leos )                !==  ISOMIP EOS  ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
             zt    = pts  (ji,jj,jp_tem)  - (-1._wp)
 …
       IF( ln_timing )   CALL timing_stop('eos-pot')
+      !
    END SUBROUTINE eos_insitu_pot_2d
+   END SUBROUTINE eos_insitu_pot_2d_t
 …
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            !
             zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth
 …
       CASE( np_seos )                  !==  simplified EOS  ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
             zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
             zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
 …
       CASE( np_leos )                  !==  linear ISOMIP EOS  ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
             zt  = pts (ji,jj,jk,jp_tem) - (-1._wp)
             zs  = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0)
 …
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
             zh  = pdep(ji,jj) * r1_Z0                                  ! depth
 …
       CASE( np_seos )                  !==  simplified EOS  ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
             zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
 …
       CASE( np_leos )                  !==  linear ISOMIP EOS  ==!
+         !
          DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
             zt    = pts  (ji,jj,jp_tem) - (-1._wp)   ! pot. temperature anomaly (t-T0)
 …
       IF( ln_timing )   CALL timing_start('bn2')
+      !
       DO_3D( 1, 1, 1, 1, 2, jpkm1 )      ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )      ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90
          zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   &
             &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )
 …
       CASE( np_leos )                !==  linear ISOMIP EOS  ==!
+         !
          DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
             zt  = pts(ji,jj,jk,jp_tem) - (-1._wp)  ! temperature anomaly (t-T0)
             zs = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ISOMIP+/MY_SRC/istate.F90

r14053	r14958
167	167	!
168	168	!!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
169		DO_3D( ~~1, 1, 1, 1~~, 1, jpkm1 )
	169	DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
170	170	uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
171	171	vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/ISOMIP/EXPREF/namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
 &namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
 !-----------------------------------------------------------------------
+/

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg

-                      r14229
+                      r14958
       !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
    ln_write_cfg = .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/OVERFLOW/EXPREF/AGRIF/1_namelist_cfg

r14568	r14958
38	38	cn_domcfg = "OVF_domcfg" ! domain configuration filename
39	39	!
	40	/
	41	!-----------------------------------------------------------------------
	42	&namtile ! parameters of the tiling
	43	!-----------------------------------------------------------------------
40	44	/
41	45	!-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/OVERFLOW/EXPREF/AGRIF/namelist_cfg

r14568	r14958
32	32	cn_domcfg = "OVF_domcfg" ! domain configuration filename
33	33	!
	34	/
	35	!-----------------------------------------------------------------------
	36	&namtile ! parameters of the tiling
	37	!-----------------------------------------------------------------------
34	38	/
35	39	!-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_flux_ubs_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
 &namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
 !-----------------------------------------------------------------------
+/

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

r14433	r14958
184	184	pe3vw(:,:,jk) = pe3w_1d (jk)
185	185	END DO
186		DO_2D( ~~1, 1, 1, 1~~ )
	186	DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
187	187	ik = k_bot(ji,jj)
188	188	pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/README.rst

-                      r14446
+                      r14958
   a coupled configuration through OASIS. See CPL_OASIS/README.md for more information.
+DIA_GPU
+---------
+| This is a demonstrator of diagnostic DIAHSB ported to GPU using CUDA Fortran.
+  Memory communications between host and device are asynchronous given the device has that capability.
+  This experiment is target for ORCA2_ICE_PISCES
 TSUNAMI
 ---------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/SWG/EXPREF/namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
    ln_read_cfg = .false.   !  (=F) user defined configuration           (F => create/check namusr_def)
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/SWG/MY_SRC/usrdef_hgr.F90

-                      r13752
+                      r14958
       DO jj = 1, jpj
          DO ji = 1, jpi
             zim1 = REAL( ji + nimpp - 1 )   ;   zim05 = REAL( ji + nimpp - 1 ) - 0.5
             zjm1 = REAL( jj + njmpp - 1 )   ;   zjm05 = REAL( jj + njmpp - 1 ) - 0.5
+            zim1 = REAL( ji + nimpp - nn_hls )   ;   zim05 = REAL( ji + nimpp - nn_hls ) - 0.5
+            zjm1 = REAL( jj + njmpp - nn_hls )   ;   zjm05 = REAL( jj + njmpp - nn_hls ) - 0.5
+            !
             !glamt(i,j) position (meters) at T-point

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/TSUNAMI/EXPREF/namelist_cfg

-                      r14433
+                      r14958
    ln_Iperio  =   .true.   ! i-periodicity
    ln_Jperio  =   .true.   ! j-periodicity
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/VORTEX/EXPREF/1_namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
 &namcfg        !   parameters of the configuration                      (default: user defined GYRE)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
 !-----------------------------------------------------------------------
+/

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/VORTEX/EXPREF/namelist_cfg

-                      r14229
+                      r14958
 !-----------------------------------------------------------------------
 &namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
 !-----------------------------------------------------------------------
+/

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/VORTEX/MY_SRC/usrdef_istate.F90

-                      r14433
+                      r14958
+      !
       ! temperature:
       DO_2D( 1, 1, 1, 1 )
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
          zx = glamt(ji,jj) * 1.e3
          zy = gphit(ji,jj) * 1.e3
 …
       ! Sea level:
       za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH)))
       DO_2D( 1, 1, 1, 1 )
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
          zx = glamt(ji,jj) * 1.e3
          zy = gphit(ji,jj) * 1.e3

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/WAD/EXPREF/namelist_cfg

-                      r14229
+                      r14958
       !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
    ln_write_cfg = .true.    !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namtile        !   parameters of the tiling
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

NEMO/branches/2021/dev_r14608_AGRIF_domcfg/tests/demo_cfgs.txt

r14226	r14958
12	12	STATION_ASF OCE ICE
13	13	CPL_OASIS OCE TOP ICE NST
	14	DIA_GPU OCE ICE
14	15	SWG OCE SWE
15	16	C1D_ASICS OCE

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

Legend: