Changeset 8215 for branches/2017/dev_r7881_ENHANCE09_RK3

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

-                      r7646
+                      r8215
 !-----------------------------------------------------------------------
    rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0)
+/
-!-----------------------------------------------------------------------
-&namcrs        !   Grid coarsening for dynamics output and/or
-!              !   passive tracer coarsened online simulations
-!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
 …
    filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri2    =    2.5e-3 !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    0.0e0  !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_loglayer =    .true. !  loglayer bottom friction (only effect when nn_bfr = 2)
+   rn_bfrz0    =    0.003  !  bottom roughness (only effect when ln_loglayer = .true.)
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot
+   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top)
+   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U|
+   ln_loglayer= .true.     !  logarithmic drag: Cd = vkarmn/log(z/z0) |U|
+   !
+   ln_drgimp  = .true.     !  implicit top/bottom friction flag
+/
+!-----------------------------------------------------------------------
+&namdrg_bot        !   BOTTOM friction
+!-----------------------------------------------------------------------
+   rn_Cd0     =  2.5e-3   !  drag coefficient [-]
+   rn_Uc0     =  0.4      !  ref. velocity [m/s] (linear drag=Cd0*Uc0)
+   rn_Cdmax   =  0.1      !  drag value maximum [-] (logarithmic drag)
+   rn_ke0     =  0.0e0    !  background kinetic energy  [m2/s2] (non-linear cases)
+   rn_z0      =  0.003    !  roughness [m]  (ln_loglayer=T)
+   ln_boost   = .false.   !  =T regional boost of Cd0 ; =F constant
+      rn_boost=  50.         !  local boost factor  [-]
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  0      !  diffusive bbl (=1)   or not (=0)
+&nambbl        !   bottom boundary layer scheme                         (default: NO)
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   0.1e-6  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.1e-6  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.   !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .true.       !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+      nn_evdm     =    0         ! apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd      =  100.        ! mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+      nn_npc      =    1         ! frequency of application of npc
+      nn_npcp     =  365         ! npc control print frequency
+   !
+   ln_zdfddm   = .false.   ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       ! coefficients
+   rn_avm0     =   0.1e-6     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.1e-6     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       (ln_zdfric =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   (ln_zdfgls =T)
 !-----------------------------------------------------------------------
    rn_charn =  100000.     !  Charnock constant for wb induced roughness length
 …
+/
 !-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+&namzdf_iwm    !   internal wave-driven mixing parameterization         (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm

r7646	r8215
1		bld::tool::fppkeys ~~key_zdfgls~~ key_diainstant key_mpp_mpi key_iomput
	1	bld::tool::fppkeys key_diainstant key_mpp_mpi key_iomput

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

-                      r7646
+                      r8215
+/
 !-----------------------------------------------------------------------
 &nambfr        !   bottom friction
 !-----------------------------------------------------------------------
    nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_non_lin = .true.     !  non-linear  drag: Cd = Cd0 |U|
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_zdfevd   = .false.        !  enhanced vertical diffusion (evd) (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .true.       !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+      nn_evdm     =    0         ! apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd      =  100.        ! mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+      nn_npc      =    1         ! frequency of application of npc
+      nn_npcp     =  365         ! npc control print frequency
+   !
+   ln_zdfddm   = .false.   ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       (ln_zdfric =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   (ln_zdfgls =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm    !    internal wave-driven mixing parameterization        (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/C1D_PAPA/cpp_C1D_PAPA.fcm

r4667	r8215
1		bld::tool::fppkeys ~~key_c1d key_zdfgls~~
	1	bld::tool::fppkeys key_c1d

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

-                      r7715
+                      r8215
+/
 !-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
+/
 …
+/
 !-----------------------------------------------------------------------
 &nambfr        !   bottom friction
 !-----------------------------------------------------------------------
    nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_non_lin = .true.     !  non-linear  drag: Cd = Cd0 |U|
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .true.       !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .true.       !  enhanced vertical diffusion
+      nn_evdm     =    1         ! apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd      =  100.        ! mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+      nn_npc      =    1         ! frequency of application of npc
+      nn_npcp     =  365         ! npc control print frequency
+   !
+   ln_zdfddm   = .false.   ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       (ln_zdfric =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke")
 !-----------------------------------------------------------------------
    nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
 !-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+&namzdf_gls                !   GLS vertical diffusion                   (ln_zdfgls =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm    !    internal wave-driven mixing parameterization        (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm

r5930	r8215
1		bld::tool::fppkeys ~~key_zdftke~~ key_top key_my_trc key_mpp_mpi key_iomput
	1	bld::tool::fppkeys key_top key_my_trc key_mpp_mpi key_iomput
2	2	inc $BFMDIR/src/nemo/bfm.fcm

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

-                      r7715
+                      r8215
 !!                   ***  Run management namelists  ***
 !!======================================================================
-!!   namrun        parameters of the run
-!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namrun        !   parameters of the run
 …
    nn_write    =      60   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
 !-----------------------------------------------------------------------
 &namcfg     !   parameters of the configuration
 …
 !-----------------------------------------------------------------------
    ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time
+   !
    nn_msh      =    0      !  create (>0) a mesh file or not (=0)
+   !
    rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
-!-----------------------------------------------------------------------
-&namcrs        !   Grid coarsening for dynamics output and/or
-!              !   passive tracer coarsened online simulations
-!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
 …
    ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
 !-----------------------------------------------------------------------
 &namsbc        !   Surface Boundary Condition (surface module)
 …
+/
 !-----------------------------------------------------------------------
-&namsbc_rnf    !   runoffs namelist surface boundary condition
-!-----------------------------------------------------------------------
-   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+/
-!-----------------------------------------------------------------------
-&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namsbc_ssr    !   surface boundary condition : sea surface restoring
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namsbc_alb    !   albedo parameters
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namberg       !   iceberg parameters
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &namlbc        !   lateral momentum boundary condition
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+&namdrg        !   top/bottom friction
+!-----------------------------------------------------------------------
+   ln_non_lin = .true.     !  non-linear  drag: Cd = Cd0 |U|
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         (default: NO)
 !-----------------------------------------------------------------------
+/
 …
    rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .true.       !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .true.       !  Enhanced Vertical Diffusion scheme
+      nn_evdm  =    1            !  evd apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd   =  100.           !  evd mixing coefficient [m2/s]
+   !
+   ln_zdfddm   = .false.   ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       !  Coefficients
+   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+   !
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       (ln_zdfric=T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke=T)
 !-----------------------------------------------------------------------
    nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
 !-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+&namzdf_gls                !   GLS vertical diffusion                   (ln_zdfgls=T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             (ln_zdfddm=T)
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg

-                      r7715
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namtrc_zdf        !   vertical physics
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &namtrc_rad        !  treatment of negative concentrations
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm

r7646	r8215
1		bld::tool::fppkeys ~~key_zdftke key_top key_mpp_mpi~~
	1	bld::tool::fppkeys key_top key_mpp_mpi key_nosignedzero

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg

-                      r7715
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
+/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+!              !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
+/
 …
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+&namdrg        !   bottom friction
+!-----------------------------------------------------------------------
+   ln_lin = .true.         !     linear  drag: Cd = Cd0 Uc0
+/
 !-----------------------------------------------------------------------
 …
 &nambbl        !   bottom boundary layer scheme
 !-----------------------------------------------------------------------
+   ln_trabbl   = .true.    !  Bottom Boundary Layer parameterisation flag
+   nn_bbl_ldf  =  1        !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0        !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.    !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.      !  advective bbl coefficient                 [s]
+/
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      = 8.5e+11     !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .true.       !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .true.       !  Enhanced Vertical Diffusion scheme
+      nn_evdm  =    0            !  evd apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd   =  100.           !  evd mixing coefficient [m2/s]
+   !
+   ln_zdfddm   = .true.    ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .true.       ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+      nn_zdfexp=    3            !  number of sub-timestep for ln_zdfexp=T
+   !
+   !                       !  Coefficients
+   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    1         !  horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm    !    internal wave-driven mixing parameterization        (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+   nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
+   ln_mevar    = .true.    !  variable (T) or constant (F) mixing efficiency
+   ln_tsdiff   = .true.    !  account for differential T/S mixing (T) or not (F)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml

-                      r7828
+                      r8215
      <field field_ref="avt"          name="difvho"   />
      <field field_ref="w_masstr"     name="vovematr" />
           <!-- variables available with key_zdftmx_new -->
+         <!-- variables available with ln_zdfiwm =T -->
           <field field_ref="av_wave"      name="av_wave"    />
           <field field_ref="bn2"          name="bn2"        />
           <field field_ref="bflx_tmx"     name="bflx_tmx"   />
           <field field_ref="pcmap_tmx"    name="pcmap_tmx"  />
           <field field_ref="emix_tmx"     name="emix_tmx"   />
+          <field field_ref="bflx_iwm"     name="bflx_tmx"   />
+          <field field_ref="pcmap_iwm"    name="pcmap_tmx"  />
+          <field field_ref="emix_iwm"     name="emix_tmx"   />
           <field field_ref="av_ratio"     name="av_ratio"   />
    </file>

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg

-                      r7828
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
+/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
+/
 …
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+&namdrg        !   top/bottom friction
+!-----------------------------------------------------------------------
+   ln_lin = .true.         !     linear  drag: Cd = Cd0 Uc0
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbl   = .true.    !  Bottom Boundary Layer parameterisation flag
+   nn_bbl_ldf  =  1        !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0        !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.    !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.      !  advective bbl coefficient                 [s]
+/
 !-----------------------------------------------------------------------
 …
    ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx_new !   internal wave-driven mixing parameterization        ("key_zdftmx_new" & "key_zdfddm")
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .true.       !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .true.       !  Enhanced Vertical Diffusion scheme
+      nn_evdm  =    0            !  evd apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd   =  100.           !  evd mixing coefficient [m2/s]
+   !
+   ln_zdfddm   = .true.    ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       !  Coefficients
+   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    1         !  horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm    !   tidal mixing parameterization                        (ln_zdfiwm =T)
 !-----------------------------------------------------------------------
    nn_zpyc     = 2         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_cfg

-                      r7445
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namtrc_zdf        !   vertical physics
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &namtrc_rad        !  treatment of negative concentrations
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/cpp_ORCA2_LIM3_PISCES.fcm

r7828	r8215
1		bld::tool::fppkeys ~~key_trabbl key_lim3 key_zdftke key_zdfddm key_zdftmx_new key_iomput key_mpp_mpi key_top~~ key_nosignedzero
	1	bld::tool::fppkeys key_lim3 key_top key_iomput key_mpp_mpi key_nosignedzero

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg

-                      r7646
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
+/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
 …
    rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
    ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
-!-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namcrs        !   Grid coarsening for dynamics output and/or
-               !   passive tracer coarsened online simulations
-!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
 …
 &nambbl        !   bottom boundary layer scheme
 !-----------------------------------------------------------------------
+   ln_trabbl   = .true.    !  Bottom Boundary Layer parameterisation flag
+   nn_bbl_ldf  =  1        !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0        !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.    !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.      !  advective bbl coefficient                 [s]
+/
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm

r7646	r8215
1		bld::tool::fppkeys ~~key_trabbl~~ key_top key_iomput key_mpp_mpi
	1	bld::tool::fppkeys key_top key_iomput key_mpp_mpi

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_cfg

-                      r7445
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
+/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
 …
    rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
    ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
-!-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namcrs        !   Grid coarsening for dynamics output and/or
-               !   passive tracer coarsened online simulations
-!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
 …
 &nambbl        !   bottom boundary layer scheme
 !-----------------------------------------------------------------------
+   ln_trabbl   = .true.    !  Bottom Boundary Layer parameterisation flag
+   nn_bbl_ldf  =  1        !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0        !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.    !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.      !  advective bbl coefficient                 [s]
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm

r7485	r8215
1		bld::tool::fppkeys ~~key_trabbl~~ key_top key_iomput key_mpp_mpi
	1	bld::tool::fppkeys key_top key_iomput key_mpp_mpi

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg

-                      r7404
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .true.    !  z-coordinate - partial steps
+/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
+/
 …
+/
 !-----------------------------------------------------------------------
-&nambfr        !   bottom friction
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition                (default: NO)
-!-----------------------------------------------------------------------
-   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
-&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
-!-----------------------------------------------------------------------
+/
-!----------------------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracers
-!----------------------------------------------------------------------------------
-   !                       !  Operator type:
-   ln_traldf_lap   =  .true.   !    laplacian operator
-   ln_traldf_blp   =  .false.  !  bilaplacian operator
-   !                       !  Direction of action:
-   ln_traldf_lev   =  .false.  !  iso-level
-   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
-   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
-   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
-   !                       !  iso-neutral options:
-   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
-   rn_slpmax       =   0.01    !  slope limit                      (both operators)
-   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
-   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
-   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
-   !                       !  Coefficients:
-   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
-   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
-   !                                !   =  0           constant
-   !                                !   = 10 F(k)      =ldf_c1d
-   !                                !   = 20 F(i,j)    =ldf_c2d
-   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
-   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
-   !                                !   = 31 F(i,j,k,t)=F(local velocity)
-   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
-   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
-!----------------------------------------------------------------------------------
-&namtra_ldfeiv !   eddy induced velocity param.
-!----------------------------------------------------------------------------------
-   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
-   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
-   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
-   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
-   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
-   !                                !   =  0           constant
-   !                                !   = 10 F(k)      =ldf_c1d
-   !                                !   = 20 F(i,j)    =ldf_c2d
-   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
-   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
-!-----------------------------------------------------------------------
-&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
-!-----------------------------------------------------------------------
-!-----------------------------------------------------------------------
-&namdyn_adv    !   formulation of the momentum advection
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
-!-----------------------------------------------------------------------
-   ln_dynvor_ene = .false. !  enstrophy conserving scheme
-   ln_dynvor_ens = .false. !  energy conserving scheme
-   ln_dynvor_mix = .false. !  mixed scheme
-   ln_dynvor_een = .true.  !  energy & enstrophy scheme
-      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
-!-----------------------------------------------------------------------
-&namdyn_hpg    !   Hydrostatic pressure gradient option
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namdyn_spg    !   surface pressure gradient
-!-----------------------------------------------------------------------
-   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
-!-----------------------------------------------------------------------
-&namdyn_ldf    !   lateral diffusion on momentum
-!-----------------------------------------------------------------------
-   !                       !  Type of the operator :
-   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F
-   ln_dynldf_lap =  .true.     !    laplacian operator
-   ln_dynldf_blp =  .false.    !  bilaplacian operator
-   !                       !  Direction of action  :
-   ln_dynldf_lev =  .true.     !  iso-level
-   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
-   ln_dynldf_iso =  .false.    !  iso-neutral
-   !                       !  Coefficient
-   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
-   !                                !  =-30  read in eddy_viscosity_3D.nc file
-   !                                !  =-20  read in eddy_viscosity_2D.nc file
-   !                                !  =  0  constant
-   !                                !  = 10  F(k)=c1d
-   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
-   !                                !  = 30  F(i,j,k)=c2d*c1d
-   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
-   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
-   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
-   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
-   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
-!-----------------------------------------------------------------------
-&namzdf        !   vertical physics
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
 …
 !-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namptr       !   Poleward Transport Diagnostic
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namhsb       !  Heat and salt budgets                                  (default F)
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namobs       !  observation usage                                      ('key_diaobs')
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&nam_asminc   !   assimilation increments                               ('key_asminc')
-!-----------------------------------------------------------------------
+/

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm

r7423	r8215
1		bld::tool::fppkeys ~~key_trabbl key_lim3 key_zdftke key_zdfddm key_zdftmx~~ key_iomput key_mpp_mpi
	1	bld::tool::fppkeys key_lim3 key_iomput key_mpp_mpi

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/SHARED/field_def_nemo-opa.xml

-                      r7828
+                      r8215
          <field id="uoce_eiv"     long_name="EIV ocean current along i-axis"   standard_name="bolus_sea_water_x_velocity"   unit="m/s"   grid_ref="grid_U_3D" />
          <!-- uoce_eiv: available with key_trabbl -->
+         <!-- variables available when ln_trabbl = T -->
          <field id="uoce_bbl"     long_name="BBL ocean current along i-axis"    unit="m/s"  />
          <field id="ahu_bbl"      long_name="BBL diffusive flux along i-axis"   unit="m3/s" />
 …
          <field id="voce_eiv"     long_name="EIV ocean current along j-axis"   standard_name="bolus_sea_water_y_velocity"   unit="m/s"   grid_ref="grid_V_3D" />
          <!-- voce_eiv: available with key_trabbl -->
+         <!-- variables available when ln_trabbl = T  -->
          <field id="voce_bbl"     long_name="BBL ocean current along j-axis"    unit="m/s"  />
          <field id="ahv_bbl"      long_name="BBL diffusive flux along j-axis"   unit="m3/s" />
 …
          <field id="avm"          long_name="vertical eddy viscosity"     standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" />
          <!-- avs: available with key_zdfddm -->
+         <!-- avs: if ln_zdfddm=F avs=avt -->
          <field id="avs"          long_name="salt vertical eddy diffusivity"   standard_name="ocean_vertical_salt_diffusivity"   unit="m2/s" />
          <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
 …
          <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"     standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" />
+         <!-- avt_tide: available with key_zdftmx -->
+         <field id="av_tide"      long_name="tidal vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_tides"   unit="m2/s" />
+         <!-- variables available with key_zdftmx_new -->
+         <!-- variables available with ln_zdfiwm =T -->
          <field id="av_ratio"     long_name="S over T diffusivity ratio"            standard_name="salinity_over_temperature_diffusivity_ratio"                     unit="1"    />
          <field id="av_wave"      long_name="wave-induced vertical diffusivity"     standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves"         unit="m2/s" />
          <field id="bflx_tmx"     long_name="wave-induced buoyancy flux"            standard_name="buoyancy_flux_due_to_internal_waves"                             unit="W/kg" />
          <field id="pcmap_tmx"    long_name="power consumed by wave-driven mixing"  standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing"   unit="W/m2"      grid_ref="grid_W_2D" />
          <field id="emix_tmx"     long_name="power density available for mixing"    standard_name="power_available_for_mixing_from_breaking_internal_waves"         unit="W/kg" />
+         <field id="bflx_iwm"     long_name="wave-induced buoyancy flux"            standard_name="buoyancy_flux_due_to_internal_waves"                             unit="W/kg" />
+         <field id="pcmap_iwm"    long_name="power consumed by wave-driven mixing"  standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing"   unit="W/m2"      grid_ref="grid_W_2D" />
+         <field id="emix_iwm"     long_name="power density available for mixing"    standard_name="power_available_for_mixing_from_breaking_internal_waves"         unit="W/kg" />
          <!-- variables available with diaar5 -->

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/SHARED/namelist_ref

-                      r7813
+                      r8215
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !!                            namelist_ref
+!!                            namelist_ref                            !!
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !! NEMO/OPA  :  1 - run manager      (namrun)
 !! namelists    2 - Domain           (namcfg, namzgr, namdom, namtsd, namcrs, namc1d, namc1d_uvd)
+!! namelists    2 - Domain           (namcfg, namdom, namtsd, namcrs, namc1d, namc1d_uvd)
 !!              3 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_sas)
 !!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,
 !!                                    namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave)
 !!              4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              5 - bottom  boundary (namdrg, namdrg_top, namdrg_bot, nambbc, nambbl)
 !!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp)
 !!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
 !!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx, namzdf_tmx_new)
 !!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto)
 !!             10 - miscellaneous    (nammpp, namctl)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_gls, namzdf_iwm)
+!!              9 - miscellaneous    (nammpp, namctl)
+!!             10 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto)
 !!             11 - Obs & Assim      (namobs, nam_asminc)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !!======================================================================
 !!                   ***  Run management namelists  ***
+!!                   ***  Run management namelists  ***               !!
 !!======================================================================
 !!   namrun       parameters of the run
 …
 !!======================================================================
 !!   namcfg       parameters of the configuration
-!!   namzgr       vertical coordinate                                   (default: NO selection)
 !!   namdom       space and time domain (bathymetry, mesh, timestep)
 !!   namwad       Wetting and drying                                    (default F)
 !!   namtsd       data: temperature & salinity
 !!   namcrs       coarsened grid (for outputs and/or TOP)               ("key_crs")
+!!   namcrs       coarsened grid (for outputs and/or TOP)               (ln_crs =T)
 !!   namc1d       1D configuration options                              ("key_c1d")
 !!   namc1d_dyndmp 1D newtonian damping applied on currents             ("key_c1d")
 …
+!
 !-----------------------------------------------------------------------
 &namcfg        !   parameters of the configuration
+&namcfg        !   parameters of the configuration                     !   (default: user defined GYRE)
 !-----------------------------------------------------------------------
    ln_read_cfg = .false.   !  (=T) read the domain configuration file
 …
+/
 !-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
+&namdom        !   time and space domain
 !-----------------------------------------------------------------------
    ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
 …
    rn_isfhmin  =    1.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
    rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdt      = 5760.     !  time step for the dynamics and tracer
    rn_atfp     =    0.1    !  asselin time filter parameter
+   !
    ln_crs      = .false.   !  Logical switch for coarsening module
+   ln_crs      = .false.   !  Logical switch for coarsening module      (T => fill namcrs)
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
 &namcrs        !   coarsened grid (for outputs and/or TOP)              ("key_crs")
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
    nn_factx    = 3         !  Reduction factor of x-direction
 …
    sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''       , ''
    sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''       , ''
+   !
    cn_dir      = './'      !  root directory for the location of the flux files
+/
 !-----------------------------------------------------------------------
 &namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk = T)
+&namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk =T)
 !-----------------------------------------------------------------------
 !              !  file name                   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                              ! rotation ! land/sea mask !
 …
    rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
    rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
+                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
+   ln_Cd_L12   = .false.   !  Modify the drag ice-atm and oce-atm depending on ice concentration
+                           !  This parameterization is from Lupkes et al. (JGR 2012)
+   !                       !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
+   ln_Cd_L12   = .false.   !  air-ice and ocean-ice function of ice concentration (Lupkes et al. JGR 2012)
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
 &namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T)
+&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr =T)
 !-----------------------------------------------------------------------
 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 …
+/
 !-----------------------------------------------------------------------
 &namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T)
+&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf =T)
 !-----------------------------------------------------------------------
 !              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 …
+/
 !-----------------------------------------------------------------------
 &namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T)
+&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr =T)
 !-----------------------------------------------------------------------
 !              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 …
    nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
    nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2)
                            !  or to SSS only (=1) or no damping term (=0)
+   !                       !  or to SSS only (=1) or no damping term (=0)
    rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
    rn_deds     =  -166.67  !  magnitude of the damping on salinity   [mm/day]
 …
 !-----------------------------------------------------------------------
    nn_ice_alb   =    1   !  parameterization of ice/snow albedo
                          !     0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo
                          !     1: "home made" based on Brandt et al. (JClim 2005) and Grenfell & Perovich (JGR 2004),
                          !        giving cloud-sky albedo
+   !                     !     0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo
+   !                     !     1: "home made" based on Brandt et al. (JClim 2005) and Grenfell & Perovich (JGR 2004),
+   !                     !        giving cloud-sky albedo
    rn_alb_sdry  =  0.85  !  dry snow albedo         : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky)
    rn_alb_smlt  =  0.75  !  melting snow albedo     : 0.65 ( '' )          ; 0.75 ( '' )          ; obs 0.72-0.82 ( '' )
 …
+/
 !-----------------------------------------------------------------------
 &namsbc_wave   ! External fields from wave model                        (ln_wave=T)
+&namsbc_wave   ! External fields from wave model                        (ln_wave =T)
 !-----------------------------------------------------------------------
 !              !  file name  ! frequency (hours) ! variable     ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 …
 !!======================================================================
 !!               ***  Lateral boundary condition  ***
+!!               ***  Lateral boundary condition  ***                 !!
 !!======================================================================
 !!   namlbc        lateral momentum boundary condition
 …
 !!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction                                      (default: linear)
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max=    1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   rn_tfri1    =    4.e-4  !  top drag coefficient (linear case)
+   rn_tfri2    =    2.5e-3 !  top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_tfri2_max=    1.e-1  !  max. top drag coefficient (non linear case and ln_loglayer=T)
+   rn_tfeb2    =    0.0    !  top turbulent kinetic energy background  (m2/s2)
+   rn_tfrz0    =    3.e-3  !  top roughness [m] if ln_loglayer=T
+   ln_tfr2d    = .false.   !  horizontal variation of the top friction coef (read a 2D mask file )
+   rn_tfrien   =   50.     !  local multiplying factor of tfr (ln_tfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+   ln_loglayer = .false.   !  logarithmic formulation (non linear case)
+!!                ***  top/Bottom boundary condition  ***             !!
+!!======================================================================
+!!   namdrg        top/bottom drag coefficient                          (default: NONE)
+!!   namdrg_top    top    friction                                      (ln_isfcav=T)
+!!   namdrg_bot    bottom friction
+!!   nambbc        bottom temperature boundary condition                (default: NO)
+!!   nambbl        bottom boundary layer scheme                         (default: NO)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0                  (F => fill namdrg_bot
+   ln_lin     = .false.    !      linear  drag: Cd = Cd0 Uc0                   &   namdrg_top)
+   ln_non_lin = .false.    !  non-linear  drag: Cd = Cd0 |U|
+   ln_loglayer= .false.    !  logarithmic drag: Cd = vkarmn/log(z/z0) |U|
+   !
+   ln_drgimp  = .true.     !  implicit top/bottom friction flag
+/
+!-----------------------------------------------------------------------
+&namdrg_top        !   TOP friction                                     (ln_isfcav=T)
+!-----------------------------------------------------------------------
+   rn_Cd0     =  1.e-3     !  drag coefficient [-]
+   rn_Uc0     =  0.4       !  ref. velocity [m/s] (linear drag=Cd0*Uc0)
+   rn_Cdmax   =  0.1       !  drag value maximum [-] (logarithmic drag)
+   rn_ke0     =  2.5e-3    !  background kinetic energy  [m2/s2] (non-linear cases)
+   rn_z0      =  3.0e-3    !  roughness [m] (ln_loglayer=T)
+   ln_boost   = .false.    !  =T regional boost of Cd0 ; =F constant
+      rn_boost=  50.          !  local boost factor  [-]
+/
+!-----------------------------------------------------------------------
+&namdrg_bot        !   BOTTOM friction
+!-----------------------------------------------------------------------
+   rn_Cd0     =  1.e-3    !  drag coefficient [-]
+   rn_Uc0     =  0.4      !  ref. velocity [m/s] (linear drag=Cd0*Uc0)
+   rn_Cdmax   =  0.1      !  drag value maximum [-] (logarithmic drag)
+   rn_ke0     =  2.5e-3   !  background kinetic energy  [m2/s2] (non-linear cases)
+   rn_z0      =  3.e-3    !  roughness [m] (ln_loglayer=T)
+   ln_boost   = .false.   !  =T regional boost of Cd0 ; =F constant
+      rn_boost=  50.         !  local boost factor  [-]
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbl   = .false.   !  Bottom Boundary Layer parameterisation flag
    nn_bbl_ldf  =  1        !  diffusive bbl (=1)   or not (=0)
    nn_bbl_adv  =  0        !  advective bbl (=1/2) or not (=0)
 …
+!
 !-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
+&nameos        !   ocean Equation Of Seawater                           (default: NO)
 !-----------------------------------------------------------------------
    ln_teos10   = .false.         !  = Use TEOS-10 equation of state
 …
 !-----------------------------------------------------------------------
    ln_ldfeiv     =.false.  ! use eddy induced velocity parameterization
    ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities
    rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
    nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
    !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
    !                                !   =  0           constant
    !                                !   = 10 F(k)      =ldf_c1d
    !                                !   = 20 F(i,j)    =ldf_c2d
    !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
    !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+      rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+      nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+      !                             !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+      !                             !   =  0           constant
+      !                             !   = 10 F(k)      =ldf_c1d
+      !                             !   = 20 F(i,j)    =ldf_c2d
+      !                             !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+      !                             !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+      ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities
+/
 !-----------------------------------------------------------------------
 &namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
 !-----------------------------------------------------------------------
    ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
    nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
                            !                   =1 no damping in the mixing layer (kz  criteria)
                            !                   =2 no damping in the mixed  layer (rho crieria)
    cn_resto    ='resto.nc' !  Name of file containing restoration coeff. field (use dmp_tools to create this)
+/
 !!======================================================================
 !!                      ***  Dynamics namelists  ***
+   ln_tradmp   =  .true.   !  add a damping term
+      nn_zdmp     =    0      !  vertical shape =0    damping throughout the water column
+      !                       !                 =1 no damping in the mixing layer (kz  criteria)
+      !                       !                 =2 no damping in the mixed  layer (rho crieria)
+      cn_resto    ='resto.nc' !  Name of file containing restoration coeff. field (use dmp_tools to create this)
+/
+!!======================================================================
+!!                      ***  Dynamics namelists  ***                  !!
 !!======================================================================
 !!   namdyn_adv    formulation of the momentum advection
 …
    ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
    ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+   ln_dynzad_zts = .false. !  sub-time-stepping for vertical momentum advection
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
 &namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: zps)
+&namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: NO selection)
 !-----------------------------------------------------------------------
    ln_hpg_zco  = .false.   !  z-coordinate - full steps
 …
 !!======================================================================
 !!             Tracers & Dynamics vertical physics namelists
+!!                     vertical physics namelists                     !!
 !!======================================================================
 !!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_gls    GLS vertical mixing                                 ("key_zdfgls")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+      nn_evdm     =    0        ! evd apply on tracer (=0) or on tracer and momentum (=1)
+      rn_avevd    =  100.       !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F)
+      nn_npc      =    1        ! frequency of application of npc
+      nn_npcp     =  365        ! npc control print frequency
+   ln_zdfexp   = .false.   !  time-stepping: split-explicit (T) or implicit (F) time stepping
+      nn_zdfexp   =    3        ! number of sub-timestep for ln_zdfexp=T
+   ln_zdfqiao  = .false.   !  Enhanced wave vertical mixing Qiao (2010) (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!!    namzdf_ric    richardson number vertical mixing                   (ln_zdfric=T)
+!!    namzdf_tke    TKE vertical mixing                                 (ln_zdftke=T)
+!!    namzdf_gls    GLS vertical mixing                                 (ln_zdfgls=T)
+!!    namzdf_iwm    tidal mixing parameterization                       (ln_zdfiwm=T)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+      nn_evdm     =    0         ! apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd      =  100.        ! mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+      nn_npc      =    1         ! frequency of application of npc
+      nn_npcp     =  365         ! npc control print frequency
+   !
+   ln_zdfddm   = .false.   ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       (ln_zdfric =T)
 !-----------------------------------------------------------------------
    rn_avmri    =  100.e-4  !  maximum value of the vertical viscosity
    rn_alp      =    5.     !  coefficient of the parameterization
    nn_ric      =    2      !  coefficient of the parameterization
    rn_ekmfc    =    0.7    !  Factor in the Ekman depth Equation
    rn_mldmin   =    1.0    !  minimum allowable mixed-layer depth estimate (m)
    rn_mldmax   = 1000.0    !  maximum allowable mixed-layer depth estimate (m)
    rn_wtmix    =   10.0    !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
    rn_wvmix    =   10.0    !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
    ln_mldw     =  .true.   !  Flag to use or not the mixed layer depth param.
+/
 !-----------------------------------------------------------------------
 &namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+   ln_mldw     =  .false.  !  enhanced mixing in the Ekman layer
+      rn_ekmfc    =    0.7    !  Factor in the Ekman depth Equation
+      rn_mldmin   =    1.0    !  minimum allowable mixed-layer depth estimate (m)
+      rn_mldmax   = 1000.0    !  maximum allowable mixed-layer depth estimate (m)
+      rn_wtmix    =   10.0    !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
+      rn_wvmix    =   10.0    !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T)
 !-----------------------------------------------------------------------
    rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
 …
    rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
    rn_bshear   =   1.e-20  ! background shear (>0) currently a numerical threshold (do not change it)
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
    nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
                            !                 = 1 bounded by the local vertical scale factor
                            !                 = 2 first vertical derivative of mixing length bounded by 1
                            !                 = 3 as =2 with distinct disspipative an mixing length scale
-   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
    ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
    rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_drg      = .false.   !  top/bottom friction added as boundary condition of TKE
    ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to near intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T)
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!-----------------------------------------------------------------------
+&namzdf_gls    !   GLS vertical diffusion                               ("key_zdfgls")
+      rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to NIWs
+                              !        = 0 none ; = 1 add a tke source below the ML
+                              !        = 2 add a tke source just at the base of the ML
+                              !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T)
+      rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+      nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                              !        = 0  constant 10 m length scale
+                              !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!-----------------------------------------------------------------------
+&namzdf_gls    !   GLS vertical diffusion                               (ln_zdfgls =T)
 !-----------------------------------------------------------------------
    rn_emin       = 1.e-7   !  minimum value of e   [m2/s2]
 …
+/
 !-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency
+   ln_tmx_itf  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx_new !   internal wave-driven mixing parameterization        ("key_zdftmx_new" & "key_zdfddm")
+&namzdf_iwm    !    internal wave-driven mixing parameterization        (ln_zdfiwm =T)
 !-----------------------------------------------------------------------
    nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
 …
 !!                  ***  Miscellaneous namelists  ***
 !!======================================================================
 !!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi")
 !!   namctl            Control prints
 !!   namsto            Stochastic parametrization of EOS
 …
+!
 !-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi")
 !-----------------------------------------------------------------------
    cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
 …
 !-----------------------------------------------------------------------
 &nam_diatmb    !  Top Middle Bottom Output                               (default F)
-!-----------------------------------------------------------------------
-   ln_diatmb   = .false.   !  Choose Top Middle and Bottom output or not
+/
-!-----------------------------------------------------------------------
-&nam_dia25h    !  25h Mean Output                                        (default F)
-!-----------------------------------------------------------------------
-   ln_dia25h   = .false.   ! Choose 25h mean output or not
+/
-!-----------------------------------------------------------------------
-&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
 !-----------------------------------------------------------------------
    ln_diatmb   = .false.   !  Choose Top Middle and Bottom output or not

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/SHARED/namelist_top_ref

-                      r7646
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namtrc_zdf      !   vertical physics
-!-----------------------------------------------------------------------
-   ln_trczdf_exp =  .false.  !  split explicit (T) or implicit (F) time stepping
-   nn_trczdf_exp =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
-!-----------------------------------------------------------------------
 &namtrc_rad      !  treatment of negative concentrations
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg

-                      r7715
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max =   1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   rn_tfri1    =    4.e-4  !  top drag coefficient (linear case)
+   rn_tfri2    =    2.5e-3 !  top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_tfri2_max =   1.e-1  !  max. top drag coefficient (non linear case and ln_loglayer=T)
+   rn_tfeb2    =    0.0    !  top turbulent kinetic energy background  (m2/s2)
+   rn_tfrz0    =    3.e-3  !  top roughness [m] if ln_loglayer=T
+   ln_tfr2d    = .false.   !  horizontal variation of the top friction coef (read a 2D mask file )
+   rn_tfrien   =    50.    !  local multiplying factor of tfr (ln_tfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+   ln_loglayer = .false.   !  logarithmic formulation (non linear case)
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_non_lin = .true.    !  non-linear  drag: Cd = Cd0 |U|
+/
+!-----------------------------------------------------------------------
+&namdrg_top        !   TOP friction                                     (ln_isfcav=T)
+!-----------------------------------------------------------------------
+   rn_Cd0     =  2.5e-3    !  drag coefficient [-]
+   rn_Uc0     =  0.16      !  ref. velocity [m/s] (linear drag=Cd0*Uc0)
+   rn_Cdmax   =  0.1       !  drag value maximum [-] (logarithmic drag)
+   rn_ke0     =  0.0e-0    !  background kinetic energy  [m2/s2] (non-linear cases)
+   rn_z0      =  3.0e-3    !  roughness [m] (ln_loglayer=T)
+   ln_boost   = .false.    !  =T regional boost of Cd0 ; =F constant
+      rn_boost=  50.          !  local boost factor  [-]
+/
+!-----------------------------------------------------------------------
+&namdrg_bot        !   BOTTOM friction
+!-----------------------------------------------------------------------
+   rn_Cd0     =  1.e-3    !  drag coefficient [-]
+   rn_Uc0     =  0.4      !  ref. velocity [m/s] (linear drag=Cd0*Uc0)
+   rn_Cdmax   =  0.1      !  drag value maximum [-] (logarithmic drag)
+   rn_ke0     =  2.5e-3   !  background kinetic energy  [m2/s2] (non-linear cases)
+   rn_z0      =  3.e-3    !  roughness [m] (ln_loglayer=T)
+   ln_boost   = .false.   !  =T regional boost of Cd0 ; =F constant
+      rn_boost=  50.         !  local boost factor  [-]
+/
 !-----------------------------------------------------------------------
 …
    ln_teos10   = .false.         !  = Use TEOS-10 equation of state
    ln_eos80    = .true.          !  = Use EOS80 equation of state
-   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.0e-3  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   5.0e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =   0.1     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F)
+   nn_npc      =    1            !  frequency of application of npc
+   nn_npcp     =  365            !  npc control print frequency
+   ln_zdfexp   = .false.   !  time-stepping: split-explicit (T) or implicit (F) time stepping
+   nn_zdfexp   =    3            !  number of sub-timestep for ln_zdfexp=T
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .true.       !  enhanced vertical diffusion
+      nn_evdm     =    1         ! apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd      =   0.1        ! mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+      nn_npc      =    1         ! frequency of application of npc
+      nn_npcp     =  365         ! npc control print frequency
+   !
+   ln_zdfddm   = .false.   ! double diffusive mixing
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-3     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   5.e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
-&namflo       !   float parameters                                      ("key_float")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namptr       !   Poleward Transport Diagnostic
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &namhsb       !  Heat and salt budgets
 !-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+&namobs       !  observation usage switch                               (ln_diaobs =T)
 !-----------------------------------------------------------------------
+/

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/cpp_ISOMIP.fcm

r7715	r8215
1		bld::tool::fppkeys ~~key_zdfcst~~ key_iomput key_mpp_mpi key_nosignedzero
	1	bld::tool::fppkeys key_iomput key_mpp_mpi key_nosignedzero

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_cen2_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_ubs_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_eenH_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_een_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ene_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ens_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_cen2_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_ubs_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_eenH_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_een_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ene_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ens_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_cfg

-                      r7623
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/cpp_LOCK_EXCHANGE.fcm

r7423	r8215
1		bld::tool::fppkeys ~~key_zdfcst~~ key_iomput key_mpp_mpi key_nosignedzero
	1	bld::tool::fppkeys key_iomput key_mpp_mpi key_nosignedzero

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_cfg

-                      r7624
+                      r8215
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .true.          !  = Use EOS80 equation of state
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
    rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.         !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_sco_FCT2_flux_ubs_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition                (default: NO)
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .true.          !  = Use EOS80 equation of state
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
    rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .true.       !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.   ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT2_flux_ubs_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition                (default: NO)
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .true.          !  = Use EOS80 equation of state
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
    rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_flux_ubs_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition                (default: NO)
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .true.          !  = Use EOS80 equation of state
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
    rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_vect_een_cfg

-                      r7640
+                      r8215
+/
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition                (default: NO)
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .true.          !  = Use EOS80 equation of state
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
    !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
    rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
 …
    rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .false.      !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .false.      !  enhanced vertical diffusion
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+   !
+   !                       ! time-stepping
+   ln_zdfexp   = .false.      ! split-explicit (T) or implicit (F) scheme
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.e-4      !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   0.e0       !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/cpp_OVERFLOW.fcm

r7423	r8215
1		bld::tool::fppkeys ~~key_zdfcst~~ key_mpp_mpi key_iomput key_nosignedzero
	1	bld::tool::fppkeys key_mpp_mpi key_iomput key_nosignedzero

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_cfg

-                      r7821
+                      r8215
+/
 !-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
+/
 …
 &namtra_ldfeiv !   eddy induced velocity param.
 !----------------------------------------------------------------------------------
-   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
-   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
-   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
-   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
-   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
-   !                                !   =  0           constant
-   !                                !   = 10 F(k)      =ldf_c1d
-   !                                !   = 20 F(i,j)    =ldf_c2d
-   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
-   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
-&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg

-                      r7822
+                      r8215
+/
 !-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
+/
 …
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_NONE    = .false.    !  free-slip       : Cd = 0
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .true.       !  constant mixing
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm    !   tidal mixing parameterization                        (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi")
 !-----------------------------------------------------------------------
+/

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg

-                      r7609
+                      r8215
+/
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zps      = .false.   !  z-coordinate - partial steps
-   ln_sco      = .true.    !  s-coordinate
+/
-!-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              (ln_crs =T)
 !-----------------------------------------------------------------------
+/
 …
    nn_fsbc     = 1         !  frequency of surface boundary condition computation
    !                       !     (also = the frequency of sea-ice model call)
    ln_usr      = .true.    !  analytical formulation                    (T => fill namsbc_ana )
    ln_blk      = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)
+   ln_usr      = .true.    !  analytical formulation                    (T => check usrdef_sbc)
+   ln_blk      = .false.   !  CORE bulk formulation                     (T => fill namsbc_blk )
    nn_ice      = 0         !  =0 no ice boundary condition   ,
    ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
    ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf )
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr )
    nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+/
-!-----------------------------------------------------------------------
-&namsbc_ana    !   analytical surface boundary condition
-!-----------------------------------------------------------------------
-   nn_tau000   =   100     !  gently increase the stress over the first ntau_rst time-steps
-   rn_utau0    =   0.0e0   !  uniform value for the i-stress
+/
-!-----------------------------------------------------------------------
-&namsbc_flx    !   surface boundary condition : flux formulation
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namsbc_core   !   namsbc_core  CORE bulk formulae
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
-!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+   !rn_bfri2    =    1.e-5  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   !rn_bfri2_max =   1.e-4  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfri2    =    1.e-5  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max =   1.e-4  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   !rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   !rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   ln_loglayer = .true.    !  logarithmic formulation (non linear case)
+&namdrg            !   top/bottom drag coefficient                      (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_loglayer= .false.    !  logarithmic drag: Cd = vkarmn/log(z/z0) |U|
+/
+!-----------------------------------------------------------------------
+&namdrg_bot        !   BOTTOM friction
+!-----------------------------------------------------------------------
+   rn_Cd0     =  1.e-4    !  drag coefficient [-]
+   rn_Uc0     =  0.1      !  ref. velocity [m/s] (linear drag=Cd0*Uc0)
+   rn_Cdmax   =  1.e-4    !  drag value maximum [-] (logarithmic drag)
+   rn_ke0     =  2.5e-3   !  background kinetic energy  [m2/s2] (non-linear cases)
+   rn_z0      =  3.e-3    !  roughness [m] (ln_loglayer=T)
+   ln_boost   = .false.   !  =T regional boost of Cd0 ; =F constant
+      rn_boost=  50.         !  local boost factor  [-]
+/
 !-----------------------------------------------------------------------
 …
    rn_bhm_0      =      0.     !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!!======================================================================
+!!                     vertical physics namelists                     !!
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number vertical mixing                   (ln_zdfric=T)
+!!    namzdf_tke    TKE vertical mixing                                 (ln_zdftke=T)
+!!    namzdf_gls    GLS vertical mixing                                 (ln_zdfgls=T)
+!!    namzdf_iwm    tidal mixing parameterization                       (ln_zdfiwm=T)
+!!======================================================================
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics                                     (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       ! type of vertical closure
+   ln_zdfcst   = .false.      !  constant mixing
+   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric)
+   ln_zdftke   = .true.       !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke)
+   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls)
+   !
+   !                       ! convection
+   ln_zdfevd   = .true.       !  enhanced vertical diffusion
+      nn_evdm     =    1         ! apply on tracer (=0) or on tracer and momentum (=1)
+      rn_evd      =  100.        ! mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.      !  Non-Penetrative Convective algorithm
+      nn_npc      =    1         ! frequency of application of npc
+      nn_npcp     =  365         ! npc control print frequency
+   !
+   ln_zdfddm   = .false.   ! double diffusive mixing
+      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity)
+      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio
+   !
+   !                       ! gravity wave-driven vertical mixing
+   ln_zdfiwm   = .false.      ! internal wave-induced mixing            (T =>   fill namzdf_iwm)
+   ln_zdfswm   = .false.      ! surface  wave-induced mixing            (T => ln_wave=ln_sdw=T )
+   !
+   !                       ! coefficients
+   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F)
+   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F)
+   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0         !  horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T)
 !-----------------------------------------------------------------------
    nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
 !-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 …
 !!gm
 !-----------------------------------------------------------------------
-&namflo       !   float parameters                                      ("key_float")
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
-&namptr       !   Poleward Transport Diagnostic
-!-----------------------------------------------------------------------
+/
-!-----------------------------------------------------------------------
 &namhsb       !  Heat and salt budgets
 !-----------------------------------------------------------------------
 …
+/
 !-----------------------------------------------------------------------
 &namobs       !  observation usage switch                               ('key_diaobs')
+&namobs       !  observation usage switch
 !-----------------------------------------------------------------------
+/

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/WAD/cpp_WAD.fcm

r7645	r8215
1		bld::tool::fppkeys ~~key_zdftke~~ key_iomput key_mpp_mpi key_nosignedzero
	1	bld::tool::fppkeys key_iomput key_mpp_mpi key_nosignedzero

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/cfg.txt

r7715	r8215
7	7	ORCA2_OFF_TRC OPA_SRC OFF_SRC TOP_SRC
8	8	ORCA2_LIM3_PISCES OPA_SRC LIM_SRC_3 TOP_SRC NST_SRC
	9	GYRE_PISCES_XIOS OPA_SRC TOP_SRC

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90

-                      r7646
+                      r8215
    PUBLIC agrif_ice_alloc ! routine called by nemo_init in nemogcm.F90
    INTEGER, PUBLIC :: u_ice_id, v_ice_id, adv_ice_id
    REAL(wp), PUBLIC :: lim_nbstep = 0.    ! child time position in sea-ice model
+   INTEGER , PUBLIC ::   u_ice_id, v_ice_id, adv_ice_id
+   REAL(wp), PUBLIC ::   lim_nbstep = 0.    ! child time position in sea-ice model
 #if defined key_lim2_vp
    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)     :: u_ice_nst, v_ice_nst
 #else
    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: u_ice_oe, u_ice_sn     !: boundaries arrays
    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:  "          "
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:     -        -
 #endif
    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:  "          "
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:     -        -
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.3.4 , NEMO Consortium (2012)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 …
 #if ! defined key_lim2_vp
       u_ice_oe(:,:,:) =  0.e0
       v_ice_oe(:,:,:) =  0.e0
       u_ice_sn(:,:,:) =  0.e0
       v_ice_sn(:,:,:) =  0.e0
+      u_ice_oe(:,:,:) =  0._wp
+      v_ice_oe(:,:,:) =  0._wp
+      u_ice_sn(:,:,:) =  0._wp
+      v_ice_sn(:,:,:) =  0._wp
 #endif
       adv_ice_oe (:,:,:,:) = 0.e0
       adv_ice_sn (:,:,:,:) = 0.e0
+      adv_ice_oe (:,:,:,:) = 0._wp
+      adv_ice_sn (:,:,:,:) = 0._wp
+      !
    END FUNCTION agrif_ice_alloc
 …
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.6 , NEMO Consortium (2016)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90

-                      r7761
+                      r8215
    PRIVATE
    PUBLIC agrif_interp_lim3
+   PUBLIC   agrif_interp_lim3   ! called by ???
    !!----------------------------------------------------------------------
 …
       !!  computing factor for time interpolation
       !!-----------------------------------------------------------------------
       CHARACTER(len=1), INTENT( in )           :: cd_type
       INTEGER         , INTENT( in ), OPTIONAL :: kiter, kitermax
       !!
       REAL(wp) :: zbeta
+      CHARACTER(len=1), INTENT(in   )           ::   cd_type
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kiter, kitermax
+      !!
+      REAL(wp) ::   zbeta   ! local scalar
       !!-----------------------------------------------------------------------
+      !
       IF( Agrif_Root() )  RETURN
+      !
       SELECT CASE(cd_type)
+      SELECT CASE( cd_type )
       CASE('U','V')
          IF( PRESENT( kiter ) ) THEN  ! interpolation at the child sub-time step (only for ice rheology)
 …
       END SELECT
+      !
       Agrif_SpecialValue=-9999.
+      Agrif_SpecialValue    = -9999.
       Agrif_UseSpecialValue = .TRUE.
+      SELECT CASE(cd_type)
+      CASE('U')
+         CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta )
+      CASE('V')
+         CALL Agrif_Bc_variable( v_ice_id  , procname=interp_v_ice  , calledweight=zbeta )
+      CASE('T')
+         CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta )
+      SELECT CASE( cd_type )
+      CASE('U')   ;   CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta )
+      CASE('V')   ;   CALL Agrif_Bc_variable( v_ice_id  , procname=interp_v_ice  , calledweight=zbeta )
+      CASE('T')   ;   CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta )
       END SELECT
       Agrif_SpecialValue=0.
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .FALSE.
+      !
    END SUBROUTINE agrif_interp_lim3
+   !!------------------
+   !! Local subroutines
+   !!------------------
    SUBROUTINE interp_u_ice( ptab, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
 …
       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------
       INTEGER , INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
       LOGICAL , INTENT(in) :: before
       !!
       REAL(wp) :: zrhoy
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !!
+      REAL(wp) ::   zrhoy   ! local scalar
       !!-----------------------------------------------------------------------
+      !
 …
       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------
       INTEGER , INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
       LOGICAL , INTENT(in) :: before
       !!
       REAL(wp) :: zrhox
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      !!
+      REAL(wp) ::   zrhox   ! local scalar
       !!-----------------------------------------------------------------------
+      !
 …
       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2
+      LOGICAL , INTENT(in) :: before
+      INTEGER , INTENT(in) :: nb, ndir
+      !!
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztab
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      LOGICAL                               , INTENT(in   ) ::   before
+      INTEGER                               , INTENT(in   ) ::   nb, ndir
+      !!
       INTEGER  ::   ji, jj, jk, jl, jm
       INTEGER  ::   imin, imax, jmin, jmax
+      LOGICAL  ::   western_side, eastern_side, northern_side, southern_side
       REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7
+      LOGICAL  ::   western_side, eastern_side, northern_side, southern_side
+      !!-----------------------------------------------------------------------
+      ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztab
+      !!-----------------------------------------------------------------------
+      ! tracers are not multiplied by grid cell here => before: * e1e2t ; after: * r1_e1e2t / rhox / rhoy
       ! and it is ok since we conserve tracers (same as in the ocean).
       ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) )
 …
          jm = 1
          DO jl = 1, jpl
             ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl)   ;   jm = jm + 1
             DO jk = 1, nlay_s
                ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
+               ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
+            END DO
             DO jk = 1, nlay_i
                ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
          ENDDO
+               ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
+            END DO
+         END DO
          DO jk = k1, k2
             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = -9999.
          ENDDO
+            WHERE( tmask(i1:i2,j1:j2,1) == 0._wp )   ptab(i1:i2,j1:j2,jk) = -9999.
+         END DO
       ELSE               ! child grid
 …
          jm = 1
          DO jl = 1, jpl
             a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
             DO jk = 1, nlay_s
                e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             ENDDO
+               e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            END DO
             DO jk = 1, nlay_i
                e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             ENDDO
          ENDDO
+               e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            END DO
+         END DO
 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points
 …
          et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
          et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
+         !
       ENDIF
 …
 #else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                             no sea-ice
+   !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE agrif_lim3_interp_empty
-      !!---------------------------------------------
-      !!   *** ROUTINE agrif_lim3_interp_empty ***
-      !!---------------------------------------------
       WRITE(*,*)  'agrif_lim3_interp : You should not have seen this print! error?'
    END SUBROUTINE agrif_lim3_interp_empty
 #endif
+   !!======================================================================
 END MODULE agrif_lim3_interp

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90

-                      r7761
+                      r8215
    PRIVATE
    PUBLIC agrif_update_lim3
+   PUBLIC   agrif_update_lim3   ! called by ????
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.6 , LOCEAN-IPSL (2016)
+   !! NEMO/NST 4.0 , LOCEAN-IPSL (2017)
    !! $Id: agrif_lim3_update.F90 6204 2016-01-04 13:47:06Z cetlod $
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 …
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) :: kt
-      !!
       !!----------------------------------------------------------------------
+      !
 …
                                                                                                                            ! i.e. update only at the parent time step
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = -9999.
+      Agrif_SpecialValueFineGrid    = -9999.
 # if defined TWO_WAY
       IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps
 …
-   !!------------------
-   !! Local subroutines
-   !!------------------
    SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )
       !!-----------------------------------------------------------------------
 …
       !!              the properties per mass on the coarse grid
       !!-----------------------------------------------------------------------
       INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
       LOGICAL , INTENT(in) :: before
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                               , INTENT(in   ) ::   before
       !!
       INTEGER  :: jk, jl, jm
 …
          jm = 1
          DO jl = 1, jpl
             ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1
             ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl)   ;   jm = jm + 1
+            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl)   ;   jm = jm + 1
             DO jk = 1, nlay_s
                ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
+               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
+            END DO
             DO jk = 1, nlay_i
                ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
          ENDDO
+               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
+            END DO
+         END DO
          DO jk = k1, k2
             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999.
          ENDDO
+         END DO
+         !
       ELSE
          jm = 1
          DO jl = 1, jpl
             a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
             DO jk = 1, nlay_s
                e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
             ENDDO
             DO jk = 1, nlay_i
                e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
             ENDDO
          ENDDO
+               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
+            END DO
+         END DO
          ! integrated values
 …
       !! ** Method  : Update the fluxes and recover the properties (C-grid)
       !!-----------------------------------------------------------------------
       INTEGER , INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
       LOGICAL , INTENT(in) :: before
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
       !!
       REAL(wp) :: zrhoy
+      REAL(wp) ::   zrhoy   ! local scalar
       !!-----------------------------------------------------------------------
+      !
 …
          zrhoy = Agrif_Rhoy()
          ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999.
       ELSE
          u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
 …
       !! ** Method  : Update the fluxes and recover the properties (C-grid)
       !!-----------------------------------------------------------------------
       INTEGER , INTENT(in) :: i1,i2,j1,j2
       REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: ptab
       LOGICAL , INTENT(in) :: before
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
       !!
       REAL(wp) :: zrhox
+      REAL(wp) ::   zrhox   ! local scalar
       !!-----------------------------------------------------------------------
+      !
 …
          zrhox = Agrif_Rhox()
          ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( vmask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999.
       ELSE
          v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
 …
 #else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                             no sea-ice
+   !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE agrif_lim3_update_empty
-      !!---------------------------------------------
-      !!   *** ROUTINE agrif_lim3_update_empty ***
-      !!---------------------------------------------
       WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?'
    END SUBROUTINE agrif_lim3_update_empty
 #endif
+   !!======================================================================
 END MODULE agrif_lim3_update

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

-                      r5656
+                      r8215
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities
+   ! Barotropic arrays used to store open boundary data during
+   ! time-splitting loop:
+!!gm   add PUBLIC in all variable below:  should we need to add it
+   ! Barotropic arrays used to store open boundary data during time-splitting loop:
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
 …
    INTEGER :: umsk_id, vmsk_id
    INTEGER :: kindic_agr
+!!gm end possible public addition
    !!----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

-                      r7646
+                      r8215
    USE oce
    USE dom_oce
    USE zdf_oce
+   USE zdf_oce          ! vertical physics
    USE agrif_oce
    USE phycst
 …
    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
    PUBLIC   interpun, interpvn
    PUBLIC   interptsn,  interpsshn
    PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
+   PUBLIC   interpun , interpvn
+   PUBLIC   interptsn, interpsshn
+   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b
    PUBLIC   interpe3t, interpumsk, interpvmsk
-# if defined key_zdftke
    PUBLIC   Agrif_tke, interpavm
-# endif
    INTEGER ::   bdy_tinterp = 0
 …
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
       !!                  ***  ROUTINE Agrif_dyn_ts  ***
       !!----------------------------------------------------------------------
-      !!
       INTEGER, INTENT(in) ::   jn
       !!
 …
       !!                  ***  ROUTINE Agrif_dta_ts  ***
       !!----------------------------------------------------------------------
-      !!
       INTEGER, INTENT(in) ::   kt
       !!
 …
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt
-      !!
       !!----------------------------------------------------------------------
+      !
 …
       !!----------------------------------------------------------------------
+      !
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
          DO jj = 1, jpj
             ssha_e(2,jj) = hbdy_w(jj)
 …
       ENDIF
+      !
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
          DO jj = 1, jpj
             ssha_e(nlci-1,jj) = hbdy_e(jj)
 …
       ENDIF
+      !
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
          DO ji = 1, jpi
             ssha_e(ji,2) = hbdy_s(ji)
 …
    END SUBROUTINE Agrif_ssh_ts
-# if defined key_zdftke
    SUBROUTINE Agrif_tke
 …
       IF( zalpha > 1. )   zalpha = 1.
+      !
       Agrif_SpecialValue    = 0.e0
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
+      !
       CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)
+      CALL Agrif_Bc_variable( avm_id , calledweight=zalpha, procname=interpavm )
+      !
       Agrif_UseSpecialValue = .FALSE.
+      !
    END SUBROUTINE Agrif_tke
+# endif
    SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
       !!----------------------------------------------------------------------
       !!   *** ROUTINE interptsn ***
+      !!                  *** ROUTINE interptsn ***
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab
 …
       INTEGER                                     , INTENT(in   ) ::   nb , ndir
+      !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::   imin, imax, jmin, jmax
       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER ::   imin, imax, jmin, jmax
+      REAL(wp)::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp)::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------
+      !
 …
    SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before )
       !!----------------------------------------------------------------------
       !!   *** ROUTINE interpun ***
+      !!                         *** ROUTINE interpun ***
       !!----------------------------------------------------------------------
       INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
 …
       LOGICAL                               , INTENT(in   ) ::   before
+      !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zrhoy
+      INTEGER ::   ji, jj, jk
+      REAL(wp)::   zrhoy
       !!----------------------------------------------------------------------
+      !
 …
    SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before )
       !!----------------------------------------------------------------------
       !!   *** ROUTINE interpvn ***
+      !!                      *** ROUTINE interpvn ***
       !!----------------------------------------------------------------------
       INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
 …
       LOGICAL                               , INTENT(in   ) ::   before
+      !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zrhox
+      INTEGER ::   ji, jj, jk
+      REAL(wp)::   zrhox
       !!----------------------------------------------------------------------
+      !
 …
       INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
       INTEGER  ::   ji, jj
       REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff
       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      INTEGER ::   ji, jj
+      REAL(wp)::   zrhoy, zrhot, zt0, zt1, ztcoeff
+      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------
+      !
 …
       INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
       INTEGER  ::   ji,jj
       REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff
       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      INTEGER ::   ji,jj
+      REAL(wp)::   zrhox, zrhot, zt0, zt1, ztcoeff
+      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------
+      !
 …
          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
          IF( bdy_tinterp == 1 ) THEN
             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
                &               - zt0**2._wp * (       zt0 - 1._wp)        )
+            ztcoeff = zrhot * (  zt1**2._wp * ( zt1 - 1._wp)        &
+               &               - zt0**2._wp * ( zt0 - 1._wp)        )
          ELSEIF( bdy_tinterp == 2 ) THEN
             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
                &               - zt0        * (       zt0 - 1._wp)**2._wp )
+            ztcoeff = zrhot * (  zt1        * ( zt1 - 1._wp)**2._wp &
+               &               - zt0        * ( zt0 - 1._wp)**2._wp )
          ELSE
             ztcoeff = 1
 …
                      &                                  * vmask(i1:i2,j1,1)
             ENDIF
+!!gm better coding
+!            IF( western_side  )   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1)
+!            IF( eastern_side  )   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1)
+!            IF( southern_side )   vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1)
+!            IF( northern_side )   vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1)
+!!gm end
          ENDIF
       ENDIF
 …
       INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
       INTEGER  ::   ji,jj
       REAL(wp) ::   zrhot, zt0, zt1,zat
       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      INTEGER ::   ji,jj
+      REAL(wp)::   zrhot, zt0, zt1,zat
+      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------
       IF( before ) THEN
 …
             &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )
+         !
          IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)
          IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)
          IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)
          IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)
+         IF( western_side  )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)
+         IF( eastern_side  )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)
+         IF( southern_side )   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)
+         IF( northern_side )   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)
       ENDIF
+      !
 …
       INTEGER                              , INTENT(in   ) :: nb , ndir
+      !
       INTEGER :: ji, jj, jk
       LOGICAL :: western_side, eastern_side, northern_side, southern_side
       REAL(wp) :: ztmpmsk
+      INTEGER ::   ji, jj, jk
+      LOGICAL ::   western_side, eastern_side, northern_side, southern_side
+      REAL(wp)::   ztmpmsk
       !!----------------------------------------------------------------------
+      !
 …
                DO ji = i1, i2
                   ! Get velocity mask at boundary edge points:
                   IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1)
                   IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1)
                   IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1)
                   IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1)
+                  IF( western_side  )   ztmpmsk = umask(ji    ,jj    ,1)
+                  IF( eastern_side  )   ztmpmsk = umask(nlci-2,jj    ,1)
+                  IF( northern_side )   ztmpmsk = vmask(ji    ,nlcj-2,1)
+                  IF( southern_side )   ztmpmsk = vmask(ji    ,2     ,1)
+                  !
                   IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN
 …
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
       LOGICAL                              , INTENT(in   ) ::   before
       INTEGER                              , INTENT(in   ) :: nb , ndir
+      INTEGER                              , INTENT(in   ) ::   nb , ndir
+      !
       INTEGER ::   ji, jj, jk
 …
    END SUBROUTINE interpvmsk
-# if defined key_zdftke
    SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before )
 …
          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
       ENDIF
+!!gm better coding ???
+!      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+!      ELSE                ;   avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
+!      ENDIF
+!!gm
+      !
    END SUBROUTINE interpavm
-# endif /* key_zdftke */
 #else

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

-                      r7646
+                      r8215
 MODULE agrif_opa_sponge
    !!======================================================================
    !!                ***  MODULE agrif_opa_update  ***
    !! AGRIF :
+   !!                   ***  MODULE  agrif_opa_interp  ***
+   !! AGRIF: interpolation package
    !!======================================================================
+   !! History :
+   !! History :  2.0  !  2002-06  (XXX)  Original cade
+   !!             -   !  2005-11  (XXX)
+   !!            3.2  !  2009-04  (R. Benshila)
+   !!            3.6  !  2014-09  (R. Benshila)
    !!----------------------------------------------------------------------
 #if defined key_agrif
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!----------------------------------------------------------------------
    USE par_oce
    USE oce
    USE dom_oce
+   !
    USE in_out_manager
    USE agrif_oce
 …
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
    SUBROUTINE Agrif_Sponge_Tra
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_Tra ***
       !!---------------------------------------------
       REAL(wp) :: timecoeff
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_Sponge_Tra ***
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   timecoeff   ! local scalar
+      !!----------------------------------------------------------------------
+      !
 #if defined SPONGE
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+      !
       CALL Agrif_Sponge
       Agrif_SpecialValue=0.
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
       tabspongedone_tsn = .FALSE.
+      tabspongedone_tsn     = .FALSE.
+      !
       CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+      !
       Agrif_UseSpecialValue = .FALSE.
 #endif
 …
    SUBROUTINE Agrif_Sponge_dyn
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_dyn ***
       !!---------------------------------------------
       REAL(wp) :: timecoeff
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_Sponge_dyn ***
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   timecoeff   ! local scalar
+      !!----------------------------------------------------------------------
+      !
 #if defined SPONGE
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
       Agrif_SpecialValue=0.
+      !
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = ln_spc_dyn
+      !
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.
       CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
+      !
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.
       CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
+      !
       Agrif_UseSpecialValue = .FALSE.
 #endif
 …
    SUBROUTINE Agrif_Sponge
       !!---------------------------------------------
       !!   *** ROUTINE  Agrif_Sponge ***
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE  Agrif_Sponge ***
+      !!----------------------------------------------------------------------
       INTEGER  :: ji,jj,jk
       INTEGER  :: ispongearea, ilci, ilcj
 …
       REAL(wp) :: z1spongearea, zramp
       REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp
+      !!----------------------------------------------------------------------
+      !
 #if defined SPONGE || defined SPONGE_TOP
       ll_spdone=.TRUE.
 …
                fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj)
                fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) &
                                                      &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
             END DO
          END DO
+                  &                                     +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
+            END DO
+         END DO
+         !
          CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( fsahm_spf, 'F', 1. )
 …
    SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
       !!---------------------------------------------
       !!   *** ROUTINE interptsn_sponge ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
+   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE interptsn_sponge ***
+      !!----------------------------------------------------------------------
+      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres
+      LOGICAL                                     , INTENT(in   ) ::   before
+      !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
 …
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
+      !!----------------------------------------------------------------------
+      !
       IF( before ) THEN
 …
                         zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                         ! horizontal diffusive trends
                         ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  )
+                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
                         ! add it to the general tracer trends
                         tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
 …
    SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before)
       !!---------------------------------------------
       !!   *** ROUTINE interpun_sponge ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
+   SUBROUTINE interpun_sponge( tabres, i1, i2, j1, j2, k1, k2, before )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE interpun_sponge ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   tabres
+      LOGICAL                               , INTENT(in   ) ::   before
+      !!
       INTEGER :: ji,jj,jk
+      ! sponge parameters
+      INTEGER :: jmax
       REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: jmax
+      !!---------------------------------------------
+      !!----------------------------------------------------------------------
+      !
       IF( before ) THEN
          tabres = un(i1:i2,j1:j2,:)
       ELSE
          ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:)
+         ubdiff(i1:i2,j1:j2,:) = ( ub(i1:i2,j1:j2,:) - tabres(:,:,:) )*umask(i1:i2,j1:j2,:)
+         !
          DO jk = 1, jpkm1                                 ! Horizontal slab
 …
                DO ji = i1,i2   ! vector opt.
                   zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) &
+                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) &
+                                    & ) * fmask(ji,jj,jk) * zbtr
+                  rotdiff(ji,jj,jk) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1,jk)   &
+                                    &   +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) ) * fmask(ji,jj,jk) * zbtr
                END DO
             END DO
 …
                      ze1v = hdivdiff(ji,jj,jk)
                      ! horizontal diffusive trends
                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   &
                            + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj)
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj)
                      ! add it to the general momentum trends
 …
                      ! horizontal diffusive trends
                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   &
                            + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj)
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj)
                      ! add it to the general momentum trends
 …
+   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn_sponge ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: imax
+      !!---------------------------------------------
+   SUBROUTINE interpvn_sponge( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE interpvn_sponge ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   tabres
+      LOGICAL                               , INTENT(in   ) ::   before
+      INTEGER                               , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER ::   ji, jj, jk
+      INTEGER ::   imax
+      REAL(wp)::   ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) ::   vbdiff, rotdiff, hdivdiff
+      !!----------------------------------------------------------------------
       IF( before ) THEN
 …
       ELSE
+         !
          vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:)
+         vbdiff(i1:i2,j1:j2,:) = ( vb(i1:i2,j1:j2,:) - tabres(:,:,:) ) * vmask(i1:i2,j1:j2,:)
+         !
          DO jk = 1, jpkm1                                 ! Horizontal slab
 …
+         !
          imax = i2-1
+         imax = i2 - 1
          IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3)
 …
 #else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                          no AGRIF zoom
+   !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE agrif_opa_sponge_empty
       !!---------------------------------------------
       !!   *** ROUTINE agrif_OPA_sponge_empty ***
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_OPA_sponge_empty ***
+      !!----------------------------------------------------------------------
       WRITE(*,*)  'agrif_opa_sponge : You should not have seen this print! error?'
    END SUBROUTINE agrif_opa_sponge_empty

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

-                      r7646
+                      r8215
 MODULE agrif_opa_update
+   !!======================================================================
+   !!                   ***  MODULE  agrif_opa_interp  ***
+   !! AGRIF: interpolation package
+   !!======================================================================
+   !! History :  2.0  !  2002-06  (XXX)  Original cade
+   !!             -   !  2005-11  (XXX)
+   !!            3.2  !  2009-04  (R. Benshila)
+   !!            3.6  !  2014-09  (R. Benshila)
+   !!----------------------------------------------------------------------
 #if defined key_agrif
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!----------------------------------------------------------------------
    USE par_oce
    USE oce
    USE dom_oce
+   USE zdf_oce        ! vertical physics: ocean variables
    USE agrif_oce
+   USE in_out_manager  ! I/O manager
+   !
+   USE in_out_manager ! I/O manager
    USE lib_mpp
    USE wrk_nemo
-   USE zdf_oce        ! vertical physics: ocean variables
    IMPLICIT NONE
    PRIVATE
+   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales
+# if defined key_zdftke
+   PUBLIC Agrif_Update_Tke
+# endif
+   PUBLIC   Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales
+   PUBLIC   Agrif_Update_Tke
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
    RECURSIVE SUBROUTINE Agrif_Update_Tra( )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Tra ***
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Update_Tra ***
+      !!----------------------------------------------------------------------
+      !
       IF (Agrif_Root()) RETURN
 …
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
+      Agrif_SpecialValueFineGrid    = 0._wp
+      !
       IF (MOD(nbcline,nbclineupdate) == 0) THEN
 …
    RECURSIVE SUBROUTINE Agrif_Update_Dyn( )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Dyn ***
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Update_Dyn ***
+      !!----------------------------------------------------------------------
+      !
       IF (Agrif_Root()) RETURN
 …
 # endif
       IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN
+      IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN
          ! Update time integrated transports
          IF (mod(nbcline,nbclineupdate) == 0) THEN
 …
    END SUBROUTINE Agrif_Update_Dyn
+# if defined key_zdftke
+!!gm Missing GLS case !!!!!
    SUBROUTINE Agrif_Update_Tke( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Tke ***
+      !!---------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Update_Tke ***
+      !!----------------------------------------------------------------------
       INTEGER, INTENT(in) :: kt
+      !
+      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
+      !!----------------------------------------------------------------------
+      !
+!!gm test on kt/=0  ????  why not nit000-1  ?  doesn't seem logic
+      IF( ( Agrif_NbStepint() /= 0 ) .AND. kt /= 0 )   RETURN
 #  if defined TWO_WAY
+      !
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
       CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  )
       CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT )
       CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM )
+      Agrif_SpecialValueFineGrid    = 0._wp
+      !
+      CALL Agrif_Update_Variable(  en_id, locupdate=(/0,0/), procname=updateEN  )
+      CALL Agrif_Update_Variable( avt_id, locupdate=(/0,0/), procname=updateAVT )
+      CALL Agrif_Update_Variable( avm_id, locupdate=(/0,0/), procname=updateAVM )
+      !
       Agrif_UseSpecialValueInUpdate = .FALSE.
+      !
 #  endif
+      !
    END SUBROUTINE Agrif_Update_Tke
-# endif /* key_zdftke */
    SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
       !!           *** ROUTINE updateT ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji,jj,jk,jn
       !!---------------------------------------------
+      !
       IF (before) THEN
          DO jn = n1,n2
             DO jk=k1,k2
                DO jj=j1,j2
                   DO ji=i1,i2
+      !!----------------------------------------------------------------------
+      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres
+      LOGICAL                                    , INTENT(in   ) ::   before
+      !
+      INTEGER :: ji, jj, jk, jn
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         DO jn = n1, n2
+            DO jk = k1, k2
+               DO jj = j1, j2
+                  DO ji = i1, i2
                      tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)
                   END DO
 …
                                  &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
                   ENDDO
                ENDDO
             ENDDO
+                     END DO
+                  END DO
+               END DO
+            END DO
          ENDIF
          DO jn = n1,n2
 …
       LOGICAL                               , INTENT(in   ) :: before
+      !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zrhoy
+      INTEGER ::   ji, jj, jk
+      REAL(wp)::   zrhoy
       !!---------------------------------------------
+      !
 …
    SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updatev ***
+      !!---------------------------------------------
+      INTEGER :: i1,i2,j1,j2,k1,k2
+      INTEGER :: ji,jj,jk
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
+      LOGICAL :: before
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updatev ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL                               , INTENT(in   ) :: before
       !!
+      REAL(wp) :: zrhox
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zrhox
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
          zrhox = Agrif_Rhox()
          DO jk=k1,k2
 …
    SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before )
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updateu2d ***
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres
+      LOGICAL                         , INTENT(in   ) ::   before
+      !!
+      INTEGER ::   ji, jj, jk
+      REAL(wp)::   zrhoy, zcorr
       !!---------------------------------------------
+      !!          *** ROUTINE updateu2d ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj, jk
+      REAL(wp) :: zrhoy
+      REAL(wp) :: zcorr
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+      !
+      IF( before ) THEN
          zrhoy = Agrif_Rhoy()
          DO jj=j1,j2
 …
    SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updatev2d ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
       !!
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE updatev2d ***
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres
+      LOGICAL                         , INTENT(in   ) ::   before
+      !
       INTEGER :: ji, jj, jk
+      REAL(wp) :: zrhox
+      REAL(wp) :: zcorr
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+      REAL(wp) :: zrhox, zcorr
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
          zrhox = Agrif_Rhox()
          DO jj=j1,j2
 …
    SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updateSSH ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE updateSSH ***
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres
+      LOGICAL                         , INTENT(in   ) ::   before
       !!
       INTEGER :: ji, jj
       !!---------------------------------------------
+      !
       IF (before) THEN
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
          DO jj=j1,j2
             DO ji=i1,i2
 …
    SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updateub2b ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updateub2b ***
+      !!----------------------------------------------------------------------
+      INTEGER                            , INTENT(in) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres
+      LOGICAL                            , INTENT(in) ::   before
       !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhoy
       !!---------------------------------------------
+      INTEGER ::   ji, jj
+      REAL(wp)::   zrhoy
+      !!----------------------------------------------------------------------
+      !
       IF (before) THEN
 …
    SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updatevb2b ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updatevb2b ***
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres
+      LOGICAL                         , INTENT(in   ) ::   before
       !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhox
       !!---------------------------------------------
+      !
       IF (before) THEN
+      INTEGER ::   ji, jj
+      REAL(wp)::   zrhox
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
          zrhox = Agrif_Rhox()
          DO jj=j1,j2
 …
    SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
+      ! currently not used
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, iNTENT(in) :: before
+      !
+      !
+      ! ====>>>>>>>>>>    currently not used
+      !
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updateT ***
+      !!----------------------------------------------------------------------
+      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres
+      LOGICAL                                    , INTENT(in   ) ::   before
+      !!
       INTEGER :: ji,jj,jk
       REAL(wp) :: ztemp
       !!---------------------------------------------
+      !!----------------------------------------------------------------------
       IF (before) THEN
 …
    END SUBROUTINE update_scales
-# if defined key_zdftke
    SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
       !!---------------------------------------------
       !!           *** ROUTINE updateen ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
       LOGICAL, INTENT(in) :: before
       !!---------------------------------------------
+      !
       IF (before) THEN
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updateen ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                               , INTENT(in   ) ::   before
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
          ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2)
       ELSE
 …
    SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavt ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updateavt ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                               , INTENT(in   ) ::   before
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
+      ELSE                ;   avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
       ENDIF
+      !
 …
       !!---------------------------------------------
       !!           *** ROUTINE updateavm ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                               , INTENT(in   ) ::   before
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE                ;   avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
       ENDIF
+      !
    END SUBROUTINE updateAVM
-# endif /* key_zdftke */
 #else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                          no AGRIF zoom
+   !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE agrif_opa_update_empty
-      !!---------------------------------------------
-      !!   *** ROUTINE agrif_opa_update_empty ***
-      !!---------------------------------------------
       WRITE(*,*)  'agrif_opa_update : You should not have seen this print! error?'
    END SUBROUTINE agrif_opa_update_empty
 #endif
+   !!======================================================================
 END MODULE agrif_opa_update

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

-                      r6140
+                      r8215
 MODULE agrif_top_interp
+   !!======================================================================
+   !!                   ***  MODULE  agrif_top_interp  ***
+   !! AGRIF: interpolation package
+   !!======================================================================
+   !! History :  2.0  !  ???
+   !!----------------------------------------------------------------------
 #if defined key_agrif && defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!   'key_top'                                           on-line tracers
+   !!----------------------------------------------------------------------
    USE par_oce
    USE oce
 …
    USE par_trc
    USE trc
+   !
    USE lib_mpp
    USE wrk_nemo
 …
    PUBLIC Agrif_trc, interptrn
-#  include "vectopt_loop_substitute.h90"
   !!----------------------------------------------------------------------
    !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
    SUBROUTINE Agrif_trc
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE Agrif_trc  ***
+      !!                   ***  ROUTINE Agrif_trc  ***
       !!----------------------------------------------------------------------
+      !
       IF( Agrif_Root() )   RETURN
       Agrif_SpecialValue    = 0.e0
+      !
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
+      !
       CALL Agrif_Bc_variable( trn_id, procname=interptrn )
       Agrif_UseSpecialValue = .FALSE.
 …
+   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptrn ***
+      !!---------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER :: imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      IF (before) THEN
+   SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE interptrn ***
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab
+      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
+      LOGICAL                                     , INTENT(in   ) ::   before
+      INTEGER                                     , INTENT(in   ) ::   nb , ndir
+      !!
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER ::   imin, imax, jmin, jmax
+      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
+      REAL(wp)::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp)::   zalpha4, zalpha5, zalpha6, zalpha7
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
          ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
       ELSE
 …
 #else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                           no TOP AGRIF
+   !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE Agrif_TOP_Interp_empty
 …
    END SUBROUTINE Agrif_TOP_Interp_empty
 #endif
+   !!======================================================================
 END MODULE agrif_top_interp

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

-                      r6140
+                      r8215
    !!======================================================================
    !!                ***  MODULE agrif_top_sponge  ***
    !! AGRIF :   define in memory AGRIF variables for sea-ice
+   !! AGRIF :   TOP sponge layer
    !!======================================================================
    !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
    !!----------------------------------------------------------------------
+#if defined key_agrif && defined key_top
    !!----------------------------------------------------------------------
    !!   Agrif_Sponge_trc :
    !!   interptrn_sponge :
    !!----------------------------------------------------------------------
-#if defined key_agrif && defined key_top
    USE par_oce
    USE par_trc
 …
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
       !!                   *** ROUTINE Agrif_Sponge_Trc ***
       !!----------------------------------------------------------------------
       REAL(wp) ::   timecoeff
+      REAL(wp) ::   timecoeff   ! local scalar
       !!----------------------------------------------------------------------
+      !
 …
 #else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                           no TOP AGRIF
+   !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE agrif_top_sponge_empty

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

-                      r6140
+                      r8215
    !!                ***  MODULE agrif_top_update  ***
    !! AGRIF :
    !!----------------------------------------------------------------------
+   !!======================================================================
    !! History :
    !!----------------------------------------------------------------------
 #if defined key_agrif && defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!   'key_TOP'                                           on-line tracers
+   !!----------------------------------------------------------------------
    USE par_oce
    USE oce
+   USE dom_oce
+   USE agrif_oce
    USE par_trc
    USE trc
+   USE dom_oce
+   USE agrif_oce
+   !
    USE wrk_nemo
 …
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! NEMO/NST 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
 #else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                           no TOP AGRIF
+   !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE agrif_top_update_empty
-      !!---------------------------------------------
-      !!   *** ROUTINE agrif_Top_update_empty ***
-      !!---------------------------------------------
       WRITE(*,*)  'agrif_top_update : You should not have seen this print! error?'
    END SUBROUTINE agrif_top_update_empty

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

-                      r7761
+                      r8215
 #if defined key_agrif
 !!----------------------------------------------------------------------
 !! NEMO/NST 3.7 , NEMO Consortium (2016)
+!! NEMO/NST 4.0 , NEMO Consortium (2017)
 !! $Id$
 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
    !!
    IMPLICIT NONE
+   !
    !!----------------------------------------------------------------------
+   !
 …
    USE par_oce
    USE oce
    !!
+   !
    IMPLICIT NONE
    !!----------------------------------------------------------------------
 …
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
    CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
+   CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
    ! 3. Location of interpolation
    !-----------------------------
    CALL Agrif_Set_bc(e1u_id,(/0,0/))
    CALL Agrif_Set_bc(e2v_id,(/0,0/))
+   CALL Agrif_Set_bc( e1u_id, (/0,0/) )
+   CALL Agrif_Set_bc( e2v_id, (/0,0/) )
    ! 5. Update type
    !---------------
    CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
    CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
+   CALL Agrif_Set_Updatetype( e1u_id, update1=Agrif_Update_Copy   , update2=Agrif_Update_Average )
+   CALL Agrif_Set_Updatetype( e2v_id, update1=Agrif_Update_Average, update2=Agrif_Update_Copy    )
 ! High order updates
 !   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
 !   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
+!   CALL Agrif_Set_Updatetype( e1u_id, update1=Agrif_Update_Average       , update2=Agrif_Update_Full_Weighting )
+!   CALL Agrif_Set_Updatetype( e2v_id, update1=Agrif_Update_Full_Weighting, update2=Agrif_Update_Average        )
+    !
 END SUBROUTINE agrif_declare_var_dom
 …
    USE oce
    USE dom_oce
+   USE zdf_oce
    USE nemogcm
+   !
    USE lib_mpp
    USE in_out_manager
 …
    USE agrif_opa_interp
    USE agrif_opa_sponge
    !!
+   !
    IMPLICIT NONE
+   !
 …
    ! 2. First interpolations of potentially non zero fields
    !-------------------------------------------------------
    Agrif_SpecialValue=0.
+   Agrif_SpecialValue    = 0._wp
    Agrif_UseSpecialValue = .TRUE.
    CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
 …
    ENDIF
+   !
+# if defined key_zdftke
+   CALL Agrif_Update_tke(0)
+# endif
+   IF( ln_zdftke )   CALL Agrif_Update_tke( 0 )
+   !
    Agrif_UseSpecialValueInUpdate = .FALSE.
 …
    !!----------------------------------------------------------------------
    USE agrif_util
+   USE par_oce       !   ONLY : jpts
+   USE agrif_oce
+   USE par_oce       ! ocean parameters
+   USE zdf_oce       ! vertical physics
    USE oce
-   USE agrif_oce
    !!
    IMPLICIT NONE
 …
    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
+# if defined key_zdftke
    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
+# endif
+   IF( ln_zdftke ) THEN
+      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
+      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
+      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
+   ENDIF
    ! 2. Type of interpolation
 …
    CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
+# if defined key_zdftke
+   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
+# endif
+   IF( ln_zdftke )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
    ! 3. Location of interpolation
 …
    CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
    CALL Agrif_Set_bc(sshn_id,(/0,0/))
    CALL Agrif_Set_bc(unb_id ,(/0,0/))
    CALL Agrif_Set_bc(vnb_id ,(/0,0/))
    CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
    CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
+   CALL Agrif_Set_bc( sshn_id       , (/0,0/) )
+   CALL Agrif_Set_bc( unb_id        , (/0,0/) )
+   CALL Agrif_Set_bc( vnb_id        , (/0,0/) )
+   CALL Agrif_Set_bc( ub2b_interp_id, (/0,0/) )
+   CALL Agrif_Set_bc( vb2b_interp_id, (/0,0/) )
    CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
 …
    CALL Agrif_Set_bc(vmsk_id,(/0,0/))
+# if defined key_zdftke
+   CALL Agrif_Set_bc(avm_id ,(/0,1/))
+# endif
+   IF( ln_zdftke )   CALL Agrif_Set_bc( avm_id, (/0,1/) )
    ! 5. Update type
 …
    CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+# if defined key_zdftke
    CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
    CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
    CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
+# endif
+   IF( ln_zdftke) THEN
+      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
+      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
+      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
+   ENDIF
 ! High order updates

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

-                      r7646
+                      r8215
       CALL zdf_mxl( kt )                                                   ! In any case, we need mxl
+      !
       hmld(:,:)         = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht
       avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient
+      !
+#if defined key_trabbl && ! defined key_c1d
       ahu_bbl(:,:)      = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1)    ! bbl diffusive coef
       ahv_bbl(:,:)      = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1)
+#endif
+      hmld(:,:)       = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht
+      avt(:,:,:)      = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient
+      !
+      IF( ln_trabbl .AND. .NOT.lk_c1d ) THEN       ! diffusive Bottom boundary layer param
+         ahu_bbl(:,:) = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1)    ! bbl diffusive coef
+         ahv_bbl(:,:) = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1)
+      ENDIF
+      !
+      !
 …
       ENDIF
+      !
       IF( lk_trabbl ) THEN
+      IF( ln_trabbl ) THEN
                  jf_ubl  = jfld + 1    ;         jf_vbl  = jfld + 2     ;      jfld = jf_vbl
            slf_d(jf_ubl) = sn_ubl      ;   slf_d(jf_vbl) = sn_vbl

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

-                      r7761
+                      r8215
    USE trabbl          ! bottom boundary layer          (tra_bbl_init routine)
    USE traldf          ! lateral physics                (tra_ldf_init routine)
+   USE zdfini          ! vertical physics: initialization
+   USE sbcmod          ! surface boundary condition       (sbc_init     routine)
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE sbcmod          ! surface boundary condition     (sbc_init     routine)
+   USE phycst          ! physical constant                   (par_cst routine)
    USE dtadyn          ! Lecture and Interpolation of the dynamical fields
    USE trcini          ! Initilization of the passive tracers
    USE daymod          ! calendar                         (day     routine)
    USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
+   USE daymod          ! calendar                            (day     routine)
+   USE trcstp          ! passive tracer time-stepping        (trc_stp routine)
    USE dtadyn          ! Lecture and interpolation of the dynamical fields
    !              ! Passive tracers needs
 …
                             CALL tra_qsr_init   ! penetrative solar radiation qsr
       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
                             CALL trc_nam_run    ! Needed to get restart parameters for passive tracers

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

-                      r6140
+                      r8215
    USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces
    USE tradmp             ! Tracer damping
-#if defined key_zdftke
    USE zdftke             ! TKE vertical physics
-#endif
    USE eosbn2             ! Equation of state (eos_bn2 routine)
    USE zdfmxl             ! Mixed layer depth
 …
             IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
                zdate = REAL( ndastp )
+#if defined key_zdftke
+               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+#endif
+               IF( ln_zdftke ) THEN                   ! read turbulent kinetic energy ( en )
+                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+                  CALL tke_rst( nit000, 'READ' )
+               ENDIF
             ELSE
                zdate = REAL( ndastp )
 …
             CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
             CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
+#if defined key_zdftke
+            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
+#endif
+            IF( ln_zdftke )   CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
+            !
             CALL iom_close( inum )

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

-                      r6140
+                      r8215
    PUBLIC stp_c1d      ! called by opa.F90
-   !! * Substitutions
-#  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/C1D 3.7 , NEMO Consortium (2015)
 …
                          CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
                          CALL bn2( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+      !  VERTICAL PHYSICS
+                         CALL zdf_bfr( kstp )         ! bottom friction
+      !                                               ! Vertical eddy viscosity and diffusivity coefficients
+      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz
+      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
+      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
+      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
+         avt (:,:,:) = rn_avt0 * tmask(:,:,:)
+         avmu(:,:,:) = rn_avm0 * umask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * vmask(:,:,:)
+      ENDIF
+      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:)   ;   END DO
+      ENDIF
+      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
+      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
+      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
+                         CALL zdf_mxl( kstp )         ! mixed layer depth
+                                                      ! write tke information in the restart file
+      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
+                                                      ! write gls information in the restart file
+      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
+      !  VERTICAL PHYSICS
+                         CALL zdf_phy( kstp )         ! vertical physics update (bfr, avt, avs, avm + MLD)
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

-                      r6140
+                      r8215
       ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs
       REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs
 …
       ! Vertical diffusion
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp
+# if defined key_zdfddm
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
+# endif
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: temperature vertical diffusivity coeff. [m2/s] at w-point
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity    vertical diffusivity coeff. [m2/s] at w-point
       ! Mixing and Mixed Layer Depth
 …
+      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , &
+         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),&
+         &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11))
+      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk)   ,     &
+         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(11))
      ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
 …
          &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  )
+     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    &
+# if defined key_zdfddm
+         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
+# endif
+         &      STAT=ierr(13) )
+     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),   &
+         &                                        avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) )
       ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
          &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
+      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), &
+       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
+                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), &
+       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) )
+      ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij),   &
+         &      nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
+                njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij),   &
+         &      njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) )
       crs_dom_alloc = MAXVAL(ierr)
+      !
    END FUNCTION crs_dom_alloc

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

-                      r6140
+                      r8215
       INTEGER  ::   ji, jj, jk        ! dummy loop indices
       REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
+      REAL(wp) ::   zztmp             !   -      -
+      !
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs, z3d
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs
       !!----------------------------------------------------------------------
 …
       CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3w )
       CALL wrk_alloc( jpi,jpj,jpk,   ze3u, ze3v )
       CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs   )
+      CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs  , z3d )
+      !
       CALL wrk_alloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
 …
          vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
          wn_crs   (:,:,:  ) = 0._wp    ! w
          avt_crs  (:,:,:  ) = 0._wp    ! avt
+         avs_crs  (:,:,:  ) = 0._wp    ! avt
          hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
-         rke_crs  (:,:,:  ) = 0._wp    ! rke
          sshn_crs (:,:    ) = 0._wp    ! ssh
          utau_crs (:,:    ) = 0._wp    ! taux
 …
       CALL iom_put( "voces" , zs_crs )   ! vS
+      !  Kinetic energy
+      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
+      CALL iom_put( "eken", rke_crs )
+      IF( iom_use( "eken") ) THEN     !      kinetic energy
+         z3d(:,:,jk) = 0._wp
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zztmp  = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  z3d(ji,jj,jk) = 0.25_wp * zztmp * (                                    &
+                     &            un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   &
+                     &          + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   &
+                     &          + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   &
+                     &          + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z3d, 'T', 1. )
+         !
+         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
+         CALL iom_put( "eken", zt_crs )
+      ENDIF
       !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 )
       DO jk = 1, jpkm1
 …
                    hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)
                ENDIF
             ENDDO
          ENDDO
       ENDDO
+            END DO
+         END DO
+      END DO
       CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
+      !
 …
       !  free memory
+      !  avt, avs
+!!gm BUG   TOP always uses avs !!!
+      !  avs
       SELECT CASE ( nn_crs_kz )
          CASE ( 0 )
             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
          CASE ( 1 )
             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
          CASE ( 2 )
             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
       END SELECT
+      !
+      CALL iom_put( "avt", avt_crs )   !  Kz
+      CALL iom_put( "avt", avt_crs )   !  Kz on T
+      CALL iom_put( "avs", avs_crs )   !  Kz on S
       !  sbc fields

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

-                      r7753
+                      r8215
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE zdfgls   , ONLY : hmxl_n
    USE in_out_manager  ! I/O units
    USE iom             ! I/0 library
+   USE wrk_nemo        ! working arrays
+#if defined key_zdftke
+   USE zdf_oce, ONLY: en
+#endif
+   USE zdf_oce, ONLY: avt, avm
+#if defined key_zdfgls
+   USE zdf_oce, ONLY: en
+   USE zdfgls, ONLY: mxln
+#endif
+   USE wrk_nemo        ! work arrays
    IMPLICIT NONE
    PRIVATE
-   LOGICAL , PUBLIC ::   ln_dia25h     !:  25h mean output
    PUBLIC   dia_25h_init               ! routine called by nemogcm.F90
    PUBLIC   dia_25h                    ! routine called by diawri.F90
+  !! * variables for calculating 25-hourly means
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h
+#if defined key_zdfgls || key_zdftke
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h
+#endif
+#if defined key_zdfgls
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h
+#endif
+   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means
+   LOGICAL, PUBLIC ::   ln_dia25h      !:  25h mean output
+   ! variables for calculating 25-hourly means
+   INTEGER , SAVE ::   cnt_25h           ! Counter for 25 hour means
+   REAL(wp), SAVE ::   r1_25 = 0.04_wp   ! =1/25
+   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h
+   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h
+   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h
+   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h
+   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h  , rmxln_25h
    !!----------------------------------------------------------------------
 …
       !!
       !! ** Method : Read namelist
-      !!   History
-      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_25h
       !!---------------------------------------------------------------------------
-      !!
       INTEGER ::   ios                 ! Local integer output status for namelist read
       INTEGER ::   ierror              ! Local integer for memory allocation
 …
          WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics'
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) 'Namelist nam_dia25h : set 25h outputs '
          WRITE(numout,*) 'Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h
+         WRITE(numout,*) '   Namelist nam_dia25h : set 25h outputs '
+         WRITE(numout,*) '      Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h
       ENDIF
       IF( .NOT. ln_dia25h )   RETURN
 …
       ! 1 - Allocate memory !
       ! ------------------- !
+      ALLOCATE( tn_25h(jpi,jpj,jpk), STAT=ierror )
+      !                                ! ocean arrays
+      ALLOCATE( tn_25h (jpi,jpj,jpk), sn_25h (jpi,jpj,jpk), sshn_25h(jpi,jpj)  ,     &
+         &      un_25h (jpi,jpj,jpk), vn_25h (jpi,jpj,jpk), wn_25h(jpi,jpj,jpk),     &
+         &      avt_25h(jpi,jpj,jpk), avm_25h(jpi,jpj,jpk),                      STAT=ierror )
       IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate tn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( sn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate un_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( vn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate vn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( wn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate wn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( avt_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate avt_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( avm_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate avm_25h' )   ;   RETURN
+      ENDIF
+# if defined key_zdfgls || defined key_zdftke
+      ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN
+      ENDIF
+#endif
+# if defined key_zdfgls
+      ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' )   ;   RETURN
+      ENDIF
+#endif
+      ALLOCATE( sshn_25h(jpi,jpj), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN
+         CALL ctl_stop( 'dia_25h: unable to allocate ocean arrays' )   ;   RETURN
+      ENDIF
+      IF( ln_zdftke ) THEN             ! TKE physics
+         ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN
+         ENDIF
+      ENDIF
+      IF( ln_zdfgls ) THEN             ! GLS physics
+         ALLOCATE( en_25h(jpi,jpj,jpk), rmxln_25h(jpi,jpj,jpk), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'dia_25h: unable to allocate en_25h and rmxln_25h' )   ;   RETURN
+         ENDIF
       ENDIF
       ! ------------------------- !
 …
       ! ------------------------- !
       cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible)
       tn_25h(:,:,:) = tsb(:,:,:,jp_tem)
       sn_25h(:,:,:) = tsb(:,:,:,jp_sal)
       sshn_25h(:,:) = sshb(:,:)
       un_25h(:,:,:) = ub(:,:,:)
       vn_25h(:,:,:) = vb(:,:,:)
       wn_25h(:,:,:) = wn(:,:,:)
       avt_25h(:,:,:) = avt(:,:,:)
       avm_25h(:,:,:) = avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+      tn_25h  (:,:,:) = tsb (:,:,:,jp_tem)
+      sn_25h  (:,:,:) = tsb (:,:,:,jp_sal)
+      sshn_25h(:,:)   = sshb(:,:)
+      un_25h  (:,:,:) = ub  (:,:,:)
+      vn_25h  (:,:,:) = vb  (:,:,:)
+      wn_25h  (:,:,:) = wn  (:,:,:)
+      avt_25h (:,:,:) = avt (:,:,:)
+      avm_25h (:,:,:) = avm (:,:,:)
+      IF( ln_zdftke ) THEN
          en_25h(:,:,:) = en(:,:,:)
+#endif
+# if defined key_zdfgls
+         rmxln_25h(:,:,:) = mxln(:,:,:)
+#endif
+      ENDIF
+      IF( ln_zdfgls ) THEN
+         en_25h   (:,:,:) = en    (:,:,:)
+         rmxln_25h(:,:,:) = hmxl_n(:,:,:)
+      ENDIF
 #if defined key_lim3 || defined key_lim2
          CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice')
 #endif
+      ! -------------------------- !
+      ! 3 - Return to dia_wri      !
+      ! -------------------------- !
+      !
    END SUBROUTINE dia_25h_init
 …
       !!                 ***  ROUTINE dia_25h  ***
       !!
-      !!
-      !!--------------------------------------------------------------------
-      !!
       !! ** Purpose :   Write diagnostics with M2/S2 tide removed
       !!
+      !! ** Method  :
+      !!      25hr mean outputs for shelf seas
+      !! ** Method  :   25hr mean outputs for shelf seas
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!
-      !! History :
-      !!   ?.0  !  07-04  (A. Hines) New routine, developed from dia_wri_foam
-      !!   3.4  !  02-13  (J. Siddorn) Routine taken from old dia_wri_foam
-      !!   3.6  !  08-14  (E. O'Dea) adapted for VN3.6
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      IMPLICIT NONE
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !! * Local declarations
       INTEGER ::   ji, jj, jk
+      INTEGER                          ::   iyear0, nimonth0,iday0            ! start year,imonth,day
       LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
+      REAL(wp)                         ::   zsto, zout, zmax, zjulian, zmdi       ! temporary reals
+      INTEGER                          ::   i_steps                               ! no of timesteps per hour
+      REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                    ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                                  ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
+      INTEGER                          ::   iyear0, nimonth0,iday0                ! start year,imonth,day
+      REAL(wp)                         ::   zsto, zout, zmax, zjulian, zmdi   ! local scalars
+      INTEGER                          ::   i_steps                           ! no of timesteps per hour
+      REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                ! workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                              ! workspace
+      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                             ! workspace
       !!----------------------------------------------------------------------
 …
       ENDIF
-#if defined key_lim3 || defined key_lim2
-      CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice')
-#endif
       ! local variable for debugging
       ll_print = ll_print .AND. lwp
+      ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours
+      ! every day
+      IF( MOD( kt, i_steps ) == 0  .and. kt .ne. nn_it000 ) THEN
+      ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours every day
+      IF( MOD( kt, i_steps ) == 0  .AND. kt /= nn_it000 ) THEN
          IF (lwp) THEN
 …
          ENDIF
+         tn_25h(:,:,:)        = tn_25h(:,:,:) + tsn(:,:,:,jp_tem)
+         sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal)
+         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:)
+         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:)
+         vn_25h(:,:,:)        = vn_25h(:,:,:) + vn(:,:,:)
+         wn_25h(:,:,:)        = wn_25h(:,:,:) + wn(:,:,:)
+         avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:)
+         avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+         en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:)
+#endif
+# if defined key_zdfgls
+         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:)
+#endif
+         tn_25h  (:,:,:)     = tn_25h  (:,:,:) + tsn (:,:,:,jp_tem)
+         sn_25h  (:,:,:)     = sn_25h  (:,:,:) + tsn (:,:,:,jp_sal)
+         sshn_25h(:,:)       = sshn_25h(:,:)   + sshn(:,:)
+         un_25h  (:,:,:)     = un_25h  (:,:,:) + un  (:,:,:)
+         vn_25h  (:,:,:)     = vn_25h  (:,:,:) + vn  (:,:,:)
+         wn_25h  (:,:,:)     = wn_25h  (:,:,:) + wn  (:,:,:)
+         avt_25h (:,:,:)     = avt_25h (:,:,:) + avt (:,:,:)
+         avm_25h (:,:,:)     = avm_25h (:,:,:) + avm (:,:,:)
+         IF( ln_zdftke ) THEN
+            en_25h(:,:,:)    = en_25h  (:,:,:) + en(:,:,:)
+         ENDIF
+         IF( ln_zdfgls ) THEN
+            en_25h   (:,:,:) = en_25h   (:,:,:) + en    (:,:,:)
+            rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + hmxl_n(:,:,:)
+         ENDIF
          cnt_25h = cnt_25h + 1
+         !
          IF (lwp) THEN
             WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h
          ENDIF
+         !
       ENDIF ! MOD( kt, i_steps ) == 0
+         ! Write data for 25 hour mean output streams
+      IF( cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt
+               WRITE(numout,*) '~~~~~~~~~~~~ '
+            ENDIF
+            tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp
+            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp
+            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp
+            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp
+            vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp
+            wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp
+            avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp
+            avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp
+# if defined key_zdfgls || defined key_zdftke
+            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp
+#endif
+# if defined key_zdfgls
+            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp
+#endif
+            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output'
+            zmdi=1.e+20 !missing data indicator for masking
+            ! write tracers (instantaneous)
+            zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("temper25h", zw3d)   ! potential temperature
+            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put( "salin25h", zw3d  )   ! salinity
+            zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
+            CALL iom_put( "ssh25h", zw2d )   ! sea surface
+            ! Write velocities (instantaneous)
+            zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:))
+            CALL iom_put("vozocrtx25h", zw3d)    ! i-current
+            zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:))
+            CALL iom_put("vomecrty25h", zw3d  )   ! j-current
+            zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("vomecrtz25h", zw3d )   ! k-current
+            zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("avt25h", zw3d )   ! diffusivity
+            zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("avm25h", zw3d)   ! viscosity
+#if defined key_zdftke || defined key_zdfgls
+            zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+      ! Write data for 25 hour mean output streams
+      IF( cnt_25h == 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt /= nn_it000 ) THEN
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt
+            WRITE(numout,*) '~~~~~~~~~~~~ '
+         ENDIF
+         !
+         tn_25h  (:,:,:) = tn_25h  (:,:,:) * r1_25
+         sn_25h  (:,:,:) = sn_25h  (:,:,:) * r1_25
+         sshn_25h(:,:)   = sshn_25h(:,:)   * r1_25
+         un_25h  (:,:,:) = un_25h  (:,:,:) * r1_25
+         vn_25h  (:,:,:) = vn_25h  (:,:,:) * r1_25
+         wn_25h  (:,:,:) = wn_25h  (:,:,:) * r1_25
+         avt_25h (:,:,:) = avt_25h (:,:,:) * r1_25
+         avm_25h (:,:,:) = avm_25h (:,:,:) * r1_25
+         IF( ln_zdftke ) THEN
+            en_25h(:,:,:) = en_25h(:,:,:) * r1_25
+         ENDIF
+         IF( ln_zdfgls ) THEN
+            en_25h   (:,:,:) = en_25h   (:,:,:) * r1_25
+            rmxln_25h(:,:,:) = rmxln_25h(:,:,:) * r1_25
+         ENDIF
+         !
+         IF(lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output'
+         zmdi=1.e+20 !missing data indicator for masking
+         ! write tracers (instantaneous)
+         zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+         CALL iom_put("temper25h", zw3d)   ! potential temperature
+         zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+         CALL iom_put( "salin25h", zw3d  )   ! salinity
+         zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
+         CALL iom_put( "ssh25h", zw2d )   ! sea surface
+         ! Write velocities (instantaneous)
+         zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:))
+         CALL iom_put("vozocrtx25h", zw3d)    ! i-current
+         zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:))
+         CALL iom_put("vomecrty25h", zw3d  )   ! j-current
+         zw3d(:,:,:) = wn_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+         CALL iom_put("vomecrtz25h", zw3d )   ! k-current
+         ! Write vertical physics
+         zw3d(:,:,:) = avt_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+         CALL iom_put("avt25h", zw3d )   ! diffusivity
+         zw3d(:,:,:) = avm_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+         CALL iom_put("avm25h", zw3d)   ! viscosity
+         IF( ln_zdftke ) THEN
+            zw3d(:,:,:) = en_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
             CALL iom_put("tke25h", zw3d)   ! tke
+#endif
+#if defined key_zdfgls
+            zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+         ENDIF
+         IF( ln_zdfgls ) THEN
+            zw3d(:,:,:) = en_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("tke25h", zw3d)   ! tke
+            zw3d(:,:,:) = rmxln_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
             CALL iom_put( "mxln25h",zw3d)
+#endif
             ! After the write reset the values to cnt=1 and sum values equal current value
             tn_25h(:,:,:) = tsn(:,:,:,jp_tem)
             sn_25h(:,:,:) = tsn(:,:,:,jp_sal)
             sshn_25h(:,:) = sshn (:,:)
             un_25h(:,:,:) = un(:,:,:)
             vn_25h(:,:,:) = vn(:,:,:)
             wn_25h(:,:,:) = wn(:,:,:)
             avt_25h(:,:,:) = avt(:,:,:)
             avm_25h(:,:,:) = avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+         ENDIF
+         !
+         ! After the write reset the values to cnt=1 and sum values equal current value
+         tn_25h  (:,:,:) = tsn (:,:,:,jp_tem)
+         sn_25h  (:,:,:) = tsn (:,:,:,jp_sal)
+         sshn_25h(:,:)   = sshn(:,:)
+         un_25h  (:,:,:) = un  (:,:,:)
+         vn_25h  (:,:,:) = vn  (:,:,:)
+         wn_25h  (:,:,:) = wn  (:,:,:)
+         avt_25h (:,:,:) = avt (:,:,:)
+         avm_25h (:,:,:) = avm (:,:,:)
+         IF( ln_zdftke ) THEN
             en_25h(:,:,:) = en(:,:,:)
+#endif
+# if defined key_zdfgls
+            rmxln_25h(:,:,:) = mxln(:,:,:)
+#endif
+            cnt_25h = 1
+            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h
+         ENDIF
+         IF( ln_zdfgls ) THEN
+            en_25h   (:,:,:) = en    (:,:,:)
+            rmxln_25h(:,:,:) = hmxl_n(:,:,:)
+         ENDIF
+         cnt_25h = 1
+         IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h
+         !
       ENDIF !  cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000
+      !
    END SUBROUTINE dia_25h

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

-                      r7753
+                      r8215
    !! * Substitutions
-#  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
 …
       ! Exclude points where rn2 is negative as convection kicks in here and
       ! work is not being done against stratification
+          CALL wrk_alloc( jpi, jpj, zpe )
+          zpe(:,:) = 0._wp
+          IF( lk_zdfddm ) THEN
+             DO ji=1,jpi
+                DO jj=1,jpj
+                   DO jk=1,jpk
+                      zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                         &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )
+                      !
+                      zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
+                      zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
+                      !
+                      zpe(ji, jj) = zpe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * &
+                           &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  &
+                           &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )
+                   ENDDO
+                ENDDO
+             ENDDO
+         CALL wrk_alloc( jpi, jpj, zpe )
+         zpe(:,:) = 0._wp
+         IF( ln_zdfddm ) THEN
+            DO jk = 2, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( rn2(ji,jj,jk) > 0._wp ) THEN
+                        zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                           &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )
+!!gm  this can be reduced to :  (depw-dept) / e3w   (NB idem dans bn2 !)
+!                        zrw =   ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk)
+!!gm end
+                        !
+                        zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
+                        zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
+                        !
+                        zpe(ji, jj) = zpe(ji, jj)            &
+                           &        -  grav * (  avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  &
+                           &                   - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )
+                     ENDIF
+                  END DO
+               END DO
+             END DO
           ELSE
+             DO ji = 1, jpi
+                DO jj = 1, jpj
+                   DO jk = 1, jpk
+                       zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+          CALL lbc_lnk( zpe, 'T', 1._wp)
+            DO jk = 1, jpk
+               DO ji = 1, jpi
+                  DO jj = 1, jpj
+                     zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+!!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj
+!!gm           CALL lbc_lnk( zpe, 'T', 1._wp)
           CALL iom_put( 'tnpeo', zpe )
           CALL wrk_dealloc( jpi, jpj, zpe )

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

-                      r7753
+                      r8215
    !!   dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
    USE dynadv, ONLY: ln_dynadv_vec
    USE zdf_oce         ! ocean vertical physics
    USE ldftra          ! lateral physics: eddy diffusivity coef.
    USE ldfdyn          ! lateral physics: eddy viscosity   coef.
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE icb_oce         ! Icebergs
    USE icbdia          ! Iceberg budgets
    USE sbcssr          ! restoring term toward SST/SSS climatology
    USE phycst          ! physical constants
    USE zdfmxl          ! mixed layer
    USE dianam          ! build name of file (routine)
    USE zdfddm          ! vertical  physics: double diffusion
    USE diahth          ! thermocline diagnostics
    USE wet_dry         ! wetting and drying
    USE sbcwave         ! wave parameters
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE dianam         ! build name of file (routine)
+   USE diahth         ! thermocline diagnostics
+   USE dynadv   , ONLY: ln_dynadv_vec
+   USE icb_oce        ! Icebergs
+   USE icbdia         ! Iceberg budgets
+   USE ldftra         ! lateral physics: eddy diffusivity coef.
+   USE ldfdyn         ! lateral physics: eddy viscosity   coef.
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE sbcssr         ! restoring term toward SST/SSS climatology
+   USE sbcwave        ! wave parameters
+   USE wet_dry        ! wetting and drying
+   USE zdf_oce        ! ocean vertical physics
+   USE zdfdrg         ! ocean vertical physics: top/bottom friction
+   USE zdfmxl         ! mixed layer
+   !
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
    USE diatmb          ! Top,middle,bottom output
    USE dia25h          ! 25h Mean output
    USE iom
    USE ioipsl
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager ! I/O manager
+   USE diatmb         ! Top,middle,bottom output
+   USE dia25h         ! 25h Mean output
+   USE iom            !
+   USE ioipsl         !
 #if defined key_lim2
 …
    USE diurnal_bulk    ! diurnal warm layer
    USE cool_skin       ! Cool skin
-   USE wrk_nemo        ! working array
    IMPLICIT NONE
 …
    !! * Substitutions
-#  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
 …
       !! ** Method  :  use iom_put
       !!----------------------------------------------------------------------
-      !!
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
       INTEGER                      ::   ji, jj, jk              ! dummy loop indices
       INTEGER                      ::   jkbot                   !
       REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !
       !!
       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
+      INTEGER ::   ji, jj, jk       ! dummy loop indices
+      INTEGER ::   ikbot            ! local integer
+      REAL(wp)::   zztmp , zztmpx   ! local scalar
+      REAL(wp)::   zztmp2, zztmpy   !   -      -
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d   ! 3D workspace
       !!----------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )   CALL timing_start('dia_wri')
+      !
-      CALL wrk_alloc( jpi , jpj      , z2d )
-      CALL wrk_alloc( jpi , jpj, jpk , z3d )
+      !
       ! Output the initial state and forcings
       IF( ninist == 1 ) THEN
 …
          DO jj = 1, jpj
             DO ji = 1, jpi
                jkbot = mbkt(ji,jj)
                z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem)
+               ikbot = mbkt(ji,jj)
+               z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem)
             END DO
          END DO
 …
          DO jj = 1, jpj
             DO ji = 1, jpi
                jkbot = mbkt(ji,jj)
                z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal)
+               ikbot = mbkt(ji,jj)
+               z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal)
             END DO
          END DO
 …
       IF ( iom_use("taubot") ) THEN                ! bottom stress
+         zztmp = rau0 * 0.25
          z2d(:,:) = 0._wp
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  &
                       &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )
                zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  &
                       &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  )
                z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)
+               zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * un(ji  ,jj,mbku(ji  ,jj))  )**2   &
+                  &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj))  )**2   &
+                  &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vn(ji,jj  ,mbkv(ji,jj  ))  )**2   &
+                  &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1))  )**2
+               z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)
+               !
             ENDDO
          ENDDO
+            END DO
+         END DO
          CALL lbc_lnk( z2d, 'T', 1. )
          CALL iom_put( "taubot", z2d )
       ENDIF
       CALL iom_put( "uoce", un(:,:,:)         )    ! 3D i-current
       CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current
+      CALL iom_put( "uoce", un(:,:,:) )            ! 3D i-current
+      CALL iom_put(  "ssu", un(:,:,1) )            ! surface i-current
       IF ( iom_use("sbu") ) THEN
          DO jj = 1, jpj
             DO ji = 1, jpi
                jkbot = mbku(ji,jj)
                z2d(ji,jj) = un(ji,jj,jkbot)
+               ikbot = mbku(ji,jj)
+               z2d(ji,jj) = un(ji,jj,ikbot)
             END DO
          END DO
 …
       ENDIF
       CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current
       CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current
+      CALL iom_put( "voce", vn(:,:,:) )            ! 3D j-current
+      CALL iom_put(  "ssv", vn(:,:,1) )            ! surface j-current
       IF ( iom_use("sbv") ) THEN
          DO jj = 1, jpj
             DO ji = 1, jpi
                jkbot = mbkv(ji,jj)
                z2d(ji,jj) = vn(ji,jj,jkbot)
+               ikbot = mbkv(ji,jj)
+               z2d(ji,jj) = vn(ji,jj,ikbot)
             END DO
          END DO
 …
       ENDIF
       CALL iom_put( "avt" , avt                        )    ! T vert. eddy diff. coef.
       CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef.
       CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm)
       IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt  (:,:,:) ) ) )
       IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) )
+      CALL iom_put( "avt" , avt )                  ! T vert. eddy diff. coef.
+      CALL iom_put( "avs" , avs )                  ! S vert. eddy diff. coef.
+      CALL iom_put( "avm" , avm )                  ! T vert. eddy visc. coef.
+      IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt(:,:,:) ) ) )
+      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) )
       IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
 …
          END DO
          CALL lbc_lnk( z2d, 'T', 1. )
          CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient
+         CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient
          z2d(:,:) = SQRT( z2d(:,:) )
          CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient
+         CALL iom_put( "sstgrad" ,  z2d )          ! module of sst gradient
       ENDIF
 …
             END DO
          END DO
          CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2)
+         CALL iom_put( "heatc", rau0_rcp * z2d )   ! vertically integrated heat content (J/m2)
       ENDIF
 …
             END DO
          END DO
          CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2)
+         CALL iom_put( "saltc", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
       ENDIF
+      !
       IF ( iom_use("eken") ) THEN
          rke(:,:,jk) = 0._wp                               !      kinetic energy
+         z3d(:,:,jk) = 0._wp
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zztmp   = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)    &
+                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) )  &
+                     &          *  zztmp
+                  !
+                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)    &
+                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) )  &
+                     &          *  zztmp
+                  !
+                  rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy )
+                  !
+               ENDDO
+            ENDDO
+         ENDDO
+         CALL lbc_lnk( rke, 'T', 1. )
+         CALL iom_put( "eken", rke )
+                  zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  z3d(ji,jj,jk) = zztmp * (  un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   &
+                     &                     + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   &
+                     &                     + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   &
+                     &                     + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z3d, 'T', 1. )
+         CALL iom_put( "eken", z3d )                 ! kinetic energy
       ENDIF
+      !
 …
             z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
          END DO
          CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction
          CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum
+         CALL iom_put( "u_masstr"     , z3d )         ! mass transport in i-direction
+         CALL iom_put( "u_masstr_vint", z2d )         ! mass transport in i-direction vertical sum
       ENDIF
       IF( iom_use("u_heattr") ) THEN
          z2d(:,:) = 0.e0
+         z2d(:,:) = 0._wp
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
 …
          END DO
          CALL lbc_lnk( z2d, 'U', -1. )
          CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction
+         CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction
       ENDIF
 …
          END DO
          CALL lbc_lnk( z2d, 'U', -1. )
          CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction
+         CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction
       ENDIF
 …
             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)
          END DO
          CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction
+         CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction
       ENDIF
 …
          END DO
          CALL lbc_lnk( z2d, 'V', -1. )
          CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction
+         CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction
       ENDIF
       IF( iom_use("v_salttr") ) THEN
          z2d(:,:) = 0.e0
+         z2d(:,:) = 0._wp
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
 …
          END DO
          CALL lbc_lnk( z2d, 'V', -1. )
+         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction
+      ENDIF
+      ! Vertical integral of temperature
+         CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction
+      ENDIF
       IF( iom_use("tosmint") ) THEN
          z2d(:,:)=0._wp
+         z2d(:,:) = 0._wp
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem)
+                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem)
                END DO
             END DO
          END DO
          CALL lbc_lnk( z2d, 'T', -1. )
+         CALL iom_put( "tosmint", z2d )
+      ENDIF
+      ! Vertical integral of salinity
+         CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature
+      ENDIF
       IF( iom_use("somint") ) THEN
          z2d(:,:)=0._wp
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
+                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
                END DO
             END DO
          END DO
          CALL lbc_lnk( z2d, 'T', -1. )
+         CALL iom_put( "somint", z2d )
+      ENDIF
+      CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2)
+      !
+      CALL wrk_dealloc( jpi , jpj      , z2d )
+      CALL wrk_dealloc( jpi , jpj, jpk , z3d )
+      !
+      ! If we want tmb values
+      IF (ln_diatmb) THEN
+         CALL dia_tmb
+      ENDIF
+      IF (ln_dia25h) THEN
+         CALL dia_25h( kt )
+      ENDIF
+         CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity
+      ENDIF
+      CALL iom_put( "bn2", rn2 )                      ! Brunt-Vaisala buoyancy frequency (N^2)
+      !
+      IF (ln_diatmb)   CALL dia_tmb                   ! tmb values
+      IF (ln_dia25h)   CALL dia_25h( kt )             ! 25h averaging
       IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
 …
       REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
+      !
       REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace
       !!----------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )   CALL timing_start('dia_wri')
+      !
+                             CALL wrk_alloc( jpi,jpj      , zw2d )
+      IF( .NOT.ln_linssh )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d )
+      !
+      ! Output the initial state and forcings
+      IF( ninist == 1 ) THEN
+      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==!
          CALL dia_wri_state( 'output.init', kt )
          ninist = 0
 …
       ! -----------------
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = .FALSE.                  ! local variable for debugging
       ll_print = ll_print .AND. lwp
 …
          CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
          CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity"             , "m2/s"  ,   &  ! avmu
+         CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity"             , "m2/s"  ,   &  ! avm
             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
          IF( lk_zdfddm ) THEN
+         IF( ln_zdfddm ) THEN
             CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs
                &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
 …
       CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
       CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
       CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
       IF( lk_zdfddm ) THEN
          CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
+      CALL histwrite( nid_W, "votkeavm", it, avm            , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
+      IF( ln_zdfddm ) THEN
+         CALL histwrite( nid_W, "voddmavs", it, avs         , ndim_T, ndex_T )    ! S vert. eddy diff. coef.
       ENDIF
       IF( ln_wave .AND. ln_sdw ) THEN
          CALL histwrite( nid_U, "sdzocrtx", it, usd           , ndim_U , ndex_U )    ! i-StokesDrift-current
          CALL histwrite( nid_V, "sdmecrty", it, vsd           , ndim_V , ndex_V )    ! j-StokesDrift-current
          CALL histwrite( nid_W, "sdvecrtz", it, wsd           , ndim_T , ndex_T )    ! StokesDrift vert. current
+         CALL histwrite( nid_U, "sdzocrtx", it, usd         , ndim_U , ndex_U )    ! i-StokesDrift-current
+         CALL histwrite( nid_V, "sdmecrty", it, vsd         , ndim_V , ndex_V )    ! j-StokesDrift-current
+         CALL histwrite( nid_W, "sdvecrtz", it, wsd         , ndim_T , ndex_T )    ! StokesDrift vert. current
       ENDIF
 …
          CALL histclo( nid_W )
       ENDIF
+      !
-                             CALL wrk_dealloc( jpi , jpj        , zw2d )
-      IF( .NOT.ln_linssh )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
+      !
       IF( nn_timing == 1 )   CALL timing_stop('dia_wri')

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

-                      r7753
+                      r8215
    !!==============================================================================
    !! History :  3.2  ! 2008-11  (A. C. Coward)  Original code
    !!            3.4  ! 2011-09  (H. Liu) Make it consistent with semi-implicit
    !!                            Bottom friction (ln_bfrimp = .true.)
+   !!            3.4  ! 2011-09  (H. Liu) Make it consistent with semi-implicit Bottom friction (ln_drgimp =T)
+   !!            4.0  ! 2017-05  (G. Madec)  drag coef. defined at t-point (zdfdrg.F90)
    !!----------------------------------------------------------------------
 …
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
    USE zdf_oce        ! ocean vertical physics variables
    USE zdfbfr         ! ocean bottom friction variables
+   USE zdf_oce        ! vertical physics: variables
+   USE zdfdrg         ! vertical physics: top/bottom drag coef.
    USE trd_oce        ! trends: ocean variables
    USE trddyn         ! trend manager: dynamics
+   !
    USE in_out_manager ! I/O manager
    USE prtctl         ! Print control
    USE timing         ! Timing
-   USE wrk_nemo       ! Memory Allocation
    IMPLICIT NONE
 …
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
       !! ** Purpose :   compute the bottom friction ocean dynamics physics.
       !!
+      !!              only for explicit bottom friction form
+      !!              implicit bfr is implemented in dynzdf_imp
+      !!
       !! ** Action  :   (ua,va)   momentum trend increased by bottom friction trend
       !!---------------------------------------------------------------------
 …
       INTEGER  ::   ikbu, ikbv   ! local integers
       REAL(wp) ::   zm1_2dt      ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      REAL(wp) ::   zCdu, zCdv   !   -      -
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv
       !!---------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )  CALL timing_start('dyn_bfr')
+      !
+!!gm issue: better to put the logical in step to control the call of zdf_bfr
+!!          ==> change the logical from ln_bfrimp to ln_bfr_exp !!
+      IF( .NOT.ln_bfrimp) THEN     ! only for explicit bottom friction form
+                                    ! implicit bfr is implemented in dynzdf_imp
+!!gm bug : time step is only rdt (not 2 rdt if euler start !)
+         zm1_2dt = - 1._wp / ( 2._wp * rdt )
+!!gm bug : time step is only rdt (not 2 rdt if euler start !)
+        zm1_2dt = - 1._wp / ( 2._wp * rdt )
+        IF( l_trddyn ) THEN      ! trends: store the input trends
+           CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+           ztrdu(:,:,:) = ua(:,:,:)
+           ztrdv(:,:,:) = va(:,:,:)
+        ENDIF
+      IF( l_trddyn ) THEN      ! trends: store the input trends
+         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
+         ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+      ENDIF
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1
+              ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
+              ikbv = mbkv(ji,jj)
+              !
+              ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+              ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
+              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv)
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels
+            ikbv = mbkv(ji,jj)
+            !
+            ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+            zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu)
+            zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv)
+            !
+            ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * ub(ji,jj,ikbu)
+            va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * vb(ji,jj,ikbv)
+         END DO
+      END DO
+      !
+      IF( ln_isfcav ) THEN        ! ocean cavities
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
+               ikbv = mikv(ji,jj)
+               !
+               ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+               zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked
+               zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv)
+               !
+               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * ub(ji,jj,ikbu)
+               va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * vb(ji,jj,ikbv)
            END DO
+        END DO
+        !
+        IF( ln_isfcav ) THEN        ! ocean cavities
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 ! (ISF) stability criteria for top friction
+                 ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
+                 ikbv = mikv(ji,jj)
+                 !
+                 ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+                 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) &
+                    &             * (1.-umask(ji,jj,1))
+                 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) &
+                    &             * (1.-vmask(ji,jj,1))
+                 ! (ISF)
+              END DO
+           END DO
+        END IF
+        !
+        IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics
+           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )
+           CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+        ENDIF
+        !                                          ! print mean trends (used for debugging)
+        IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr  - Ua: ', mask1=umask,               &
+           &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+        !
+      ENDIF     ! end explicit bottom friction
+         END DO
+      ENDIF
+      !
+      IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )
+         DEALLOCATE( ztrdu, ztrdv )
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr  - Ua: ', mask1=umask,               &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_bfr')

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

r7761	r8215
1457	1457	!! * ROUTINE interp1 *
1458	1458	!!
1459		!! ** Purpose : Calculate the first order of deriavtive of
	1459	!! ** Purpose : Calculate the first order of derivative of
1460	1460	!! a cubic spline function y=a+bx+cx^2+d*x^3
1461	1461	!!

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

-                      r7753
+                      r8215
    !                      ! Parameter to control the type of lateral viscous operator
    INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in setting the operator
    INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral viscous trend)
+   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   !: error in setting the operator
+   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   !: without operator (i.e. no lateral viscous trend)
    !                          !!      laplacian     !    bilaplacian    !
    INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
    INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11                       ! iso-neutral or geopotential operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  !: iso-level operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11                       !: iso-neutral or geopotential operator
    INTEGER ::   nldf   ! type of lateral diffusion used defined from ln_dynldf_... (namlist logicals)
+   INTEGER, PUBLIC ::   nldf   !: type of lateral diffusion used defined from ln_dynldf_... (namlist logicals)
    !! * Substitutions

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

-                      r6140
+                      r8215
    PUBLIC   dyn_ldf_iso_alloc     ! called by nemogcm.F90
+   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   !  -      -
 …
       !!                  ***  ROUTINE dyn_ldf_iso_alloc  ***
       !!----------------------------------------------------------------------
       ALLOCATE( zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     &
          &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=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.')
 …
       !!
       !! ** Action :
+      !!        Update (ua,va) arrays with the before geopotential biharmonic
+      !!      mixing trend.
+      !!        Update (avmu,avmv) to accompt for the diagonal vertical component
+      !!      of the rotated operator in dynzdf module
+      !!       -(ua,va) updated with the before geopotential harmonic mixing trend
+      !!       -(akzu,akzv) to accompt for the diagonal vertical component
+      !!                    of the rotated operator in dynzdf module
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
 …
          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
          CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
+!!bug
+         IF( kt == nit000 ) then
+            IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &
+               &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj))
+         endif
+!!end
+      ENDIF
+         !
+       ENDIF
       !                                                ! ===============
 …
                            + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     &
                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) )
                ! update avmu (add isopycnal vertical coefficient to avmu)
                ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
                avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0
+               ! vertical mixing coefficient (akzu)
+               ! Note: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               akzu(ji,jj,jk) = ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0
             END DO
          END DO
 …
                   &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
                   &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )
                ! update avmv (add isopycnal vertical coefficient to avmv)
                ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
                avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0
+               ! vertical mixing coefficient (akzv)
+               ! Note: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               akzv(ji,jj,jk) = ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0
             END DO
          END DO

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

-                      r7831
+                      r8215
    !!             3.7  ! 2015-11  (J. Chanut) free surface simplification
    !!              -   ! 2016-12  (G. Madec, E. Clementi) update for Stoke-Drift divergence
+   !!             4.0  ! 2017-05  (G. Madec)  drag coef. defined at t-point (zdfdrg.F90)
    !!---------------------------------------------------------------------
 …
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! surface boundary condition: ocean
+   USE zdf_oce         ! Bottom friction coefts
+   USE zdf_oce         ! vertical physics: variables
+   USE zdfdrg          ! vertical physics: top/bottom drag coef.
    USE sbcisf          ! ice shelf variable (fwfisf)
    USE sbcapr          ! surface boundary condition: atmospheric pressure
 …
    USE updtide         ! tide potential
    USE sbcwave         ! surface wave
+   USE diatmb          ! Top,middle,bottom output
+#if defined key_agrif
+   USE agrif_opa_interp ! agrif
+#endif
+#if defined key_asminc
+   USE asminc          ! Assimilation increment
+#endif
+   !
    USE in_out_manager  ! I/O manager
 …
    USE iom             ! IOM library
    USE restart         ! only for lrst_oce
-   USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
-   USE diatmb          ! Top,middle,bottom output
-#if defined key_agrif
-   USE agrif_opa_interp ! agrif
-#endif
-#if defined key_asminc
-   USE asminc          ! Assimilation increment
-#endif
    IMPLICIT NONE
 …
    PUBLIC ts_rst            !    "      "     "    "
-   INTEGER, SAVE :: icycle  ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro
-   REAL(wp),SAVE :: rdtbt   ! Barotropic time step
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   wgtbtp1, wgtbtp2   !: 1st & 2nd weights used in time filtering of barotropic fields
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          !: ff_f/h at F points
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   !: triad of coriolis parameter
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   !: (only used with een vorticity scheme)
    !! Time filtered arrays at baroclinic time step:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv     !: Advection vel. at "now" barocl. step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv   !: Advection vel. at "now" barocl. step
+   INTEGER , SAVE ::   icycle   ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro
+   REAL(wp), SAVE ::   rdtbt    ! Barotropic time step
+   !
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz                 ! ff_f/h at F points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne          ! triad of coriolis parameter
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse          ! (only used with een vorticity scheme)
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! local ratios
+   REAL(wp) ::   r1_8  = 0.125_wp         !
+   REAL(wp) ::   r1_4  = 0.25_wp          !
+   REAL(wp) ::   r1_2  = 0.5_wp           !
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.5 , NEMO Consortium (2013)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
       INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      !
-      LOGICAL  ::   ll_fw_start        ! if true, forward integration
-      LOGICAL  ::   ll_init             ! if true, special startup of 2d equations
-      LOGICAL  ::   ll_tmp1, ll_tmp2            ! local logical variables used in W/D
       INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices
+      INTEGER  ::   ikbu, ikbv, noffset      ! local integers
+      INTEGER  ::   iktu, iktv               ! local integers
+      REAL(wp) ::   zmdi
+      REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf    ! local scalars
+      REAL(wp) ::   zx1, zy1, zx2, zy2          !   -      -
+      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2  !   -      -
+      REAL(wp) ::   zu_spg, zv_spg              !   -      -
+      REAL(wp) ::   zhura, zhvra          !   -      -
+      REAL(wp) ::   za0, za1, za2, za3    !   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e
+      REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc
+      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv
+      REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e
+      REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a
+      REAL(wp), POINTER, DIMENSION(:,:) :: zhf
+      REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy                 ! Wetting/Dying gravity filter coef.
+      LOGICAL  ::   ll_fw_start           ! =T : forward integration
+      LOGICAL  ::   ll_init               ! =T : special startup of 2d equations
+      LOGICAL  ::   ll_tmp1, ll_tmp2      ! local logical variables used in W/D
+      INTEGER  ::   ikbu, iktu, noffset   ! local integers
+      INTEGER  ::   ikbv, iktv            !   -      -
+      REAL(wp) ::   z1_2dt_b, z2dt_bf        ! local scalars
+      REAL(wp) ::   zx1, zx2, zu_spg, zhura  !   -      -
+      REAL(wp) ::   zy1, zy2, zv_spg, zhvra  !   -      -
+      REAL(wp) ::   za0, za1, za2, za3       !   -      -
+      REAL(wp) ::   zmdi, zztmp              !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e, zhf
+      REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zssh_frc
+      REAL(wp), DIMENSION(jpi,jpj) :: zwy, zv_trd, zv_frc, zhdiv
+      REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhust_e
+      REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zhvst_e
+      REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v   ! top/bottom stress at u- & v-points
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zcpx, zcpy   ! Wetting/Dying gravity filter coef.
       !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_ts')
+      !
+      !                                         !* Allocate temporary arrays
+      CALL wrk_alloc( jpi,jpj,   zsshp2_e, zhdiv )
+      CALL wrk_alloc( jpi,jpj,   zu_trd, zv_trd)
+      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc)
+      CALL wrk_alloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e)
+      CALL wrk_alloc( jpi,jpj,   zsshu_a, zsshv_a                  )
+      CALL wrk_alloc( jpi,jpj,   zhf )
+      IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy )
+      IF( nn_timing == 1 )   CALL timing_start('dyn_spg_ts')
+      !
+      IF( ln_wd ) ALLOCATE( zcpx(jpi,jpj), zcpy(jpi,jpj) )
+      !
       zmdi=1.e+20                               !  missing data indicator for masking
+      !                                         !* Local constant initialization
+      z1_12 = 1._wp / 12._wp
+      z1_8  = 0.125_wp
+      z1_4  = 0.25_wp
+      z1_2  = 0.5_wp
+      zraur = 1._wp / rau0
+      !
       !                                            ! reciprocal of baroclinic time step
       IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt
 …
          CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
+         !
+      ENDIF
+      !
+      IF( ln_isfcav ) THEN    ! top+bottom friction (ocean cavities)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
+               zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) )
+            END DO
+         END DO
+      ELSE                    ! bottom friction only
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
+               zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
+            END DO
+         END DO
       ENDIF
+      !
 …
 !!gm
 !!
               IF ( .not. ln_sco ) THEN
+              IF( .NOT.ln_sco ) THEN
    !!gm  agree the JC comment  : this should be done in a much clear way
 …
       IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN
          ll_fw_start=.FALSE.
          CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2)
+         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
       ENDIF
 …
                zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                ! energy conserving formulation for planetary vorticity term
                zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
                zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+               zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
             END DO
          END DO
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
+               zy1 =   r1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
                  &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
                zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
+               zx1 = - r1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
                  &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+               zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
                 &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
                 &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
                 &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
                zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
+               zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
                 &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
                 &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
 …
       !                                   ! ----------------------------------------------------
       IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient
         IF( ln_wd ) THEN                        ! Calculating and applying W/D gravity filters
            DO jj = 2, jpjm1
               DO ji = 2, jpim1
                 ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
                      &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
                      &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+         IF( ln_wd ) THEN                        ! Calculating and applying W/D gravity filters
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                     &      MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
+                     &      MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
                      &                                                         > rn_wdmin1 + rn_wdmin2
+                ll_tmp2 = ( ABS( sshn(ji+1,jj)             -   sshn(ji  ,jj))  > 1.E-12 ).AND.( &
+                     &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(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  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
+                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                              &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+                ELSE
+                  zcpx(ji,jj) = 0._wp
+                END IF
+                ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                  ll_tmp2 = ( ABS( sshn(ji+1,jj)             -   sshn(ji  ,jj))  > 1.E-12 ).AND.( &
+                     &      MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                     &      MAX( -ht_wd(ji,jj)               , -ht_wd(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  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
+                     zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                        &             / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+                  ELSE
+                     zcpx(ji,jj) = 0._wp
+                  ENDIF
+                  !
+                  ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
                      &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
                      &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
                      &                                                         > rn_wdmin1 + rn_wdmin2
                 ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1))  > 1.E-12 ).AND.( &
+                  ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1))  > 1.E-12 ).AND.( &
                      &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
                      &    MAX( -ht_wd(ji,jj)               , -ht_wd(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  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
                   zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
                               &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
                 ELSE
                   zcpy(ji,jj) = 0._wp
                 END IF
               END DO
            END DO
            DO jj = 2, jpjm1
               DO ji = 2, jpim1
                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
                         &                        * r1_e1u(ji,jj) * zcpx(ji,jj)
                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
                         &                        * r1_e2v(ji,jj) * zcpy(ji,jj)
               END DO
            END DO
+                     !
+                  IF(ll_tmp1) THEN
+                     zcpy(ji,jj) = 1.0_wp
+                  ELSE IF(ll_tmp2) THEN
+                     ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
+                     zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                        &             / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
+                  ELSE
+                     zcpy(ji,jj) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+            !
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
+                     &                            * r1_e1u(ji,jj) * zcpx(ji,jj)
+                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
+                     &                            * r1_e2v(ji,jj) * zcpy(ji,jj)
+               END DO
+            END DO
+            !
          ELSE
            DO jj = 2, jpjm1
               DO ji = fs_2, fs_jpim1   ! vector opt.
                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj)
               END DO
            END DO
         ENDIF
       ENDIF
+            !
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
+                  zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj)
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
       DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend
          DO ji = fs_2, fs_jpim1
 …
       END DO
+      !
       !                 ! Add bottom stress contribution from baroclinic velocities:
       IF (ln_bt_fw) THEN
+      !                 ! Add BOTTOM stress contribution from baroclinic velocities:
+      IF( ln_bt_fw ) THEN
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
 …
       ! Note that the "unclipped" bottom friction parameter is used even with explicit drag
       IF( ln_wd ) THEN
+        zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:)
+        zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:)
+         zztmp = - 1._wp / rdtbt
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zu_frc(ji,jj) = zu_frc(ji,jj) + MAX( r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp ) * zwx(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + MAX( r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp ) * zwy(ji,jj)
+            END DO
+         END DO
       ELSE
+        zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:)
+        zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj)
+            END DO
+         END DO
       END IF
+      !
+      !                                         ! Add top stress contribution from baroclinic velocities:
+      IF( ln_bt_fw ) THEN
+      IF( ln_isfcav ) THEN       ! Add TOP stress contribution from baroclinic velocities:
+         IF( ln_bt_fw ) THEN
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  iktu = miku(ji,jj)
+                  iktv = mikv(ji,jj)
+                  zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities
+                  zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
+               END DO
+            END DO
+         ELSE
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  iktu = miku(ji,jj)
+                  iktv = mikv(ji,jj)
+                  zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities
+                  zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Note that the "unclipped" top friction parameter is used even with explicit drag
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zwx(ji,jj)
+               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zwy(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      IF( ln_bt_fw ) THEN                        ! Add wind forcing
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities
+               zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
+               zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj)
+               zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj)
             END DO
          END DO
       ELSE
+         zztmp = r1_rau0 * r1_2
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities
+               zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      ! Note that the "unclipped" top friction parameter is used even with explicit drag
+      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:)
+      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:)
+      !
+      IF (ln_bt_fw) THEN                        ! Add wind forcing
+         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:)
+         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:)
+      ELSE
+         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:)
+         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:)
+               zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj)
+               zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj)
+            END DO
+         END DO
       ENDIF
+      !
       IF ( ln_apr_dyn ) THEN                    ! Add atm pressure forcing
          IF (ln_bt_fw) THEN
+      IF( ln_apr_dyn ) THEN                     ! Add atm pressure forcing
+         IF( ln_bt_fw ) THEN
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
 …
             END DO
          ELSE
+            zztmp = grav * r1_2
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
                       &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
                   zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
                       &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+                  zu_spg = zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
+                      &             + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+                  zv_spg = zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
+                      &             + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
                   zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
                   zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
 …
       !                                         ! Surface net water flux and rivers
       IF (ln_bt_fw) THEN
          zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
+         zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
       ELSE
+         zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
+                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
+         zztmp = r1_rau0 * r1_2
+         zssh_frc(:,:) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
+                &                 + fwfisf(:,:) + fwfisf_b(:,:)                     )
       ENDIF
+      !
 …
             DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points
                DO ji = 2, fs_jpim1   ! Vector opt.
                   zwx(ji,jj) = z1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     &
+                  zwx(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     &
                      &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
                      &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )
                   zwy(ji,jj) = z1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     &
+                  zwy(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     &
                      &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
                      &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )
 …
             DO jj = 2, jpjm1
                DO ji = 2, jpim1      ! NO Vector Opt.
                   zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
+                  zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
                      &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
                      &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
                   zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
+                  zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
                      &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
                      &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
 …
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
                   zx1 = z1_2 * ssumask(ji  ,jj) *  r1_e1e2u(ji  ,jj)    &
+                  zx1 = r1_2 * ssumask(ji  ,jj) *  r1_e1e2u(ji  ,jj)    &
                      &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
                      &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
                   zy1 = z1_2 * ssvmask(ji  ,jj) *  r1_e1e2v(ji  ,jj  )  &
+                  zy1 = r1_2 * ssvmask(ji  ,jj) *  r1_e1e2v(ji  ,jj  )  &
                      &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
                      &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
 …
                   zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
                   zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
                   zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+                  zu_trd(ji,jj) = r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+                  zv_trd(ji,jj) =-r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
                END DO
             END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
+                  zy1 =   r1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
                    &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
                   zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
+                  zx1 = - r1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
                    &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+                  zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
                      &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
                      &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
                      &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
                   zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
+                  zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
                      &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
                      &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
 …
          ENDIF
+         !
+         ! Add bottom stresses:
+         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:)
+         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
+         !
+         ! Add top stresses:
+         zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:)
+         zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! Add top/bottom stresses:
+!!gm old/new
+               zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
+               zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
+!!gm
+            END DO
+         END DO
+         !
          ! Surface pressure trend:
 …
          vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:)
       ELSE
          un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:)
          vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:)
+         un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:)
+         vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:)
       END IF
 …
          DO jj = 1, jpjm1
             DO ji = 1, jpim1      ! NO Vector Opt.
                zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) &
+               zsshu_a(ji,jj) = r1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) &
                   &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)    &
                   &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
                zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) &
+               zsshv_a(ji,jj) = r1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) &
                   &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )    &
                   &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
 …
       IF( lrst_oce .AND.ln_bt_fw )   CALL ts_rst( kt, 'WRITE' )
+      !
+      CALL wrk_dealloc( jpi,jpj,   zsshp2_e, zhdiv )
+      CALL wrk_dealloc( jpi,jpj,   zu_trd, zv_trd )
+      CALL wrk_dealloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc )
+      CALL wrk_dealloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e )
+      CALL wrk_dealloc( jpi,jpj,   zsshu_a, zsshv_a                                   )
+      CALL wrk_dealloc( jpi,jpj,   zhf )
+      IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy )
+      IF( ln_wd )   DEALLOCATE( zcpx, zcpy )
+      !
       IF ( ln_diatmb ) THEN
 …
       INTEGER  ::   ji ,jj              ! dummy loop indices
       REAL(wp) ::   zxr2, zyr2, zcmax   ! local scalar
       REAL(wp), POINTER, DIMENSION(:,:) ::   zcu
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcu
       !!----------------------------------------------------------------------
+      !
       ! Max courant number for ext. grav. waves
+      !
-      CALL wrk_alloc( jpi,jpj,   zcu )
+      !
       DO jj = 1, jpj
 …
       ENDIF
+      !
-      CALL wrk_dealloc( jpi,jpj,   zcu )
+      !
    END SUBROUTINE dyn_spg_ts_init

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

-                      r7753
+                      r8215
    !! History :  1.0  !  2005-11  (G. Madec)  Original code
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    !!   dyn_zdf       : Update the momentum trend with the vertical diffusion
    !!   dyn_zdf_init  : initializations of the vertical diffusion scheme
+   !!            4.0  !  2017-06  (G. Madec) remove the explicit time-stepping option + avm at t-point
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf       : compute the after velocity through implicit calculation of vertical mixing
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
+   USE phycst         ! physical constants
    USE dom_oce        ! ocean space and time domain variables
+   USE sbc_oce        ! surface boundary condition: ocean
    USE zdf_oce        ! ocean vertical physics variables
+   USE dynzdf_exp     ! vertical diffusion: explicit (dyn_zdf_exp     routine)
+   USE dynzdf_imp     ! vertical diffusion: implicit (dyn_zdf_imp     routine)
+   USE zdfdrg         ! vertical physics: top/bottom drag coef.
+   USE dynadv    ,ONLY: ln_dynadv_vec    ! dynamics: advection form
+   USE dynldf    ,ONLY: nldf, np_lap_i   ! dynamics: type of lateral mixing
+   USE dynldf_iso,ONLY: akzu, akzv       ! dynamics: vertical component of rotated lateral mixing
    USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
    USE trd_oce        ! trends: ocean variables
 …
    USE lib_mpp        ! MPP library
    USE prtctl         ! Print control
-   USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
 …
    PRIVATE
+   PUBLIC   dyn_zdf       !  routine called by step.F90
+   PUBLIC   dyn_zdf_init  !  routine called by opa.F90
+   INTEGER  ::   nzdf = 0   ! type vertical diffusion algorithm used, defined from ln_zdf... namlist logicals
+   PUBLIC   dyn_zdf   !  routine called by step.F90
+   REAL(wp) ::  r_vvl     ! non-linear free surface indicator: =0 if ln_linssh=T, =1 otherwise
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 …
       !!                  ***  ROUTINE dyn_zdf  ***
       !!
+      !! ** Purpose :   compute the vertical ocean dynamics physics.
+      !! ** Purpose :   compute the trend due to the vert. momentum diffusion
+      !!              together with the Leap-Frog time stepping using an
+      !!              implicit scheme.
+      !!
+      !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing
+      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf.
+      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise
+      !!               - update the after velocity with the implicit vertical mixing.
+      !!      This requires to solver the following system:
+      !!         ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ]
+      !!      with the following surface/top/bottom boundary condition:
+      !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2)
+      !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90)
+      !!
+      !! ** Action :   (ua,va)   after velocity
       !!---------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      INTEGER , INTENT(in) ::  kt     ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk         ! dummy loop indices
+      INTEGER  ::   iku, ikv           ! local integers
+      REAL(wp) ::   zzwi, ze3ua, zdt   ! local scalars
+      REAL(wp) ::   zzws, ze3va        !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::  zwi, zwd, zws   ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv   !  -      -
       !!---------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )   CALL timing_start('dyn_zdf')
+      !
+      !                                          ! set time step
+      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
+      !                             !* set time step
       IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdt (restart with Euler time stepping)
       ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdt (leapfrog)
       ENDIF
       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )
+      IF( l_trddyn )   THEN         !* temporary save of ta and sa trends
+         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) )
          ztrdu(:,:,:) = ua(:,:,:)
          ztrdv(:,:,:) = va(:,:,:)
       ENDIF
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      !
+      CASE ( 0 )   ;   CALL dyn_zdf_exp( kt, r2dt )      ! explicit scheme
+      CASE ( 1 )   ;   CALL dyn_zdf_imp( kt, r2dt )      ! implicit scheme
+      !
+      END SELECT
+      !
+      !              !==  RHS: Leap-Frog time stepping on all trends but the vertical mixing  ==!   (put in ua,va)
+      !
+      !                    ! time stepping except vertical diffusion
+      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = ( ub(:,:,jk) + r2dt * ua(:,:,jk) ) * umask(:,:,jk)
+            va(:,:,jk) = ( vb(:,:,jk) + r2dt * va(:,:,jk) ) * vmask(:,:,jk)
+         END DO
+      ELSE                                      ! applied on thickness weighted velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  &
+               &          + r2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
+            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  &
+               &          + r2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
+         END DO
+      ENDIF
+      !                    ! add top/bottom friction
+      !     With split-explicit free surface, barotropic stress is treated explicitly Update velocities at the bottom.
+      !     J. Chanut: The bottom stress is computed considering after barotropic velocities, which does
+      !                not lead to the effective stress seen over the whole barotropic loop.
+      !     G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a
+      IF( ln_drgimp .AND. ln_dynspg_ts ) THEN
+         DO jk = 1, jpkm1        ! remove barotropic velocities
+            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk)
+            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk)
+         END DO
+         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points
+               ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
+               ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua
+               va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va
+            END DO
+         END DO
+         IF( ln_isfcav ) THEN    ! Ocean cavities (ISF)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  iku = miku(ji,jj)         ! top ocean level at u- and v-points
+                  ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
+                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)
+                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)
+                  ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua
+                  va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va
+               END DO
+            END DO
+         END IF
+      ENDIF
+      !
+      !              !==  Vertical diffusion on u  ==!
+      !
+      !                    !* Matrix construction
+      zdt = r2dt * 0.5
+      IF( nldf == np_lap_i ) THEN   ! rotated lateral mixing: add its vertical mixing (akzu)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point
+                  zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   &
+                     &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
+                  zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   &
+                     &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
+                  zwi(ji,jj,jk) = zzwi
+                  zws(ji,jj,jk) = zzws
+                  zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+               END DO
+            END DO
+         END DO
+      ELSE                          ! standard case
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point
+                  zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  )
+                  zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)
+                  zwi(ji,jj,jk) = zzwi
+                  zws(ji,jj,jk) = zzws
+                  zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+      DO jj = 2, jpjm1     !* Surface boundary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END DO
+      END DO
+      !
+      !              !==  Apply semi-implicit bottom friction  ==!
+      !
+      !     Only needed for semi-implicit bottom friction setup. The explicit
+      !     bottom friction has been included in "u(v)a" which act as the R.H.S
+      !     column vector of the tri-diagonal matrix equation
+      !
+      IF ( ln_drgimp ) THEN      ! implicit bottom friction
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
+               zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
+            END DO
+         END DO
+         IF ( ln_isfcav ) THEN   ! top friction (always implicit)
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed
+                  iku = miku(ji,jj)       ! ocean top level at u- and v-points
+                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point
+                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
+               END DO
+            END DO
+         END IF
+      ENDIF
+      !
+      ! Matrix inversion starting from the first level
+      !-----------------------------------------------------------------------
+      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+      !
+      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+      !        (        ...               )( ...  ) ( ...  )
+      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+      !
+      !   m is decomposed in the product of an upper and a lower triangular matrix
+      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+      !   The solution (the after velocity) is in ua
+      !-----------------------------------------------------------------------
+      !
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)
+            ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      !              !==  Vertical diffusion on v  ==!
+      !
+      !                       !* Matrix construction
+      zdt = r2dt * 0.5
+      IF( nldf == np_lap_i ) THEN   ! rotated lateral mixing: add its vertical mixing (akzu)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point
+                  zzwi = - zdt * ( avm(ji,jj+1,jk  )+ avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   &
+                     &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
+                  zzws = - zdt * ( avm(ji,jj+1,jk+1)+ avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   &
+                     &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
+                  zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  )
+                  zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1)
+                  zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+               END DO
+            END DO
+         END DO
+      ELSE                          ! standard case
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point
+                  zzwi = - zdt * ( avm(ji,jj+1,jk  )+ avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  )
+                  zzws = - zdt * ( avm(ji,jj+1,jk+1)+ avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)
+                  zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  )
+                  zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1)
+                  zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+      DO jj = 2, jpjm1        !* Surface boundary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END DO
+      END DO
+      !              !==  Apply semi-implicit top/bottom friction  ==!
+      !
+      !     Only needed for semi-implicit bottom friction setup. The explicit
+      !     bottom friction has been included in "u(v)a" which act as the R.H.S
+      !     column vector of the tri-diagonal matrix equation
+      !
+      IF( ln_drgimp ) THEN
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
+               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va
+            END DO
+         END DO
+         IF ( ln_isfcav ) THEN
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
+                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point
+                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va
+               END DO
+            END DO
+         ENDIF
+      ENDIF
+      ! Matrix inversion
+      !-----------------------------------------------------------------------
+      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+      !
+      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+      !        (        ...               )( ...  ) ( ...  )
+      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+      !
+      !   m is decomposed in the product of an upper and lower triangular matrix
+      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+      !   The solution (after velocity) is in 2d array va
+      !-----------------------------------------------------------------------
+      !
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+               &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
          ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:)
          ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:)
          CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt )
          CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )
+         DEALLOCATE( ztrdu, ztrdv )
       ENDIF
       !                                          ! print mean trends (used for debugging)
 …
    END SUBROUTINE dyn_zdf
-   SUBROUTINE dyn_zdf_init
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dyn_zdf_init  ***
-      !!
-      !! ** Purpose :   initializations of the vertical diffusion scheme
-      !!
-      !! ** Method  :   implicit (euler backward) scheme (default)
-      !!                explicit (time-splitting) scheme if ln_zdfexp=T
-      !!----------------------------------------------------------------------
-      USE zdftke
-      USE zdfgls
-      !!----------------------------------------------------------------------
+      !
-      ! Choice from ln_zdfexp read in namelist in zdfini
-      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
-      ELSE                   ;   nzdf = 1           ! use implicit scheme
-      ENDIF
+      !
-      ! Force implicit schemes
-      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE or GLS physics
-      IF( ln_dynldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
-      IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
+      !
-      IF(lwp) THEN                                  ! Print the choice
-         WRITE(numout,*)
-         WRITE(numout,*) 'dyn_zdf_init : vertical dynamics physics scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         IF( nzdf ==  0 )   WRITE(numout,*) '      ===>>   Explicit time-splitting scheme'
-         IF( nzdf ==  1 )   WRITE(numout,*) '      ===>>   Implicit (euler backward) scheme'
-      ENDIF
+      !
-   END SUBROUTINE dyn_zdf_init
    !!==============================================================================
 END MODULE dynzdf

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

r7646	r8215
126	126	INTEGER :: numoni = -1 !: logical unit for Output Namelist Ice
127	127	INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution)
128		INTEGER :: num~~sol = -1 !: logical unit for solver~~ statistics
	128	INTEGER :: numrun = -1 !: logical unit for run statistics
129	129	INTEGER :: numdct_in = -1 !: logical unit for transports computing
130	130	INTEGER :: numdct_vol = -1 !: logical unit for voulume transports output

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

-                      r6493
+                      r8215
    !!======================================================================
    !!                       ***  MODULE  lbclnk  ***
    !! Ocean        : lateral boundary conditions
+   !! NEMO : lateral boundary conditions --- MPP exchanges
    !!=====================================================================
    !! History :  OPA  ! 1997-06  (G. Madec)  Original code
 …
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case
    !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi
+   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size)
+   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather)
    !!----------------------------------------------------------------------
 #if defined key_mpp_mpi
 …
    !!   'key_mpp_mpi'             MPI massively parallel processing library
    !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
+   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!           define the generic interfaces of lib_mpp routines
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
+   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
    !!----------------------------------------------------------------------
    USE lib_mpp        ! distributed memory computing library
 …
    END INTERFACE
    PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
    PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
    PUBLIC   lbc_sum
    PUBLIC   lbc_lnk_e     !
+   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
+   PUBLIC   lbc_sum       ! sum across processors
+   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
    PUBLIC   lbc_lnk_icb   !
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
    !!----------------------------------------------------------------------
    !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!                routines setting the appropriate values
+   !!         on first and last row and column of the global domain
    !!----------------------------------------------------------------------
    !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d
 …
    !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
    USE in_out_manager  ! I/O manager
    USE lbcnfd          ! north fold
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE in_out_manager ! I/O manager
+   USE lbcnfd         ! north fold
    IMPLICIT NONE
 …
       MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d
    END INTERFACE
+   !
    INTERFACE lbc_lnk_e
       MODULE PROCEDURE lbc_lnk_2d_e
 …
       MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple
    END INTERFACE
+   !
    INTERFACE lbc_bdy_lnk
       MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
 …
       REAL , DIMENSION (:,:),  POINTER :: pt2d
    END TYPE arrayptr
+   !
    PUBLIC   arrayptr
    PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
    PUBLIC   lbc_sum       ! ocean/ice  lateral boundary conditions (sum of the overlap region)
    PUBLIC   lbc_lnk_e     !
    PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
+   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
    PUBLIC   lbc_lnk_icb   !
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
    !!   'key_c1d'                                          1D configuration
    !!----------------------------------------------------------------------
+   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case)
+      !!
+      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
+      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
+      !
+   END SUBROUTINE lbc_lnk_3d_gather
+   !!     central point value replicated over the 8 surrounding points
+   !!----------------------------------------------------------------------
    SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
 …
       !! ** Method  :   1D case, the central water column is set everywhere
       !!----------------------------------------------------------------------
       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold
+      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !
       INTEGER  ::   jk     ! dummy loop index
 …
       !!----------------------------------------------------------------------
+      !
       DO jk = 1, jpk
+      DO jk = 1, SIZE( pt3d, 3 )
          ztab = pt3d(2,2,jk)
          pt3d(:,:,jk) = ztab
 …
       !! ** Method  :   1D case, the central water column is set everywhere
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold
       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
 …
    END SUBROUTINE lbc_lnk_2d
-   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
-      !!
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
+      !
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      !
-      DO ii = 1, num_fields
-        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
-      END DO
+      !
-   END SUBROUTINE lbc_lnk_2d_multiple
-   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
-      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      !!---------------------------------------------------------------------
-      !!The first array
-      CALL lbc_lnk( pt2dA, cd_typeA, psgnA )
-      !! Look if more arrays to process
-      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )
-      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )
-      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )
-      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )
-      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )
-      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )
-      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )
-      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )
-   END SUBROUTINE lbc_lnk_2d_9
 #else
    !!----------------------------------------------------------------------
    !!   Default option                           3D shared memory computing
    !!----------------------------------------------------------------------
+   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
+   !!          routines setting land point, or east-west cyclic,
+   !!             or north-south cyclic, or north fold values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
+   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
       !!
       !! ** Method  :   psign = -1 :    change the sign across the north fold
 …
       !!                             for closed boundaries.
       !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
+      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
+      !
+   END SUBROUTINE lbc_lnk_3d_gather
+   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold
+      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !
       REAL(wp) ::   zland
       !!----------------------------------------------------------------------
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
       ELSE                         ;   zland = 0._wp
       ENDIF
+      !
       IF( PRESENT( cd_mpp ) ) THEN
          ! only fill the overlap area and extra allows
 …
       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold
       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
 …
    END SUBROUTINE lbc_lnk_2d
+   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
+      !!
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
+      !                                                               ! = T , U , V , F , W and I points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
+      !                                                               ! =  1. , the sign is kept
+      !
+      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      !
+      DO ii = 1, num_fields
+        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
+#endif
+   !!----------------------------------------------------------------------
+   !!   identical routines in both C1D and shared memory computing cases
+   !!----------------------------------------------------------------------
+   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case)
+      !!
+      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d1 & pt3d2 grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn                 ! sign used across north fold
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
+      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
+      !
+   END SUBROUTINE lbc_lnk_3d_gather
+   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array, type_array, psgn_array, kfld )
+      !!---------------------------------------------------------------------
+      TYPE( arrayptr ), DIMENSION(:), INTENT(inout) ::   pt2d_array   ! pointer array of 2D fields
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! nature of ptab_array grid-points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! sign used across the north fold boundary
+      INTEGER                       , INTENT(in   ) ::   kfld         ! number of 2D fields
+      !
+      INTEGER  ::   jf    !dummy loop index
+      !!---------------------------------------------------------------------
+      !
+      DO jf = 1, kfld
+        CALL lbc_lnk_2d( pt2d_array(jf)%pt2d, type_array(jf), psgn_array(jf) )
       END DO
+      !
    END SUBROUTINE lbc_lnk_2d_multiple
+   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
+   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC,   &
+      &                     pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF,   &
+      &                     pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI,   &
+      &                     cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    ! 2D arrays on which the lbc is applied
       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA ! nature of pt2D. array grid-points
       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA    ! sign used across the north fold
       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
 …
       !!
       !!---------------------------------------------------------------------
+      !!The first array
+      CALL lbc_lnk( pt2dA, cd_typeA, psgnA )
+      !! Look if more arrays to process
+      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )
+      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )
+      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )
+      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )
+      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )
+      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )
+      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )
+      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )
+      !
+                              CALL lbc_lnk( pt2dA, cd_typeA, psgnA )    ! The first array
+      !
+      IF( PRESENT (psgnB) )   CALL lbc_lnk( pt2dB, cd_typeB, psgnB )    ! Look if more arrays to process
+      IF( PRESENT (psgnC) )   CALL lbc_lnk( pt2dC, cd_typeC, psgnC )
+      IF( PRESENT (psgnD) )   CALL lbc_lnk( pt2dD, cd_typeD, psgnD )
+      IF( PRESENT (psgnE) )   CALL lbc_lnk( pt2dE, cd_typeE, psgnE )
+      IF( PRESENT (psgnF) )   CALL lbc_lnk( pt2dF, cd_typeF, psgnF )
+      IF( PRESENT (psgnG) )   CALL lbc_lnk( pt2dG, cd_typeG, psgnG )
+      IF( PRESENT (psgnH) )   CALL lbc_lnk( pt2dH, cd_typeH, psgnH )
+      IF( PRESENT (psgnI) )   CALL lbc_lnk( pt2dI, cd_typeI, psgnI )
+      !
    END SUBROUTINE lbc_lnk_2d_9
+   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_bdy_lnk  ***
+      !!
+      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
+      !!              to maintain the same interface with regards to the mpp case
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold
+      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
+      !
+   END SUBROUTINE lbc_bdy_lnk_3d
+   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_bdy_lnk  ***
+      !!
+      !! ** Purpose :   wrapper rountine to 'lbc_lnk_2d'. This wrapper is used
+      !!              to maintain the same interface with regards to the mpp case
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
+      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
+      !
+   END SUBROUTINE lbc_bdy_lnk_2d
+   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, ki, kj )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
+      !!                special dummy routine to allow for use of halo indexing in mpp case
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
+      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp)
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
+      !
+   END SUBROUTINE lbc_lnk_2d_e
    SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
 …
       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold
       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
 …
       REAL(wp) ::   zland
       !!----------------------------------------------------------------------
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
       ELSE                         ;   zland = 0._wp
       ENDIF
+      !
       IF (PRESENT(cd_mpp)) THEN
          ! only fill the overlap area and extra allows
 …
+         !
       END IF
+      !
    END SUBROUTINE
    SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval )
 …
       !!                this line, nothing is done along the north fold.
       !!----------------------------------------------------------------------
       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
       !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold
+      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !
       REAL(wp) ::   zland
       !!----------------------------------------------------------------------
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
       ELSE                         ;   zland = 0._wp
       ENDIF
+      !
       IF( PRESENT( cd_mpp ) ) THEN
          ! only fill the overlap area and extra allows
 …
             pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:)
             pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:)
             pt3d( 1 ,:,:) = 0.0_wp            ! all points
             pt3d(jpi,:,:) = 0.0_wp
+            pt3d( 1 ,:,:) = 0._wp
+            pt3d(jpi,:,:) = 0._wp
+            !
          CASE DEFAULT                             !**  East closed  --  West closed
 …
+         !
       END IF
+      !
    END SUBROUTINE
-#endif
-   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!              to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign
-      INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
-      !!----------------------------------------------------------------------
+      !
-      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
+      !
-   END SUBROUTINE lbc_bdy_lnk_3d
-   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!              to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign
-      INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
-      !!----------------------------------------------------------------------
+      !
-      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
+      !
-   END SUBROUTINE lbc_bdy_lnk_2d
-   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!                special dummy routine to allow for use of halo indexing in mpp case
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign
-      INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp)
-      INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp)
-      !!----------------------------------------------------------------------
+      !
-      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
+      !
-   END SUBROUTINE lbc_lnk_2d_e
 #endif

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

-                      r7646
+                      r8215
    !!======================================================================
    !! History :  3.2  ! 2009-03  (R. Benshila)  Original code
+   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization
+   !!            3.5  ! 2013-07  (I. Epicoco, S. Mocavero - CMCC) MPP optimization
+   !!            4.0  ! 2017-04  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
    !!----------------------------------------------------------------------
 …
    !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
    !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
    !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP
    !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP
+   !!   mpp_lbc_nfd_3d: North fold treatment for a 3D arrays optimized for MPP
+   !!   mpp_lbc_nfd_2d: North fold treatment for a 2D arrays optimized for MPP
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
 …
       !! ** Action  :   pt3d with updated values along the north fold
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept  if north fold boundary
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-point
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold
+      !
       INTEGER  ::   ji, jk
       INTEGER  ::   ijt, iju, ijpj, ijpjm1
       !!----------------------------------------------------------------------
+      !
       SELECT CASE ( jpni )
       CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
 …
       ijpjm1 = ijpj-1
       DO jk = 1, jpk
+      DO jk = 1, SIZE( pt3d, 3 )
+         !
          SELECT CASE ( npolj )
 …
             SELECT CASE ( cd_type)
             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
                pt3d(:, 1  ,jk) = 0.e0
                pt3d(:,ijpj,jk) = 0.e0
+               pt3d(:, 1  ,jk) = 0._wp
+               pt3d(:,ijpj,jk) = 0._wp
             CASE ( 'F' )                               ! F-point
                pt3d(:,ijpj,jk) = 0.e0
+               pt3d(:,ijpj,jk) = 0._wp
             END SELECT
+            !
 …
       !! ** Action  :   pt2d with updated values along the north fold
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt2d grid-point
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
       INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
+      !
 …
                END DO
             END DO
-         CASE ( 'J' )                                     ! first ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                     ! second ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
          END SELECT
+         !
 …
             END DO
          CASE ( 'I' )                                  ! ice U-V point (I-point)
             pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp
             DO jl = 0, ipr2dj
                DO ji = 2 , jpiglo-1
 …
                END DO
             END DO
-         CASE ( 'J' )                                  ! first ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                  ! second ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)
-               END DO
-            END DO
          END SELECT
+         !
 …
          SELECT CASE ( cd_type)
          CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
             pt2d(:, 1:1-ipr2dj     ) = 0.e0
             pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:, 1:1-ipr2dj     ) = 0._wp
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          CASE ( 'F' )                                   ! F-point
             pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          CASE ( 'I' )                                   ! ice U-V point
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'J' )                                   ! first ice U-V point
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'K' )                                   ! second ice U-V point
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:, 1:1-ipr2dj     ) = 0._wp
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          END SELECT
+         !
 …
       !! ** Action  :   pt3d with updated values along the north fold
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept    if north fold boundary
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl     ! 3D array on which the boundary condition is applied
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji, jk
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d(l/r) grid-point
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold
+      !
+      INTEGER  ::   ji, jk      ! dummy loop indices
+      INTEGER  ::   ipk         ! 3rd dimension of the input array
       INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
       !!----------------------------------------------------------------------
+      !
+      ipk = SIZE( pt3dl, 3 )
+      !
       SELECT CASE ( jpni )
 …
       END SELECT
       ijpjm1 = ijpj-1
+         !
          SELECT CASE ( npolj )
+         !
          CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
             SELECT CASE ( cd_type )
+      !
+      !
+      SELECT CASE ( npolj )
+      !
+      CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( cd_type )
             CASE ( 'T' , 'W' )                         ! T-, W-point
+               IF (nimpp .ne. 1) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+               DO jk = 1, jpk
+               IF ( nimpp /= 1 ) THEN   ;   startloop = 1
+               ELSE                     ;   startloop = 2
+               ENDIF
+               !
+               DO jk = 1, ipk
                   DO ji = startloop, nlci
                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
 …
                END DO
                IF(nimpp .ge. (jpiglo/2+1)) THEN
+               IF( nimpp >= jpiglo/2+1 ) THEN
                  startloop = 1
                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
                  startloop = jpiglo/2+1 - nimpp + 1
                ELSE
                  startloop = nlci + 1
                ENDIF
                IF(startloop .le. nlci) THEN
                  DO jk = 1, jpk
+               IF(startloop <= nlci) THEN
+                 DO jk = 1, ipk
                     DO ji = startloop, nlci
                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
                        jia = ji + nimpp - 1
                        ijta = jpiglo - jia + 2
                        IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
+                       IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
                           pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)
                        ELSE
 …
                  END DO
                ENDIF
+               !
             CASE ( 'U' )                               ! U-point
                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
                   endloop = nlci
                ELSE
                   endloop = nlci - 1
                ENDIF
                DO jk = 1, jpk
+               DO jk = 1, ipk
                   DO ji = 1, endloop
                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
 …
                   ENDIF
                END DO
                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               !
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
                   endloop = nlci
                ELSE
                   endloop = nlci - 1
                ENDIF
                IF(nimpp .ge. (jpiglo/2)) THEN
+               IF( nimpp >= jpiglo/2 ) THEN
                   startloop = 1
                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
+               ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN
                   startloop = jpiglo/2 - nimpp + 1
                ELSE
                   startloop = endloop + 1
                ENDIF
                IF (startloop .le. endloop) THEN
                  DO jk = 1, jpk
+               IF( startloop <= endloop ) THEN
+                 DO jk = 1, ipk
                     DO ji = startloop, endloop
                       iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
                       jia = ji + nimpp - 1
                       ijua = jpiglo - jia + 1
                       IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
+                      IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
                         pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)
                       ELSE
 …
                  END DO
                ENDIF
+               !
             CASE ( 'V' )                               ! V-point
                IF (nimpp .ne. 1) THEN
+               IF( nimpp /= 1 ) THEN
                   startloop = 1
                ELSE
                   startloop = 2
                ENDIF
                DO jk = 1, jpk
+               DO jk = 1, ipk
                   DO ji = startloop, nlci
                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
 …
                END DO
             CASE ( 'F' )                               ! F-point
                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
                   endloop = nlci
                ELSE
                   endloop = nlci - 1
                ENDIF
                DO jk = 1, jpk
+               DO jk = 1, ipk
                   DO ji = 1, endloop
                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
 …
                   ENDIF
                END DO
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( cd_type )
+         END SELECT
+         !
+      CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( cd_type )
             CASE ( 'T' , 'W' )                         ! T-, W-point
                DO jk = 1, jpk
+               DO jk = 1, ipk
                   DO ji = 1, nlci
                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
 …
                   END DO
                END DO
+               !
             CASE ( 'U' )                               ! U-point
                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
                   endloop = nlci
                ELSE
                   endloop = nlci - 1
                ENDIF
                DO jk = 1, jpk
+               DO jk = 1, ipk
                   DO ji = 1, endloop
                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
 …
                   ENDIF
                END DO
+               !
             CASE ( 'V' )                               ! V-point
                DO jk = 1, jpk
+               DO jk = 1, ipk
                   DO ji = 1, nlci
                      ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3
 …
                   END DO
                END DO
                IF(nimpp .ge. (jpiglo/2+1)) THEN
+               !
+               IF( nimpp >= jpiglo/2+1 ) THEN
                   startloop = 1
                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
                   startloop = jpiglo/2+1 - nimpp + 1
                ELSE
                   startloop = nlci + 1
                ENDIF
                IF(startloop .le. nlci) THEN
                  DO jk = 1, jpk
+               IF( startloop <= nlci ) THEN
+                 DO jk = 1, ipk
                     DO ji = startloop, nlci
                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
 …
                  END DO
                ENDIF
+               !
             CASE ( 'F' )                               ! F-point
                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
                   endloop = nlci
                ELSE
                   endloop = nlci - 1
                ENDIF
                DO jk = 1, jpk
+               DO jk = 1, ipk
                   DO ji = 1, endloop
                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
 …
                   ENDIF
                END DO
                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               !
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
                   endloop = nlci
                ELSE
                   endloop = nlci - 1
                ENDIF
                IF(nimpp .ge. (jpiglo/2+1)) THEN
+               IF( nimpp >= jpiglo/2+1 ) THEN
                   startloop = 1
                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
                   startloop = jpiglo/2+1 - nimpp + 1
                ELSE
                   startloop = endloop + 1
                ENDIF
                IF (startloop .le. endloop) THEN
                   DO jk = 1, jpk
+               IF( startloop <= endloop ) THEN
+                  DO jk = 1, ipk
                      DO ji = startloop, endloop
                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
 …
                   END DO
                ENDIF
             END SELECT
          CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
             SELECT CASE ( cd_type)
+               !
+         END SELECT
+         !
+      CASE DEFAULT                           ! *  closed : the code probably never go through
+         !
+         SELECT CASE ( cd_type)
             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
                pt3dl(:, 1  ,jk) = 0.e0
                pt3dl(:,ijpj,jk) = 0.e0
+               pt3dl(:, 1  ,jk) = 0._wp
+               pt3dl(:,ijpj,jk) = 0._wp
             CASE ( 'F' )                               ! F-point
+               pt3dl(:,ijpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+               pt3dl(:,ijpj,jk) = 0._wp
+         END SELECT
+         !
+      END SELECT     !  npolj
+      !
    END SUBROUTINE mpp_lbc_nfd_3d
 …
       !!
       !! ** Purpose :   2D lateral boundary condition : North fold treatment
       !!       without processor exchanges.
+      !!              without processor exchanges.
       !!
       !! ** Method  :
       !!
+      !! ** Action  :   pt2d with updated values along the north fold
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
+      !                                                      ! = T , U , V , F , W points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
+      !                                                      !   = -1. , the sign is changed if north fold boundary
+      !                                                      !   =  1. , the sign is kept  if north fold boundary
+      !! ** Action  :   pt2dl with updated values along the north fold
+      !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl     ! 2D array on which the boundary condition is applied
       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d(l/r) grid-point
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
+      !
       INTEGER  ::   ji
 …
+      !
       ijpjm1 = ijpj-1
+      !
+      !
       SELECT CASE ( npolj )
+      !
 …
+         !
          CASE ( 'T' , 'W' )                               ! T- , W-points
             IF (nimpp .ne. 1) THEN
+            IF( nimpp /= 1 ) THEN
               startloop = 1
             ELSE
 …
               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
             END DO
             IF (nimpp .eq. 1) THEN
               pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2)
             ENDIF
             IF(nimpp .ge. (jpiglo/2+1)) THEN
+            IF( nimpp == 1 ) THEN
+              pt2dl(1,ijpj) = psgn * pt2dl(3,ijpj-2)
+            ENDIF
+            !
+            IF( nimpp >= jpiglo/2+1 ) THEN
                startloop = 1
             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+            ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
                startloop = jpiglo/2+1 - nimpp + 1
             ELSE
 …
             ENDIF
             DO ji = startloop, nlci
                ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
                jia = ji + nimpp - 1
                ijta = jpiglo - jia + 2
                IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
+               IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
                   pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)
                ELSE
 …
                ENDIF
             END DO
+            !
          CASE ( 'U' )                                     ! U-point
             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+            IF( nimpp + nlci - 1 /= jpiglo ) THEN
                endloop = nlci
             ELSE
 …
                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
             END DO
+            !
             IF (nimpp .eq. 1) THEN
               pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2)
 …
               pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2)
             ENDIF
             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+            !
+            IF( nimpp + nlci - 1 /= jpiglo ) THEN
                endloop = nlci
             ELSE
                endloop = nlci - 1
             ENDIF
             IF(nimpp .ge. (jpiglo/2)) THEN
+            IF( nimpp >= jpiglo/2 ) THEN
                startloop = 1
             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
+            ELSEIF( nimpp+nlci-1 >= jpiglo/2 .AND. nimpp < jpiglo/2 ) THEN
                startloop = jpiglo/2 - nimpp + 1
             ELSE
 …
                jia = ji + nimpp - 1
                ijua = jpiglo - jia + 1
                IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
+               IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
                   pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)
                ELSE
 …
                ENDIF
             END DO
+            !
          CASE ( 'V' )                                     ! V-point
             IF (nimpp .ne. 1) THEN
+            IF( nimpp /= 1 ) THEN
               startloop = 1
             ELSE
 …
               pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3)
             ENDIF
+            !
          CASE ( 'F' )                                     ! F-point
             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+            IF( nimpp + nlci - 1 /= jpiglo ) THEN
                endloop = nlci
             ELSE
 …
               pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2)
             ENDIF
+            !
          CASE ( 'I' )                                     ! ice U-V point (I-point)
             IF (nimpp .ne. 1) THEN
+            IF( nimpp /= 1 ) THEN
                startloop = 1
             ELSE
 …
                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
             END DO
+         CASE ( 'J' )                                     ! first ice U-V point
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+         CASE ( 'K' )                                     ! second ice U-V point
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+            !
          END SELECT
+         !
 …
                pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
             END DO
+            !
          CASE ( 'U' )                                     ! U-point
             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+            IF( nimpp + nlci - 1 /= jpiglo ) THEN
                endloop = nlci
             ELSE
 …
                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)
             ENDIF
+            !
          CASE ( 'V' )                                     ! V-point
             DO ji = 1, nlci
 …
                pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
             END DO
             IF(nimpp .ge. (jpiglo/2+1)) THEN
+            IF( nimpp >= jpiglo/2+1 ) THEN
                startloop = 1
             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+            ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
                startloop = jpiglo/2+1 - nimpp + 1
             ELSE
 …
                pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
             END DO
+            !
          CASE ( 'F' )                               ! F-point
             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+            IF( nimpp + nlci - 1 /= jpiglo ) THEN
                endloop = nlci
             ELSE
 …
                 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)
             ENDIF
             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+            !
+            IF( nimpp + nlci - 1 /= jpiglo ) THEN
                endloop = nlci
             ELSE
                endloop = nlci - 1
             ENDIF
             IF(nimpp .ge. (jpiglo/2+1)) THEN
+            IF( nimpp >= jpiglo/2+1 ) THEN
                startloop = 1
             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+            ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
                startloop = jpiglo/2+1 - nimpp + 1
             ELSE
                startloop = endloop + 1
             ENDIF
+            !
             DO ji = startloop, endloop
                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
                pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
             END DO
+            !
          CASE ( 'I' )                                  ! ice U-V point (I-point)
                IF (nimpp .ne. 1) THEN
+               IF( nimpp /= 1 ) THEN
                   startloop = 1
                ELSE
                   startloop = 2
                ENDIF
                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
                   endloop = nlci
                ELSE
 …
                DO ji = startloop , endloop
                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
+               END DO
+         CASE ( 'J' )                                  ! first ice U-V point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop , endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1)
+               END DO
+         CASE ( 'K' )                                  ! second ice U-V point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop, endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)
+               END DO
+                  pt2dl(ji,ijpj) = 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
+               END DO
+               !
          END SELECT
+         !
 …
          SELECT CASE ( cd_type)
          CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
             pt2dl(:, 1     ) = 0.e0
             pt2dl(:,ijpj) = 0.e0
+            pt2dl(:, 1  ) = 0._wp
+            pt2dl(:,ijpj) = 0._wp
          CASE ( 'F' )                                   ! F-point
             pt2dl(:,ijpj) = 0.e0
+            pt2dl(:,ijpj) = 0._wp
          CASE ( 'I' )                                   ! ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'J' )                                   ! first ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'K' )                                   ! second ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+            pt2dl(:, 1  ) = 0._wp
+            pt2dl(:,ijpj) = 0._wp
          END SELECT
+         !

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

-                      r7753
+                      r8215
    !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
    !!                 !  1998  (J.M. Molines) Open boundary conditions
    !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
+   !!   NEMO     1.0  !  2003  (J.M. Molines, G. Madec)  F90, free form
    !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
    !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
 …
    !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables
    !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
+   !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple'
+   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max
+   !!            4.0  !  2017  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
    !!----------------------------------------------------------------------
 …
    !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
    !!   mpprecv       :
    !!   mppsend       :   SUBROUTINE mpp_ini_znl
+   !!   mppsend       :
    !!   mppscatter    :
    !!   mppgather     :
 …
    TYPE arrayptr
       REAL , DIMENSION (:,:),  POINTER :: pt2d
+      REAL(wp), DIMENSION (:,:),  POINTER ::   pt2d
    END TYPE arrayptr
+   !
    PUBLIC   arrayptr
 …
    INTERFACE mpp_sum
       MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
                        mppsum_realdd, mppsum_a_realdd
+         &             mppsum_realdd, mppsum_a_realdd
    END INTERFACE
    INTERFACE mpp_lbc_north
 …
       MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
    END INTERFACE
    INTERFACE mpp_max_multiple
       MODULE PROCEDURE mppmax_real_multiple
 …
    ! variables used in case of sea-ice
    INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd)
    INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology)
    INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
    INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
    INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
+   INTEGER         ::   ngrp_iworld     !  group ID for the world processors (for rheology)
+   INTEGER         ::   ngrp_ice        !  group ID for the ice processors (for rheology)
+   INTEGER         ::   ndim_rank_ice   !  number of 'ice' processors
+   INTEGER         ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_ice     ! dimension ndim_rank_ice
    ! variables used for zonal integration
    INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
    LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
    INTEGER ::   ngrp_znl        ! group ID for the znl processors
    INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row
+   INTEGER         ::   ngrp_znl        !  group ID for the znl processors
+   INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
    ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
    INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors
    INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors
    INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold)
    INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
    INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
    INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line
    INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   nrank_north   ! dimension ndim_rank_north
+   INTEGER, PUBLIC ::   ngrp_world        !: group ID for the world processors
+   INTEGER, PUBLIC ::   ngrp_opa          !: group ID for the opa processors
+   INTEGER, PUBLIC ::   ngrp_north        !: group ID for the northern processors (to be fold)
+   INTEGER, PUBLIC ::   ncomm_north       !: communicator made by the processors belonging to ngrp_north
+   INTEGER, PUBLIC ::   ndim_rank_north   !: number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER, PUBLIC ::   njmppmax          !: value of njmpp for the processors of the northern line
+   INTEGER, PUBLIC ::   north_root        !: number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north
    ! Type of send : standard, buffered, immediate
    CHARACTER(len=1), PUBLIC ::   cn_mpi_send   ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
    LOGICAL, PUBLIC          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
    INTEGER, PUBLIC          ::   nn_buffer     ! size of the buffer in case of mpi_bsend
    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
    LOGICAL, PUBLIC                                  ::   ln_nnogather       ! namelist control of northfold comms
    LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms
+   INTEGER, PUBLIC                                  ::   ityp
+   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I')
+   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend
+   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
+   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
 CONTAINS
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm )
       !!----------------------------------------------------------------------
       !!                  ***  routine mynode  ***
 …
       WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
+      !
       REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
       READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
+      !
       REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
       READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
+      !
       !                              ! control print
       WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
+      !
 #if defined key_agrif
       IF( .NOT. Agrif_Root() ) THEN
 …
       ENDIF
 #endif
+      IF(jpnij < 1)THEN
+         ! If jpnij is not specified in namelist then we calculate it - this
+         ! means there will be no land cutting out.
+         jpnij = jpni * jpnj
+      END IF
+      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+      !
+      IF( jpnij < 1 ) THEN         ! If jpnij is not specified in namelist then we calculate it
+         jpnij = jpni * jpnj       ! this means there will be no land cutting out.
+      ENDIF
+      IF( jpni < 1 .OR. jpnj < 1  ) THEN
          WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;   ii = ii + 1
       ELSE
 …
          WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
          WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1
       END IF
+      ENDIF
       WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
 …
             kstop = kstop + 1
          END SELECT
+      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+         !
+      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN
          WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
          WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
 …
 #if defined key_agrif
       IF (Agrif_Root()) THEN
+      IF( Agrif_Root() ) THEN
          CALL Agrif_MPI_Init(mpi_comm_opa)
       ELSE
 …
       !!
       !! ** Purpose :   Message passing manadgement
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!              between processors following neighboring subdomains.
+      !!                domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn     ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   ipk                        ! 3rd dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ipk = SIZE( ptab, 3 )
+      !
+      ALLOCATE( zt3ns(jpi,jprecj,ipk,2), zt3sn(jpi,jprecj,ipk,2),   &
+         &      zt3ew(jpj,jpreci,ipk,2), zt3we(jpj,jpreci,ipk,2)  )
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING ptab is defined only between nld and nle
+         DO jk = 1, ipk
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)
+               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
+               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
+               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
+               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment
+         !
+         !                                   ! East-West boundaries
+         !                                        !* Cyclic
+         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries
+         !                                        !* cyclic (only with no mpp j-split)
+         IF( nbondj == 2 .AND. jperio == 7 ) THEN
+            ptab(:,1 , :) = ptab(:, jpjm1,:)
+            ptab(:,jpj,:) = ptab(:,     2,:)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         ENDIF
+         !
+      ENDIF
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * ipk
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * ipk
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
+         END DO
+      END SELECT
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE mpp_lnk_3d
+   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, kfld, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_multiple  ***
+      !!
+      !! ** Purpose :   Message passing management for multiple 2d arrays
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing mask
 …
       !!                    noso   : number for local neighboring processors
       !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      !!----------------------------------------------------------------------
+      TYPE( arrayptr ), DIMENSION(:), INTENT(inout) ::   pt2d_array   ! pointer array of 2D fields
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! nature of pt2d_array grid-points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! sign used across the north fold boundary
+      INTEGER                       , INTENT(in   ) ::   kfld         ! number of pt2d arrays
+      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
+      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
+      !
+      INTEGER  ::   ji, jj, jl, jf   ! dummy loop indices
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       REAL(wp) ::   zland
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt2ns(jpi,jprecj,2*kfld), zt2sn(jpi,jprecj,2*kfld),  &
+         &      zt2ew(jpj,jpreci,2*kfld), zt2we(jpj,jpreci,2*kfld)   )
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
 …
       ! 1. standard boundary treatment
       ! ------------------------------
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING ptab is defined only between nld and nle
+         DO jk = 1, jpk
+      !
+      !First Array
+      DO jf = 1 , kfld
+         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+            !
+            ! WARNING pt2d is defined only between nld and nle
             DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
                ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)
                ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
                ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
+               pt2d_array(jf)%pt2d(nldi  :nlei  , jj) = pt2d_array(jf)%pt2d(nldi:nlei, nlej)
+               pt2d_array(jf)%pt2d(1     :nldi-1, jj) = pt2d_array(jf)%pt2d(nldi     , nlej)
+               pt2d_array(jf)%pt2d(nlei+1:nlci  , jj) = pt2d_array(jf)%pt2d(     nlei, nlej)
             END DO
             DO ji = nlci+1, jpi                 ! added column(s) (full)
                ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
                ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
                ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
+               pt2d_array(jf)%pt2d(ji, nldj  :nlej  ) = pt2d_array(jf)%pt2d(nlei, nldj:nlej)
+               pt2d_array(jf)%pt2d(ji, 1     :nldj-1) = pt2d_array(jf)%pt2d(nlei, nldj     )
+               pt2d_array(jf)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(jf)%pt2d(nlei,      nlej)
             END DO
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment
+         !
+         !                                   ! East-West boundaries
+         !                                        !* Cyclic east-west
+         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+            !
+         ELSE                              ! standard close or cyclic treatment
+            !
+            !                                   ! East-West boundaries
+            IF( nbondi == 2 .AND.   &                !* Cyclic
+               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+               pt2d_array(jf)%pt2d(  1  , : ) = pt2d_array(jf)%pt2d( jpim1, : )                             ! west
+               pt2d_array(jf)%pt2d( jpi , : ) = pt2d_array(jf)%pt2d(   2  , : )                             ! east
+            ELSE                                     !* Closed
+               IF( .NOT. type_array(jf) == 'F' )   pt2d_array(jf)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
+                                                   pt2d_array(jf)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
+            ENDIF
+            !                                   ! North-South boundaries
+            !                                        !* Cyclic
+            IF( nbondj == 2 .AND. jperio == 7 ) THEN
+               pt2d_array(jf)%pt2d(:,  1  ) =   pt2d_array(jf)%pt2d(:, jpjm1 )
+               pt2d_array(jf)%pt2d(:, jpj ) =   pt2d_array(jf)%pt2d(:,   2   )
+            ELSE                                     !* Closed
+               IF( .NOT. type_array(jf) == 'F' )   pt2d_array(jf)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
+                                                   pt2d_array(jf)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
+            ENDIF
          ENDIF
+                                          ! North-south cyclic
+         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude
+            ptab(:,1 , :) = ptab(:, jpjm1,:)
+            ptab(:,jpj,:) = ptab(:,     2,:)
+         ELSE   !                                   ! North-South boundaries (closed)
+            IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         ENDIF
+         !
+      ENDIF
+      END DO
       ! 2. East and west directions exchange
 …
       ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT
+      DO jf = 1 , kfld
+         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               zt2ew( : , jl , jf ) = pt2d_array(jf)%pt2d( jpreci+jl , : )
+               zt2we( : , jl , jf ) = pt2d_array(jf)%pt2d( iihom +jl , : )
+            END DO
+         END SELECT
+      END DO
+      !
       !                           ! Migrations
       imigr = jpreci * jpj * jpk
+      imigr = jpreci * jpj
+      !
       SELECT CASE ( nbondi )
       CASE ( -1 )
          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
       CASE ( 1 )
          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CALL mppsend( 2, zt2we(1,1,1), kfld*imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,kfld+1), kfld*imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), kfld*imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), kfld*imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,kfld+1), kfld*imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,kfld+1), kfld*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), kfld*imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,kfld+1), kfld*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
+      !
       !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+      iihom = nlci - jpreci
+      !
+      DO jf = 1 , kfld
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               pt2d_array(jf)%pt2d( iihom+jl ,:) = zt2ew(:,jl,kfld+jf)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jpreci
+               pt2d_array(jf)%pt2d(       jl ,:) = zt2we(:,jl,kfld+jf)
+               pt2d_array(jf)%pt2d( iihom+jl ,:) = zt2ew(:,jl,kfld+jf)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               pt2d_array(jf)%pt2d( jl ,:)= zt2we(:,jl,kfld+jf)
+            END DO
+         END SELECT
+      END DO
       ! 3. North and south directions
       ! -----------------------------
       ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !First Array
+      DO jf = 1 , kfld
+         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               zt2sn(:,jl,jf) = pt2d_array(jf)%pt2d(:, ijhom +jl )
+               zt2ns(:,jl,jf) = pt2d_array(jf)%pt2d(:, jprecj+jl )
+            END DO
+         ENDIF
+      END DO
+      !
       !                           ! Migrations
       imigr = jprecj * jpi * jpk
+      imigr = jprecj * jpi
+      !
       SELECT CASE ( nbondj )
       CASE ( -1 )
          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
       CASE ( 1 )
          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CALL mppsend( 4, zt2sn(1,1,     1), kfld*imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,kfld+1), kfld*imigr, nono )
+         IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,     1), kfld*imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,     1), kfld*imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,kfld+1), kfld*imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,kfld+1), kfld*imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend)   CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,     1), kfld*imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,kfld+1), kfld*imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
+      !
       !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
+         END DO
+      END SELECT
+      ijhom = nlcj - jprecj
+      !
+      DO jf = 1 , kfld
+         SELECT CASE ( nbondj )
+         CASE ( -1 )
+            DO jl = 1, jprecj
+               pt2d_array(jf)%pt2d(:, ijhom+jl ) = zt2ns(:,jl, kfld+jf )
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jprecj
+               pt2d_array(jf)%pt2d(:,       jl ) = zt2sn(:,jl, kfld+jf )
+               pt2d_array(jf)%pt2d(:, ijhom+jl ) = zt2ns(:,jl, kfld+jf )
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jprecj
+               pt2d_array(jf)%pt2d(:,       jl ) = zt2sn(:,jl, kfld+jf )
+            END DO
+         END SELECT
+      END DO
       ! 4. north fold treatment
       ! -----------------------
+      !
       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+      IF( npolj /= 0 .AND. .NOT.PRESENT(cd_mpp) ) THEN
+         !
          SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         CASE ( 1 )
+            DO jf = 1, kfld
+               CALL lbc_nfd( pt2d_array(jf)%pt2d(:,:), type_array(jf), psgn_array(jf) )  ! only 1 northern proc, no mpp
+            END DO
+         CASE DEFAULT
+            CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, kfld )   ! for all northern procs.
          END SELECT
+         !
       ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE mpp_lnk_3d
+   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_multiple  ***
+      !!
+      !! ** Purpose :   Message passing management for multiple 2d arrays
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_2d_multiple
+   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, kfld )
+      !!---------------------------------------------------------------------
+      REAL(wp)        , DIMENSION(:,:), TARGET, INTENT(inout) ::   pt2d         ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type      ! nature of pt2d array grid-points
+      REAL(wp)                                , INTENT(in   ) ::   psgn         ! sign used across the north fold boundary
+      TYPE(arrayptr)  , DIMENSION(:)          , INTENT(inout) ::   pt2d_array   !
+      CHARACTER(len=1), DIMENSION(:)          , INTENT(inout) ::   type_array   ! nature of pt2d_array array grid-points
+      REAL(wp)        , DIMENSION(:)          , INTENT(inout) ::   psgn_array   ! sign used across the north fold boundary
+      INTEGER                                 , INTENT(inout) ::   kfld         !
+      !!---------------------------------------------------------------------
+      !
+      kfld                  =  kfld + 1
+      pt2d_array(kfld)%pt2d => pt2d
+      type_array(kfld)      =  cd_type
+      psgn_array(kfld)      =  psgn
+      !
+   END SUBROUTINE load_array
+   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    ! 2D arrays on which the lbc is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA ! nature of pt2D. array grid-points
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA    ! sign used across the north fold
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER :: kfld
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of pt2d array grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! sign used across the north fold boundary
+      !!---------------------------------------------------------------------
+      !
+      kfld = 0
+      !
+      !                 ! Load the first array
+      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, kfld )
+      !
+      !                 ! Look if more arrays are added
+      IF( PRESENT(psgnB) )   CALL load_array( pt2dB, cd_typeB, psgnB, pt2d_array, type_array, psgn_array, kfld )
+      IF( PRESENT(psgnC) )   CALL load_array( pt2dC, cd_typeC, psgnC, pt2d_array, type_array, psgn_array, kfld )
+      IF( PRESENT(psgnD) )   CALL load_array( pt2dD, cd_typeD, psgnD, pt2d_array, type_array, psgn_array, kfld )
+      IF( PRESENT(psgnE) )   CALL load_array( pt2dE, cd_typeE, psgnE, pt2d_array, type_array, psgn_array, kfld )
+      IF( PRESENT(psgnF) )   CALL load_array( pt2dF, cd_typeF, psgnF, pt2d_array, type_array, psgn_array, kfld )
+      IF( PRESENT(psgnG) )   CALL load_array( pt2dG, cd_typeG, psgnG, pt2d_array, type_array, psgn_array, kfld )
+      IF( PRESENT(psgnH) )   CALL load_array( pt2dH, cd_typeH, psgnH, pt2d_array, type_array, psgn_array, kfld )
+      IF( PRESENT(psgnI) )   CALL load_array( pt2dI, cd_typeI, psgnI, pt2d_array, type_array, psgn_array, kfld )
+      !
+      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, kfld, cd_mpp,pval )
+      !
+   END SUBROUTINE mpp_lnk_2d_9
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for 2d array
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing mask
 …
       !!                    noso   : number for local neighboring processors
       !!                    nono   : number for local neighboring processors
       !!----------------------------------------------------------------------
       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
       !                                                               ! = T , U , V , F , W and I points
       REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
       !                                                               ! =  1. , the sign is kept
       CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
       REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! nature of pt2d array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
       !!
       INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
       REAL(wp) ::   zland
       INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
+         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
 …
       ! ------------------------------
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+            !
+            ! WARNING pt2d is defined only between nld and nle
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
+               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
+               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej)
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
+               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
+               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
+            END DO
+            !
+         ELSE                              ! standard close or cyclic treatment
+            !
+            !                                   ! East-West boundaries
+            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
+               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
+            ELSE                                     ! closed
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
+            ENDIF
+                                                ! Noth-South boundaries
+            IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
+               pt2d_array(ii)%pt2d(:, 1   ) =   pt2d_array(ii)%pt2d(:, jpjm1 )
+               pt2d_array(ii)%pt2d(:, jpj ) =   pt2d_array(ii)%pt2d(:, 2 )
+            ELSE   !
+               !                                   ! North-South boundaries (closed)
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
+            !
+            ENDIF
+          ENDIF
+      END DO
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING pt2d is defined only between nld and nle
+         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)
+            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
+            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
+         END DO
+         DO ji = nlci+1, jpi                 ! added column(s) (full)
+            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
+            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
+            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment
+         !
+         !                                   ! East-West boundaries
+         IF( nbondi == 2 .AND.   &                !* cyclic
+            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            pt2d( 1 ,:) = pt2d(jpim1,:)                                          ! west
+            pt2d(jpi,:) = pt2d(  2  ,:)                                          ! east
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
+                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries
+         !                                        !* cyclic
+         IF( nbondj == 2 .AND. jperio == 7 ) THEN
+            pt2d(:,  1 ) = pt2d(:,jpjm1)
+            pt2d(:, jpj) = pt2d(:,    2)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
+                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+         ENDIF
+      ENDIF
       ! 2. East and west directions exchange
 …
       ! we play with the neigbours AND the row number because of the periodicity
+      !
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
+               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
+            END DO
+         END SELECT
+      END DO
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            zt2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
       !                           ! Migrations
 …
       SELECT CASE ( nbondi )
       CASE ( -1 )
          CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
          CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
          CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
          CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
          CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
       CASE ( 1 )
          CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
          CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
 …
       iihom = nlci - jpreci
+      !
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
+            END DO
+         END SELECT
+      END DO
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+         END DO
+      END SELECT
       ! 3. North and south directions
       ! -----------------------------
       ! always closed : we play only with the neigbours
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
+               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
+            END DO
+         ENDIF
+      END DO
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
       !                           ! Migrations
 …
       SELECT CASE ( nbondj )
       CASE ( -1 )
          CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
          CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
          CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
          CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
          CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
       CASE ( 1 )
          CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
          CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
 …
       ijhom = nlcj - jprecj
+      !
+      DO ii = 1 , num_fields
+         !First Array
+         SELECT CASE ( nbondj )
+         CASE ( -1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
+               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
+            END DO
+         END SELECT
+      END DO
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+         END DO
+      END SELECT
       ! 4. north fold treatment
       ! -----------------------
+      !
-         !First Array
       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
          SELECT CASE ( jpni )
+         CASE ( 1 )     ;
+             DO ii = 1 , num_fields
+                       CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
+             END DO
+         CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs.
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
          END SELECT
+         !
       ENDIF
+        !
+      !
       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_2d_multiple
+   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields )
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
+      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
+      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER                            , INTENT (inout) :: num_fields
+      !!---------------------------------------------------------------------
+      num_fields = num_fields + 1
+      pt2d_array(num_fields)%pt2d => pt2d
+      type_array(num_fields)      =  cd_type
+      psgn_array(num_fields)      =  psgn
+   END SUBROUTINE load_array
+   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER :: num_fields
+      !!---------------------------------------------------------------------
+      !
+      num_fields = 0
+      !
+      ! Load the first array
+      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields )
+      !
+      ! Look if more arrays are added
+      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
+      !
+      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval )
+      !
+   END SUBROUTINE mpp_lnk_2d_9
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for 2d array
+   END SUBROUTINE mpp_lnk_2d
+   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for two 3D arrays
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing mask
 …
       !!                    nono   : number for local neighboring processors
       !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-      !!----------------------------------------------------------------------
+      !
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-      ! 1. standard boundary treatment
-      ! ------------------------------
+      !
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
-         ! WARNING pt2d is defined only between nld and nle
-         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)
-            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
-            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
-         END DO
-         DO ji = nlci+1, jpi                 ! added column(s) (full)
-            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
-            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
-            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
-         END DO
+         !
-      ELSE                              ! standard close or cyclic treatment
+         !
-         !                                   ! East-West boundaries
-         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
-            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
-         ELSE                                     ! closed
-            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
-                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-                                            ! North-South boudaries
-         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-            pt2d(:,  1 ) = pt2d(:,jpjm1)
-            pt2d(:, jpj) = pt2d(:,    2)
-         ELSE
-         !                                   ! North-South boundaries (closed)
-            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
-                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-         ENDIF
-      ENDIF
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
+      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            zt2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
+      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
+      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
+      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,jl,2)
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,jl,2)
-         END DO
-      END SELECT
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
+      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
+      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
+      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
+      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
+      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-         END DO
-      END SELECT
-      ! 4. north fold treatment
-      ! -----------------------
+      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
+         !
-      ENDIF
+      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
-   END SUBROUTINE mpp_lnk_2d
-   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for two 3D arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
       !! ** Action  :   ptab1 and ptab2  with update value at its periphery
       !!
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER  ::   jl   ! dummy loop indices
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptab1     ! 1st 3D array on which the boundary condition is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type1  ! nature of ptab1 arrays
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptab2     ! 3nd 3D array on which the boundary condition is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type2  ! nature of ptab2 arrays
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across the north fold boundary
+      !
+      INTEGER  ::   jl                         ! dummy loop indices
+      INTEGER  ::   ipk                        ! 3rd dimension of the input array
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
 …
       !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
+         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
+      !
+      ipk = SIZE( ptab1, 3 )
+      !
+      ALLOCATE( zt4ns(jpi,jprecj,ipk,2,2), zt4sn(jpi,jprecj,ipk,2,2) ,    &
+         &      zt4ew(jpj,jpreci,ipk,2,2), zt4we(jpj,jpreci,ipk,2,2) )
       ! 1. standard boundary treatment
       ! ------------------------------
       !                                      ! East-West boundaries
       !                                           !* Cyclic east-west
+      !                                           !* Cyclic
       IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
          ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
 …
          ptab2(jpi,:,:) = ptab2(  2  ,:,:)
       ELSE                                        !* closed
+         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
+         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
+                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
+                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+      ENDIF
+                                            ! North-South boundaries
+      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
+         ptab1(:,     1       ,:) = ptab1(: ,  jpjm1 , :)
+         ptab1(:,   jpj       ,:) = ptab1(: ,      2 , :)
+         ptab2(:,     1       ,:) = ptab2(: ,  jpjm1 , :)
+         ptab2(:,   jpj       ,:) = ptab2(: ,      2 , :)
+         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0._wp   ! south except at F-point
+         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0._wp
+                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0._wp   ! north
+                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0._wp
+      ENDIF
+      !                                     ! North-South boundaries
+      !                                           !* cyclic
+      IF( nbondj == 2 .AND. jperio == 7 ) THEN
+         ptab1(:,  1  ,:) = ptab1(:, jpjm1 , :)
+         ptab1(:, jpj ,:) = ptab1(:,   2   , :)
+         ptab2(:,  1  ,:) = ptab2(:, jpjm1 , :)
+         ptab2(:, jpj ,:) = ptab2(:,   2   , :)
       ELSE
       !                                      ! North-South boundaries closed
       IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
       IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
                                     ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
                                     ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
       ENDIF
+         !                                        !* closed
+         IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0._wp   ! south except at F-point
+         IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0._wp
+                                       ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0._wp   ! north
+                                       ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0._wp
+      ENDIF
       ! 2. East and west directions exchange
 …
+      !
       !                           ! Migrations
       imigr = jpreci * jpj * jpk *2
+      imigr = jpreci * jpj * ipk *2
+      !
       SELECT CASE ( nbondi )
 …
          END DO
       END SELECT
       ! 3. North and south directions
 …
+      !
       !                           ! Migrations
       imigr = jprecj * jpi * jpk * 2
+      imigr = jprecj * jpi * ipk * 2
+      !
       SELECT CASE ( nbondj )
 …
          END DO
       END SELECT
       ! 4. north fold treatment
 …
       ! 1. standard boundary treatment
+      ! 1. standard boundary treatment   (CAUTION: the order matters Here !!!! )
       ! ------------------------------
+      ! Order matters Here !!!!
+      !
+                                           ! North-South cyclic
+      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
+         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1)
+      !                                !== North-South boundaries
+      !                                      !* cyclic
+      IF( nbondj == 2 .AND. jperio == 7 ) THEN
+         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1 )
          pt2d(:, jpj   :jpj+jprj) = pt2d ( :, 2         :2+jprj)
+      ELSE
+      !                                      !* North-South boundaries (closed)
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north
+      ENDIF
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      ELSE                                   !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0._wp     ! south except at F-point
+                                      pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0._wp     ! north
+      ENDIF
+      !                                !== East-West boundaries
+      !                                      !* Cyclic east-west
       IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+      ENDIF
+      !
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)              ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)              ! west
+      ELSE                                   !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp  ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp  ! north
+      ENDIF
+      !
       ! north fold treatment
       ! -----------------------
+      ! --------------------
       IF( npolj /= 0 ) THEN
+         !
          SELECT CASE ( jpni )
          CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
          CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
+         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                  , cd_type, psgn             )
          END SELECT
+         !
 …
       END SELECT
       ! 3. North and south directions
       ! -----------------------------
 …
+      !
    END SUBROUTINE mpp_lnk_2d_e
    SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )
 …
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  !  nature of ptab array grid-points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! sign used across the north fold boundary
       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
       REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
       !!
+      !
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
 …
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
       ELSE                         ;   zland = 0.e0      ! zero by default
+      ELSE                         ;   zland = 0._wp     ! zero by default
       ENDIF
 …
       iihom = nlci-jpreci
          DO jl = 1, jpreci
             zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp
             zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp
+            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0._wp
+            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0._wp
          END DO
       END SELECT
 …
       CASE ( -1 )
          DO jl = 1, jpreci
             ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)
+            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)
          END DO
       CASE ( 0 )
 …
       END SELECT
       ! 3. North and south directions
       ! -----------------------------
 …
          ijhom = nlcj-jprecj
          DO jl = 1, jprecj
             zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp
             zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp
+            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:)   ;   ptab(:,ijhom+jl,:) = 0._wp
+            zt3ns(:,jl,:,1) = ptab(:,jl      ,:)   ;   ptab(:,jl      ,:) = 0._wp
          END DO
       ENDIF
 …
       END SELECT
       ! 4. north fold treatment
       ! -----------------------
 …
+      !
    END SUBROUTINE mpp_lnk_sum_3d
    SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
 …
       !!                    noso   : number for local neighboring processors
       !!                    nono   : number for local neighboring processors
-      !!
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! nature of pt2d array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! sign used across the north fold boundary
       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
       REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
 …
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
       ELSE                         ;   zland = 0.e0      ! zero by default
+      ELSE                         ;   zland = 0._wp     ! zero by default
       ENDIF
 …
       END SELECT
       ! 4. north fold treatment
       ! -----------------------
 …
+      !
    END SUBROUTINE mpp_lnk_sum_2d
    SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
 …
       !!                 ***  routine mppmax_a_real  ***
       !!
       !! ** Purpose :   Maximum
       !!
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in   )                  ::   kdim
       REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
+      !! ** Purpose :   Maximum of a 1D array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab
+      INTEGER                  , INTENT(in   ) ::   kdim
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom
+      !
       INTEGER :: ierror, localcomm
 …
       !!                  ***  routine mppmax_real  ***
       !!
       !! ** Purpose :   Maximum
+      !! ** Purpose :   Maximum for each element of a 1D array
       !!
       !!----------------------------------------------------------------------
 …
    END SUBROUTINE mppmax_real
+   SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom  )
+   SUBROUTINE mppmax_real_multiple( pt1d, kdim, kcom  )
       !!----------------------------------------------------------------------
       !!                  ***  routine mppmax_real  ***
 …
       !!
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ???
       INTEGER , INTENT(in   )           ::   NUM
       INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   pt1d   ! 1D arrays
+      INTEGER                  , INTENT(in   ) ::   kdim
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom   ! local communicator
       !!
       INTEGER  ::   ierror, localcomm
+      REAL(wp) , POINTER , DIMENSION(:) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc(NUM , zwork)
+      REAL(wp), DIMENSION(kdim) ::  zwork
+      !!----------------------------------------------------------------------
+      !
       localcomm = mpi_comm_opa
       IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror )
+      ptab = zwork
+      CALL wrk_dealloc(NUM , zwork)
+      CALL mpi_allreduce( pt1d, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
+      pt1d(:) = zwork(:)
+      !
    END SUBROUTINE mppmax_real_multiple
 …
       REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
       REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
       INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
+      INTEGER                      , INTENT(  out) ::   ki, kj  ! index of minimum in global frame
+      !
       INTEGER :: ierror
 …
       !!-----------------------------------------------------------------------
+      !
       zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
       ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1._wp )
+      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1._wp )
+      !
       ki = ilocs(1) + nimpp - 1
 …
       !!
       !!--------------------------------------------------------------------------
       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
       REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
       INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
       !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                  , INTENT(  out) ::   pmin         ! Global minimum of ptab
+      INTEGER                   , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
+      !
       INTEGER  ::   ierror
       REAL(wp) ::   zmin     ! local minimum
 …
       !!-----------------------------------------------------------------------
+      !
       zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
       ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1._wp )
+      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1._wp )
+      !
       ki = ilocs(1) + nimpp - 1
 …
       kk = ilocs(3)
+      !
       zain(1,:)=zmin
       zain(2,:)=ki+10000.*kj+100000000.*kk
+      zain(1,:) = zmin
+      zain(2,:) = ki + 10000.*kj + 100000000.*kk
+      !
       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
 …
       !!-----------------------------------------------------------------------
+      !
       zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
       ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1._wp )
+      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1._wp )
+      !
       ki = ilocs(1) + nimpp - 1
 …
       !!
       !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
+      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
+      !!
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                   , INTENT(  out) ::   pmax         ! Global maximum of ptab
+      INTEGER                    , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
+      !
+      INTEGER  ::   ierror   ! local integer
+      REAL(wp) ::   zmax     ! local maximum
       REAL(wp), DIMENSION(2,1) ::   zain, zaout
       INTEGER , DIMENSION(3)   ::   ilocs
-      INTEGER :: ierror
       !!-----------------------------------------------------------------------
+      !
       zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
       ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1._wp )
+      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1._wp )
+      !
       ki = ilocs(1) + nimpp - 1
 …
       kk = ilocs(3)
+      !
       zain(1,:)=zmax
       zain(2,:)=ki+10000.*kj+100000000.*kk
+      zain(1,:) = zmax
+      zain(2,:) = ki + 10000.*kj + 100000000.*kk
+      !
       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
 …
    SUBROUTINE mpp_comm_free( kcom )
-      !!----------------------------------------------------------------------
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kcom
 …
       !!              and apply lbc north-fold on this sub array. Then we
       !!              scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      !                                                              !   = T ,  U , V , F or W  gridpoints
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold
+      !!                                                             ! =  1. , the sign is kept
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across the north fold
+      !
       INTEGER ::   ji, jj, jr, jk
+      INTEGER ::   ipk                  ! 3rd dimension of the input array
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ijpjm1, ij, iproc
 …
       !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )
+      ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) )
+      ipk = SIZE( pt3d, 3 )
+      !
+      ALLOCATE( ztab (jpiglo,4,ipk), znorthloc(jpi,4,ipk), zfoldwk(jpi,4,ipk), znorthgloio(jpi,4,ipk,jpni) )
+      ALLOCATE( ztabl(jpi   ,4,ipk), ztabr(jpi*jpmaxngh,4,ipk)   )
       ijpj   = 4
       ijpjm1 = 3
+      !
       znorthloc(:,:,:) = 0
       DO jk = 1, jpk
+      znorthloc(:,:,:) = 0._wp
+      DO jk = 1, ipk
          DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
             ij = jj - nlcj + ijpj
 …
+      !
       !                                     ! Build in procs of ncomm_north the znorthgloio
       itaille = jpi * jpk * ijpj
+      itaille = jpi * ipk * ijpj
       IF ( l_north_nogather ) THEN
+         !
         ztabr(:,:,:) = 0
         ztabl(:,:,:) = 0
         DO jk = 1, jpk
+        ztabr(:,:,:) = 0._wp
+        ztabl(:,:,:) = 0._wp
+        DO jk = 1, ipk
            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
               ij = jj - nlcj + ijpj
 …
          DO jr = 1,nsndto
             IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
               CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
             ENDIF
 …
          DO jr = 1,nsndto
             iproc = nfipproc(isendto(jr),jpnj)
             IF(iproc .ne. -1) THEN
+            IF(iproc /= -1) THEN
                ilei = nleit (iproc+1)
                ildi = nldit (iproc+1)
                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
             ENDIF
             IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
               CALL mpprecv(5, zfoldwk, itaille, iproc)
               DO jk = 1, jpk
+              DO jk = 1, ipk
                  DO jj = 1, ijpj
                     DO ji = ildi, ilei
 …
                  END DO
               END DO
            ELSE IF (iproc .eq. (narea-1)) THEN
               DO jk = 1, jpk
+           ELSE IF( iproc == narea-1 ) THEN
+              DO jk = 1, ipk
                  DO jj = 1, ijpj
                     DO ji = ildi, ilei
 …
          IF (l_isend) THEN
             DO jr = 1,nsndto
                IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+                  CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )
                ENDIF
             END DO
          ENDIF
          CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
          DO jk = 1, jpk
+         DO jk = 1, ipk
             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
                ij = jj - nlcj + ijpj
 …
          END DO
+         !
       ELSE
          CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
             &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
          ztab(:,:,:) = 0.e0
+         ztab(:,:,:) = 0._wp
          DO jr = 1, ndim_rank_north         ! recover the global north array
             iproc = nrank_north(jr) + 1
 …
             ilei  = nleit (iproc)
             iilb  = nimppt(iproc)
             DO jk = 1, jpk
+            DO jk = 1, ipk
                DO jj = 1, ijpj
                   DO ji = ildi, ilei
 …
          CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+         !
          DO jk = 1, jpk
+         DO jk = 1, ipk
             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
                ij = jj - nlcj + ijpj
 …
          DO jr = 1,nsndto
             IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
                CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))
+            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+               CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
             ENDIF
          END DO
          DO jr = 1,nsndto
             iproc = nfipproc(isendto(jr),jpnj)
             IF(iproc .ne. -1) THEN
+            IF( iproc /= -1 ) THEN
                ilei = nleit (iproc+1)
                ildi = nldit (iproc+1)
                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
             ENDIF
             IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
               CALL mpprecv(5, zfoldwk, itaille, iproc)
               DO jj = 1, ijpj
 …
                  END DO
               END DO
             ELSE IF (iproc .eq. (narea-1)) THEN
+            ELSEIF( iproc == narea-1 ) THEN
               DO jj = 1, ijpj
                  DO ji = ildi, ilei
 …
             ENDIF
          END DO
          IF (l_isend) THEN
+         IF(l_isend) THEN
             DO jr = 1,nsndto
                IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
                ENDIF
 …
             &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
          ztab(:,:) = 0.e0
+         ztab(:,:) = 0._wp
          DO jr = 1, ndim_rank_north            ! recover the global north array
             iproc = nrank_north(jr) + 1
 …
    END SUBROUTINE mpp_lbc_north_2d
+   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields)
+   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, kfld )
       !!---------------------------------------------------------------------
       !!                   ***  routine mpp_lbc_north_2d  ***
 …
       !!
       !!----------------------------------------------------------------------
+      INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
+      !                                                          !   = T ,  U , V , F or W  gridpoints
+      REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold
+      !!                                                             ! =  1. , the sign is kept
+      TYPE( arrayptr ), DIMENSION(:), INTENT(inout) ::   pt2d_array   ! pointer array of 2D fields
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type      ! nature of pt2d grid-points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn         ! sign used across the north fold
+      INTEGER                       , INTENT(in   ) ::   kfld         ! number of variables contained in pt2d
+      !
       INTEGER ::   ji, jj, jr, jk
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
+      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      INTEGER ::   ijpj, ijpjm1, ij, iproc, iflag
+      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather
+      INTEGER                            ::   ml_err      ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat     ! for mpi_isend when avoiding mpi_allgather
+      !                                                   ! Workspace for message transfers avoiding mpi_allgather
+      INTEGER :: istatus(mpi_status_size)
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields),   &
+            &   znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions
+      ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) )
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,kfld), znorthloc  (jpi,4,kfld),        &
+         &      zfoldwk(jpi,4,kfld), znorthgloio(jpi,4,kfld,jpni),   &
+         &      ztabl  (jpi,4,kfld), ztabr(jpi*jpmaxngh, 4,kfld)   )
+      !
       ijpj   = 4
 …
+      !
       DO jk = 1, num_fields
+      DO jk = 1, kfld
          DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable)
             ij = jj - nlcj + ijpj
 …
          ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
+         !
          ztabr(:,:,:) = 0
          ztabl(:,:,:) = 0
          DO jk = 1, num_fields
+         ztabr(:,:,:) = 0._wp
+         ztabl(:,:,:) = 0._wp
+         DO jk = 1, kfld
             DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
                ij = jj - nlcj + ijpj
 …
          END DO
          DO jr = 1,nsndto
             IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
                CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times
+         DO jr = 1, nsndto
+            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+               CALL mppsend(5, znorthloc, itaille*kfld, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "kfld" times
             ENDIF
          END DO
          DO jr = 1,nsndto
+         DO jr = 1, nsndto
             iproc = nfipproc(isendto(jr),jpnj)
             IF(iproc .ne. -1) THEN
+            IF( iproc /= -1 ) THEN
                ilei = nleit (iproc+1)
                ildi = nldit (iproc+1)
                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
             ENDIF
             IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
               CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times
               DO jk = 1 , num_fields
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+              CALL mpprecv(5, zfoldwk, itaille*kfld, iproc) ! Buffer expanded "kfld" times
+              DO jk = 1 , kfld
                  DO jj = 1, ijpj
                     DO ji = ildi, ilei
 …
                  END DO
               END DO
             ELSE IF (iproc .eq. (narea-1)) THEN
               DO jk = 1, num_fields
+            ELSEIF ( iproc == narea-1 ) THEN
+              DO jk = 1, kfld
                  DO jj = 1, ijpj
                     DO ji = ildi, ilei
 …
             ENDIF
          END DO
          IF (l_isend) THEN
             DO jr = 1,nsndto
                IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+         IF( l_isend ) THEN
+            DO jr = 1, nsndto
+               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
                ENDIF
 …
          ENDIF
+         !
          DO ji = 1, num_fields     ! Loop to manage 3D variables
+         DO ji = 1, kfld     ! Loop to manage 3D variables
             CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition
          END DO
+         !
          DO jk = 1, num_fields
+         DO jk = 1, kfld
             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
                ij = jj - nlcj + ijpj
 …
       ELSE
+         !
          CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        &
             &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
          ztab(:,:,:) = 0.e0
          DO jk = 1, num_fields
+         CALL MPI_ALLGATHER( znorthloc  , itaille*kfld, MPI_DOUBLE_PRECISION,        &
+            &                znorthgloio, itaille*kfld, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:,:) = 0._wp
+         DO jk = 1, kfld
             DO jr = 1, ndim_rank_north            ! recover the global north array
                iproc = nrank_north(jr) + 1
 …
          END DO
          DO ji = 1, num_fields
+         DO ji = 1, kfld
             CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition
          END DO
+         !
          DO jk = 1, num_fields
+         DO jk = 1, kfld
             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
                ij = jj - nlcj + ijpj
 …
    END SUBROUTINE mpp_lbc_north_2d_multiple
    SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
       !!---------------------------------------------------------------------
 …
       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
       CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
+      !                                                                                         !   = T ,  U , V , F or W -points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
+      !!                                                                                        ! north fold, =  1. otherwise
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! sign used across the north fold
+      !
       INTEGER ::   ji, jj, jr
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ij, iproc
+      !
       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
       !!----------------------------------------------------------------------
+      !
       ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) )
+      !
       ijpj=4
       ztab_e(:,:) = 0.e0
       ij=0
+      ztab_e(:,:) = 0._wp
+      ij = 0
       ! put in znorthloc_e the last 4 jlines of pt2d
       DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
          ij = ij + 1
          DO ji = 1, jpi
             znorthloc_e(ji,ij)=pt2d(ji,jj)
+            znorthloc_e(ji,ij) = pt2d(ji,jj)
          END DO
       END DO
+      !
       itaille = jpi * ( ijpj + 2 * jpr2dj )
       CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
          &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      !
       DO jr = 1, ndim_rank_north            ! recover the global north array
          iproc = nrank_north(jr) + 1
          ildi = nldit (iproc)
          ilei = nleit (iproc)
          iilb = nimppt(iproc)
+         ildi  = nldit (iproc)
+         ilei  = nleit (iproc)
+         iilb  = nimppt(iproc)
          DO jj = 1, ijpj+2*jpr2dj
             DO ji = ildi, ilei
 …
          END DO
       END DO
       ! 2. North-Fold boundary conditions
 …
       !!
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type  ! nature of ptab grid point
+      REAL(wp)                  , INTENT(in   ) ::   psgn     ! sign used across the north fold boundary
+      INTEGER                   , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   ipk                        ! 3rd dimension of the input array
       INTEGER  ::   imigr, iihom, ijhom        ! local integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
 …
       !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+      ipk = SIZE( ptab, 3 )
+      !
+      ALLOCATE( zt3ns(jpi,jprecj,ipk,2), zt3sn(jpi,jprecj,ipk,2),   &
+         &      zt3ew(jpj,jpreci,ipk,2), zt3we(jpj,jpreci,ipk,2)  )
       zland = 0._wp
 …
       ! ------------------------------
       !                                   ! East-West boundaries
       !                                        !* Cyclic east-west
+      !                                        !* Cyclic
       IF( nbondi == 2) THEN
          IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
 …
          ENDIF
       ELSEIF(nbondi == -1) THEN
          IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
+         IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland       ! south except F-point
       ELSEIF(nbondi == 1) THEN
          ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
 …
+      !
       !                           ! Migrations
       imigr = jpreci * jpj * jpk
+      imigr = jpreci * jpj * ipk
+      !
       SELECT CASE ( nbondi_bdy(ib_bdy) )
 …
          END DO
       END SELECT
       ! 3. North and south directions
 …
+      !
       !                           ! Migrations
       imigr = jprecj * jpi * jpk
+      imigr = jprecj * jpi * ipk
+      !
       SELECT CASE ( nbondj_bdy(ib_bdy) )
 …
          END DO
       END SELECT
       ! 4. north fold treatment
 …
       !!
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jl             ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! sign used across the north fold boundary
+      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jl                 ! dummy loop indices
       INTEGER  ::   imigr, iihom, ijhom        ! local integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
 …
       ! ------------------------------
       !                                   ! East-West boundaries
       !                                      !* Cyclic east-west
+      !                                         !* Cyclic
       IF( nbondi == 2 ) THEN
          IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
             ptab( 1 ,:) = ptab(jpim1,:)
             ptab(jpi,:) = ptab(  2  ,:)
          ELSE
             IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point
                                       ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+            IF(.NOT.cd_type == 'F' )   ptab(     1       :jpreci,:) = zland    ! south except F-point
+                                       ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
          ENDIF
       ELSEIF(nbondi == -1) THEN
          IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point
+         IF(.NOT.cd_type == 'F' )      ptab(     1       :jpreci,:) = zland    ! south except F-point
       ELSEIF(nbondi == 1) THEN
                                       ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+                                       ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
       ENDIF
       !                                      !* closed
 …
       SELECT CASE ( nbondi_bdy(ib_bdy) )
       CASE ( -1 )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
       CASE ( 1 )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err )
+      CASE ( 1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
       END SELECT
+      !
 …
       SELECT CASE ( nbondj_bdy(ib_bdy) )
       CASE ( -1 )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
       CASE ( 1 )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         IF(l_isend) CALL mpi_wait (ml_req1, ml_stat, ml_err )
+         IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err )
+      CASE ( 1 )
+         IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
       END SELECT
+      !
 …
          END DO
       END SELECT
       ! 4. north fold treatment
 …
       !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in)                         :: ilen, itype
       COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda
       COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb
+      INTEGER                     , INTENT(in)    ::   ilen, itype
+      COMPLEX(wp), DIMENSION(ilen), INTENT(in)    ::   ydda
+      COMPLEX(wp), DIMENSION(ilen), INTENT(inout) ::   yddb
+      !
       REAL(wp) :: zerr, zt1, zt2    ! local work variables
+      INTEGER :: ji, ztmp           ! local scalar
+      INTEGER  :: ji, ztmp           ! local scalar
+      !!---------------------------------------------------------------------
       ztmp = itype   ! avoid compilation warning
 …
       !!                    nono   : number for local neighboring processors
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! sign used across the north fold
       INTEGER                                             , INTENT(in   ) ::   jpri
       INTEGER                                             , INTENT(in   ) ::   jprj
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      !                                                                                 ! = T , U , V , F , W and I points
+      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
+      !!                                                                                ! north boundary, =  1. otherwise
+      !
       INTEGER  ::   jl   ! dummy loop indices
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
 …
+         !
       ELSE                                        !* closed
          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
                                       pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp    ! north
       ENDIF
+      !
 …
          END DO
       END SELECT
+      !
    END SUBROUTINE mpp_lnk_2d_icb
 …
       MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
    END INTERFACE
+   INTERFACE mpp_max_multiple
+      MODULE PROCEDURE mppmax_real_multiple
+   END INTERFACE
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
 …
       WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
    END SUBROUTINE mpp_comm_free
+   SUBROUTINE mppmax_real_multiple( ptab, kdim , kcom  )
+      REAL, DIMENSION(:) ::   ptab   !
+      INTEGER            ::   kdim   !
+      INTEGER, OPTIONAL  ::   kcom   !
+      WRITE(*,*) 'mppmax_real_multiple: You should not have seen this print! error?', ptab(1), kdim
+   END SUBROUTINE mppmax_real_multiple
 #endif
 …
                                CALL FLUSH(numout    )
       IF( numstp     /= -1 )   CALL FLUSH(numstp    )
       IF( numsol     /= -1 )   CALL FLUSH(numsol    )
+      IF( numrun     /= -1 )   CALL FLUSH(numrun    )
       IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
+      !
 …
             WRITE(kout,*)
          ENDIF
          CALL FLUSH(kout)
+         CALL FLUSH( kout )
          STOP 'ctl_opn bad opening'
       ENDIF

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

-                      r7815
+                      r8215
    !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   namsbc_cpl      : coupled formulation namlist
 …
       !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
       !!----------------------------------------------------------------------
       USE zdf_oce,  ONLY : ln_zdfqiao
+      USE zdf_oce,  ONLY : ln_zdfswm
       IMPLICIT NONE
 …
       !                                                      !      Wave mean period     !
       !                                                      ! ========================= !
          IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)
+         IF( srcv(jpr_wper)%laction )   wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)
+      !
       !                                                      ! ========================= !
       !                                                      !  Significant wave height  !
       !                                                      ! ========================= !
          IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)
+         IF( srcv(jpr_hsig)%laction )   hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)
+      !
       !                                                      ! ========================= !
       !                                                      !    Vertical mixing Qiao   !
+      !                                                      !    surface wave mixing    !
       !                                                      ! ========================= !
          IF( srcv(jpr_wnum)%laction .AND. ln_zdfqiao ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)
+         IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm )   wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)
          ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

-                      r7816
+                      r8215
    !!                   shelf
    !!======================================================================
    !! History :  3.2   !  2011-02  (C.Harris  ) Original code isf cav
    !!            X.X   !  2006-02  (C. Wang   ) Original code bg03
    !!            3.4   !  2013-03  (P. Mathiot) Merging + parametrization
+   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
+   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
+   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   sbc_isf        : update sbc under ice shelf
+   !!   sbc_isf       : update sbc under ice shelf
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
    USE eosbn2          ! equation of state
    USE sbc_oce         ! surface boundary condition: ocean fields
    USE zdfbfr          !
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE eosbn2         ! equation of state
+   USE sbc_oce        ! surface boundary condition: ocean fields
+   USE zdfdrg         ! vertical physics: top/bottom drag coef.
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O manager library
    USE fldread         ! read input field at current time step
    USE lbclnk          !
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
    USE lib_fortran     ! glob_sum
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE fldread        ! read input field at current time step
+   USE lbclnk         !
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! glob_sum
    IMPLICIT NONE
 …
 CONTAINS
   SUBROUTINE sbc_isf(kt)
+  SUBROUTINE sbc_isf( kt )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_isf  ***
 …
       INTEGER               :: ji, jj, jk           ! loop index
       INTEGER               :: ikt, ikb             ! loop index
       REAL(wp), DIMENSION (:,:), POINTER :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep)
+      REAL(wp), DIMENSION(jpi,jpj) ::   zt_frz, zdep   ! freezing temperature (zt_frz) at depth (zdep)
       REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d
       REAL(wp), DIMENSION(:,:  ), POINTER :: zqhcisf2d
 …
+      !
       IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
-         ! allocation
-         CALL wrk_alloc( jpi,jpj, zt_frz, zdep  )
          ! compute salt and heat flux
 …
             CALL wrk_dealloc( jpi,jpj,     zqhcisf2d                        )
           END IF
-          ! deallocation
-          CALL wrk_dealloc( jpi,jpj, zt_frz, zdep  )
+          !
         END IF
 …
   END FUNCTION
   SUBROUTINE sbc_isf_init
       !!---------------------------------------------------------------------
 …
       IF ( lwp ) WRITE(numout,*)
+      IF ( lwp ) WRITE(numout,*) 'sbc_isf: heat flux of the ice shelf'
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~~'
+      IF ( lwp ) WRITE(numout,*) 'sbcisf :'
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~'
+      IF ( lwp ) WRITE(numout,*) 'sbc_isf_init : heat flux of the ice shelf'
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~'
       IF ( lwp ) WRITE(numout,*) '        nn_isf      = ', nn_isf
       IF ( lwp ) WRITE(numout,*) '        nn_isfblk   = ', nn_isfblk
 …
       IF ( lwp ) WRITE(numout,*) '        rn_gammat0  = ', rn_gammat0
       IF ( lwp ) WRITE(numout,*) '        rn_gammas0  = ', rn_gammas0
       IF ( lwp ) WRITE(numout,*) '        rn_tfri2    = ', rn_tfri2
+      IF ( lwp ) WRITE(numout,*) '        rn_Cd0      = ', r_Cdmin_top
+      !
       ! Allocate public variable
 …
+      !
       ! initialisation
       qisf(:,:)        = 0._wp  ; fwfisf  (:,:) = 0._wp
       risf_tsc(:,:,:)  = 0._wp  ; fwfisf_b(:,:) = 0._wp
+      qisf    (:,:)    = 0._wp   ;   fwfisf  (:,:) = 0._wp
+      risf_tsc(:,:,:)  = 0._wp   ;   fwfisf_b(:,:) = 0._wp
+      !
       ! define isf tbl tickness, top and bottom indice
 …
       CASE ( 1 )
          rhisf_tbl(:,:) = rn_hisf_tbl
          misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+         misfkt   (:,:) = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
       CASE ( 2 , 3 )
 …
             DO jj = 1, jpj
                 ik = 2
+!!gm potential bug: use gdepw_0 not _n
                 DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw_n(ji,jj,ik) < rzisf_tbl(ji,jj) ) ;  ik = ik + 1 ;  END DO
                 misfkt(ji,jj) = ik-1
 …
          ! as in nn_isf == 1
          rhisf_tbl(:,:) = rn_hisf_tbl
          misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+         misfkt   (:,:) = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
          ! load variable used in fldread (use for temporal interpolation of isf fwf forcing)
 …
             ! determine the deepest level influenced by the boundary layer
             DO jk = ikt+1, mbkt(ji,jj)
                IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+               IF( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) )   ikb = jk
             END DO
             rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness.
 …
   END SUBROUTINE sbc_isf_init
   SUBROUTINE sbc_isf_bg03(kt)
       !!---------------------------------------------------------------------
 …
       !!         interaction for climate models", Ocean Modelling 5(2003) 157-170.
       !!         (hereafter BG)
+      !! History :
+      !!         06-02  (C. Wang) Original code
+      !! History :  06-02  (C. Wang) Original code
       !!----------------------------------------------------------------------
       INTEGER, INTENT ( in ) :: kt
 …
       !!----------------------------------------------------------------------
       IF ( nn_timing == 1 ) CALL timing_start('sbc_isf_bg03')
+      IF( nn_timing == 1 )   CALL timing_start('sbc_isf_bg03')
+      !
       DO ji = 1, jpi
 …
                !add to salinity trend
             ELSE
                qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp
+               qisf(ji,jj) = 0._wp   ;   fwfisf(ji,jj) = 0._wp
             END IF
          END DO
       END DO
+      !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_bg03')
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_isf_bg03')
+      !
   END SUBROUTINE sbc_isf_bg03
   SUBROUTINE sbc_isf_cav( kt )
 …
       !!                emp, emps  : update freshwater flux below ice shelf
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in)          ::   kt         ! ocean time step
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !
       INTEGER  ::   ji, jj     ! dummy loop indices
       INTEGER  ::   nit
+      LOGICAL  ::   lit
       REAL(wp) ::   zlamb1, zlamb2, zlamb3
       REAL(wp) ::   zeps1,zeps2,zeps3,zeps4,zeps6,zeps7
 …
       REAL(wp) ::   zeps = 1.e-20_wp
       REAL(wp) ::   zerr
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfrz
+      REAL(wp), DIMENSION(:,:), POINTER ::   zgammat, zgammas
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfwflx, zhtflx, zhtflx_b
+      LOGICAL  ::   lit
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfrz
+      REAL(wp), DIMENSION(jpi,jpj) ::   zgammat, zgammas
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfwflx, zhtflx, zhtflx_b
       !!---------------------------------------------------------------------
       ! coeficient for linearisation of potential tfreez
 …
       IF( nn_timing == 1 )  CALL timing_start('sbc_isf_cav')
+      !
-      CALL wrk_alloc( jpi,jpj, zfrz  , zgammat, zgammas  )
-      CALL wrk_alloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )
       ! initialisation
       zgammat(:,:) = rn_gammat0 ; zgammas (:,:) = rn_gammas0
 …
       CALL iom_put('isfgammas', zgammas)
+      !
-      CALL wrk_dealloc( jpi,jpj, zfrz  , zgammat, zgammas  )
-      CALL wrk_dealloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_cav')
+      !
 …
       INTEGER  :: ikt
       INTEGER  :: ji, jj                     ! loop index
-      REAL(wp), DIMENSION(:,:), POINTER :: zustar           ! U, V at T point and friction velocity
       REAL(wp) :: zdku, zdkv                 ! U, V shear
       REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number
 …
       REAL(wp), PARAMETER :: znu   = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
       REAL(wp), DIMENSION(2) :: zts, zab
+      REAL(wp), DIMENSION(jpi,jpj) :: zustar   ! U, V at T point and friction velocity
       !!---------------------------------------------------------------------
-      CALL wrk_alloc( jpi,jpj, zustar )
+      !
       SELECT CASE ( nn_gammablk )
 …
          !! Jenkins et al., 2010, JPO, p2298-2312
          !! Adopted by Asay-Davis et al. (2015)
+         !! compute ustar (eq. 24)
+         zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) )
+!!gm  I don't understand the u* expression in those papers... (see for example zdfglf module)
+!!    for me ustar= Cd0 * |U|  not  (Cd0)^1/2 * |U| ....  which is what you can find in Jenkins et al.
+         !! compute ustar (eq. 24)           !! NB: here r_Cdmin_top = rn_Cd0 read in namdrg_top namelist)
+         zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
          !! Compute gammats
 …
          !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO)
          !! compute ustar
          zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) )
+         zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
          !! compute Pr and Sc number (can be improved)
 …
          !! compute gamma
          DO ji=2,jpi
             DO jj=2,jpj
+         DO ji = 2, jpi
+            DO jj = 2, jpj
                ikt = mikt(ji,jj)
                IF (zustar(ji,jj) == 0._wp) THEN           ! only for kt = 1 I think
+               IF( zustar(ji,jj) == 0._wp ) THEN           ! only for kt = 1 I think
                   pgt = rn_gammat0
                   pgs = rn_gammas0
                ELSE
                   !! compute Rc number (as done in zdfric.F90)
+!!gm better to do it like in the new zdfric.F90   i.e. avm weighted Ri computation
+!!gm moreover, use Max(rn2,0) to take care of static instabilities....
                   zcoef = 0.5_wp / e3w_n(ji,jj,ikt)
                   !                                            ! shear of horizontal velocity
 …
          CALL lbc_lnk(pgs(:,:),'T',1.)
       END SELECT
-      CALL wrk_dealloc( jpi,jpj, zustar )
+      !
    END SUBROUTINE sbc_isf_gammats
    SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin )
       !!----------------------------------------------------------------------
 …
       !!
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT( in  ) :: pvarin
+      REAL(wp), DIMENSION(:,:)  , INTENT( out ) :: pvarout
+      CHARACTER(len=1),           INTENT( in  ) :: cd_ptin ! point of variable in/out
+      !
+      REAL(wp) :: ze3, zhk
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) :: pvarin
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) :: pvarout
+      CHARACTER(len=1),           INTENT(in   ) :: cd_ptin ! point of variable in/out
+      !
+      INTEGER ::   ji, jj, jk                ! loop index
+      INTEGER ::   ikt, ikb                    ! top and bottom index of the tbl
+      REAL(wp) ::   ze3, zhk
       REAL(wp), DIMENSION(:,:), POINTER :: zhisf_tbl ! thickness of the tbl
-      INTEGER :: ji, jj, jk                  ! loop index
-      INTEGER :: ikt, ikb                    ! top and bottom index of the tbl
       !!----------------------------------------------------------------------
       ! allocation
 …
                ikt = miku(ji,jj) ; ikb = miku(ji,jj)
                ! thickness of boundary layer at least the top level thickness
                zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3u_n(ji,jj,ikt))
+               zhisf_tbl(ji,jj) = MAX( rhisf_tbl_0(ji,jj) , e3u_n(ji,jj,ikt) )
                ! determine the deepest level influenced by the boundary layer
 …
             END DO
          END DO
+         DO jj = 2,jpj
+            DO ji = 2,jpi
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+!!gm a wet-point only average should be used here !!!
                pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji-1,jj))
             END DO
 …
             END DO
          END DO
+         DO jj = 2,jpj
+            DO ji = 2,jpi
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+!!gm a wet-point only average should be used here !!!
                pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji,jj-1))
             END DO
 …
+      !
    END SUBROUTINE sbc_isf_div
    !!======================================================================
 END MODULE sbcisf

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

-                      r7864
+                      r8215
    USE oce            ! ocean variables
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE zdf_oce,  ONLY : ln_zdfqiao
+   USE zdf_oce,  ONLY : ln_zdfswm
    USE bdy_oce        ! open boundary condition variables
    USE domvvl         ! domain: variable volume layers
 …
+         !
          ! Read also wave number if needed, so that it is available in coupling routines
          IF( ln_zdfqiao .AND. .NOT.cpl_wnum ) THEN
+         IF( ln_zdfswm .AND. .NOT.cpl_wnum ) THEN
             CALL fld_read( kt, nn_fsbc, sf_wn )          ! read wave parameters from external forcing
             wnum(:,:) = sf_wn(1)%fnow(:,:,1)
 …
          vsd(:,:,:) = 0._wp
          wsd(:,:,:) = 0._wp
          ! Wave number needed only if ln_zdfqiao=T
+         ! Wave number needed only if ln_zdfswm=T
          IF( .NOT. cpl_wnum ) THEN
             ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

r7753	r8215
928	928	pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) &
929	929	& - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) &
930		& / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
	930	& / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)
931	931	END DO
932	932	END DO

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

-                      r7753
+                      r8215
    !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
    !!             -   ! 2013-04  (F. Roquet, G. Madec)  use of eosbn2 instead of local hard coded alpha and beta
+   !!            4.0  ! 2017-04  (G. Madec)  ln_trabbl namelist variable instead of a CPP key
    !!----------------------------------------------------------------------
+#if   defined key_trabbl
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl'   or                             bottom boundary layer
    !!----------------------------------------------------------------------
    !!   tra_bbl_alloc : allocate trabbl arrays
 …
    PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag
    !                                !!* Namelist nambbl *
+   LOGICAL , PUBLIC ::   ln_trabbl   !: bottom boundary layer flag
    INTEGER , PUBLIC ::   nn_bbl_ldf  !: =1   : diffusive bbl or not (=0)
    INTEGER , PUBLIC ::   nn_bbl_adv  !: =1/2 : advective bbl or not (=0)
 …
       !!                ***  FUNCTION tra_bbl_alloc  ***
       !!----------------------------------------------------------------------
       ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d  (jpi,jpj) , mgrhu(jpi,jpj) ,     &
          &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     &
          &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          &
          &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                      STAT=tra_bbl_alloc )
+      ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d(jpi,jpj) , mgrhu(jpi,jpj) ,     &
+         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d(jpi,jpj) , mgrhv(jpi,jpj) ,     &
+         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                        &
+         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                    STAT=tra_bbl_alloc )
+         !
       IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc )
 …
       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl')
+      !
       IF( l_trdtra )   THEN                         !* Save the input trends
+      IF( l_trdtra )   THEN                         !* Save the T-S input trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
 …
+            !
          END DO
+         !                                                       ! ===========
+      END DO                                                     ! end tracer
+      !                                                          ! ===========
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      !
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv')
+      !
 …
       INTEGER ::   ios                  !   -      -
       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
+      !
       NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
+      !!
+      NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
       !!----------------------------------------------------------------------
+      !
 …
          WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
          WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist nambbl : set bbl parameters'
+         WRITE(numout,*) '      diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
+         WRITE(numout,*) '      advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
+         WRITE(numout,*) '      diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
+         WRITE(numout,*) '      advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
+      ENDIF
+         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
+         WRITE(numout,*) '          bottom boundary layer flag          ln_trabbl  = ', ln_trabbl
+      ENDIF
+      IF( .NOT.ln_trabbl )   RETURN
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
+         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
+         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
+         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
+      ENDIF
+      !
       !                              ! allocate trabbl arrays
       IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' )
+      !
       IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
       IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
+      !
       !                             !* vertical index of  "deep" bottom u- and v-points
       DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv)
 …
       zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
       CALL wrk_dealloc( jpi, jpj, zmbk )
+      !
       !                                 !* sign of grad(H) at u- and v-points
       mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0
 …
       ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1)
       ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
+      !
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init')
+      !
    END SUBROUTINE tra_bbl_init
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                      No bottom boundary layer scheme
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bbl flag
-CONTAINS
-   SUBROUTINE tra_bbl_init               ! Dummy routine
-   END SUBROUTINE tra_bbl_init
-   SUBROUTINE tra_bbl( kt )              ! Dummy routine
-      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl
-#endif
    !!======================================================================

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

-                      r7753
+                      r8215
    !! Ocean active tracers:  vertical component of the tracer mixing trend
    !!==============================================================================
+   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
+   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !! History :  1.0  !  2005-11  (G. Madec)  Original code
+   !!            3.0  !  2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!            4.0  !  2017-06  (G. Madec)  remove explict time-stepping option
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   tra_zdf       : Update the tracer trend with the vertical diffusion
-   !!   tra_zdf_init  : initialisation of the computation
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
 …
    USE ldftra         ! lateral diffusion: eddy diffusivity
    USE ldfslp         ! lateral diffusion: iso-neutral slope
-   USE trazdf_exp     ! vertical diffusion: explicit (tra_zdf_exp routine)
-   USE trazdf_imp     ! vertical diffusion: implicit (tra_zdf_imp routine)
    USE trd_oce        ! trends: ocean variables
    USE trdtra         ! trends: tracer trend manager
 …
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory allocation
    USE timing         ! Timing
 …
    PRIVATE
+   PUBLIC   tra_zdf        ! routine called by step.F90
+   PUBLIC   tra_zdf_init   ! routine called by nemogcm.F90
+   INTEGER ::   nzdf = 0   ! type vertical diffusion algorithm used (defined from ln_zdf...  namlist logicals)
+   PUBLIC   tra_zdf       ! called by step.F90
+   PUBLIC   tra_zdf_imp   ! called by trczdf.F90
    !! * Substitutions
-#  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
+      !
       INTEGER  ::   jk                   ! Dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!---------------------------------------------------------------------
+      !
 …
+      !
       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
          r2dt =  rdt                          ! = rdt (restarting with Euler time stepping)
+         r2dt =  rdt                                     ! = rdt (restarting with Euler time stepping)
       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
          r2dt = 2. * rdt                      ! = 2 rdt (leapfrog)
       ENDIF
+      !
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         r2dt = 2. * rdt                                 ! = 2 rdt (leapfrog)
+      ENDIF
+      !
+      IF( l_trdtra )   THEN                  !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
+      !
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme
+      END SELECT
+      !                                      !* compute lateral mixing trend and add it to the general trend
+      CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt, tsb, tsa, jpts )
 !!gm WHY here !   and I don't like that !
       ! DRAKKAR SSS control {
 …
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )
          CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )
          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+         DEALLOCATE( ztrdt , ztrds )
       ENDIF
       !                                          ! print mean trends (used for debugging)
 …
    END SUBROUTINE tra_zdf
    SUBROUTINE tra_zdf_init
+   SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, ptb, pta, kjpt )
       !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_zdf_init  ***
+      !!
+      !! ** Purpose :   Choose the vertical mixing scheme
+      !!
+      !! ** Method  :   Set nzdf from ln_zdfexp
+      !!      nzdf = 0   explicit (time-splitting) scheme (ln_zdfexp=T)
+      !!           = 1   implicit (euler backward) scheme (ln_zdfexp=F)
+      !!      NB: rotation of lateral mixing operator or TKE & GLS schemes,
+      !!          an implicit scheme is required.
+      !!----------------------------------------------------------------------
+      USE zdftke
+      USE zdfgls
+      !!----------------------------------------------------------------------
+      !
+      ! Choice from ln_zdfexp already read in namelist in zdfini module
+      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
+      ELSE                   ;   nzdf = 1           ! use implicit scheme
+      ENDIF
+      !
+      ! Force implicit schemes
+      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics
+      IF( ln_traldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
+      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
+            &                         ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
+            !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf ==  0 )   WRITE(numout,*) '      ===>>   Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '      ===>>   Implicit (euler backward) scheme'
+      ENDIF
+      !
+   END SUBROUTINE tra_zdf_init
+      !!                  ***  ROUTINE tra_zdf_imp  ***
+      !!
+      !! ** Purpose :   Compute the after tracer through a implicit computation
+      !!     of the vertical tracer diffusion (including the vertical component
+      !!     of lateral mixing (only for 2nd order operator, for fourth order
+      !!     it is already computed and add to the general trend in traldf)
+      !!
+      !! ** Method  :  The vertical diffusion of a tracer ,t , is given by:
+      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=after field)
+      !!      which provide directly the after tracer field.
+      !!      If ln_zdfddm=T, use avs for salinity or for passive tracers
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      If iso-neutral mixing, add to avt the contribution due to lateral mixing.
+      !!
+      !! ** Action  : - pta  becomes the after tracer
+      !!---------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zrhs             ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwi, zwt, zwd, zws
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
+         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !                                               ! ============= !
+      DO jn = 1, kjpt                                 !  tracer loop  !
+         !                                            ! ============= !
+         !  Matrix construction
+         ! --------------------
+         ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer
+         !
+         IF(  ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. ln_zdfddm ) ) ) .OR.   &
+            & ( cdtype == 'TRC' .AND. jn == 1 )  )  THEN
+            !
+            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
+            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt(:,:,2:jpk)
+            ELSE                                            ;   zwt(:,:,2:jpk) = avs(:,:,2:jpk)
+            ENDIF
+            zwt(:,:,1) = 0._wp
+            !
+            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution
+               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)
+                        END DO
+                     END DO
+                  END DO
+               ELSE                          ! standard or triad iso-neutral operator
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            ENDIF
+            !
+            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+!!gm BUG  I think, use e3w_a instead of e3w_n, not sure of that
+                     zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  )
+                     zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1)
+                     zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk)
+                 END DO
+               END DO
+            END DO
+            !
+            !! Matrix inversion from the first level
+            !!----------------------------------------------------------------------
+            !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+            !
+            !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+            !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+            !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+            !        (        ...               )( ...  ) ( ...  )
+            !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+            !
+            !   m is decomposed in the product of an upper and lower triangular matrix.
+            !   The 3 diagonal terms are in 3d arrays: zwd, zws, zwi.
+            !   Suffices i,s and d indicate "inferior" (below diagonal), diagonal
+            !   and "superior" (above diagonal) components of the tridiagonal system.
+            !   The solution will be in the 4d array pta.
+            !   The 3d array zwt is used as a work space array.
+            !   En route to the solution pta is used a to evaluate the rhs and then
+            !   used as a work space array: its value is modified.
+            !
+            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction)
+                  zwt(ji,jj,1) = zwd(ji,jj,1)
+               END DO
+            END DO
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+                  END DO
+               END DO
+            END DO
+            !
+         ENDIF
+         !
+         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+            DO ji = fs_2, fs_jpim1
+               pta(ji,jj,1,jn) = e3t_b(ji,jj,1) * ptb(ji,jj,1,jn) + p2dt * e3t_n(ji,jj,1) * pta(ji,jj,1,jn)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zrhs = e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * e3t_n(ji,jj,jk) * pta(ji,jj,jk,jn)   ! zrhs=right hand side
+                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
+               END DO
+            END DO
+         END DO
+         !
+         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
+            DO ji = fs_2, fs_jpim1
+               pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+            END DO
+         END DO
+         DO jk = jpk-2, 1, -1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
+                     &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                            ! ================= !
+      END DO                                          !  end tracer loop  !
+      !                                               ! ================= !
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp')
+      !
+   END SUBROUTINE tra_zdf_imp
    !!==============================================================================

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90

r7646	r8215
72	72	INTEGER, PUBLIC, PARAMETER :: jpdyn_atf = 10 !: Asselin time filter
73	73	INTEGER, PUBLIC, PARAMETER :: jpdyn_tau = 11 !: surface stress
74		INTEGER, PUBLIC, PARAMETER :: jpdyn_bfri = 12 !: implicit bottom friction (ln_~~bfr~~imp=.TRUE.)
	74	INTEGER, PUBLIC, PARAMETER :: jpdyn_bfri = 12 !: implicit bottom friction (ln_drgimp=.TRUE.)
75	75	INTEGER, PUBLIC, PARAMETER :: jpdyn_ken = 13 !: use for calculation of KE
76	76	!

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90

-                      r6140
+                      r8215
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics variables
+   USE phycst         ! physical constants
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE zdf_oce        ! ocean vertical physics: variables
+   USE zdfdrg         ! ocean vertical physics: bottom friction
    USE trd_oce        ! trends: ocean variables
-   USE zdfbfr         ! bottom friction
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE phycst         ! physical constants
    USE trdken         ! trends: Kinetic ENergy
    USE trdglo         ! trends: global domain averaged
    USE trdvor         ! trends: vertical averaged vorticity
    USE trdmxl         ! trends: mixed layer averaged
+   !
    USE in_out_manager ! I/O manager
    USE lbclnk         ! lateral boundary condition
    USE iom            ! I/O manager library
    USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory allocation
    IMPLICIT NONE
    PRIVATE
    PUBLIC trd_dyn        ! called by all dynXX modules
+   PUBLIC trd_dyn        ! called by all dynXXX modules
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
       INTEGER ::   ji, jj, jk   ! dummy loop indices
       INTEGER ::   ikbu, ikbv   ! local integers
       REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3dx, z3dy   ! 3D workspace
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   z3dx, z3dy   ! 3D workspace
       !!----------------------------------------------------------------------
+      !
 …
       CASE( jpdyn_keg )   ;   CALL iom_put( "utrd_keg", putrd )    ! Kinetic Energy gradient (or had)
                               CALL iom_put( "vtrd_keg", pvtrd )
                               CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )
+                              ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) )
                               z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation)
                               z3dy(:,:,:) = 0._wp
 …
                               CALL iom_put( "utrd_udx", z3dx  )
                               CALL iom_put( "vtrd_vdy", z3dy  )
                               CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )
       CASE( jpdyn_zad )   ;   CALL iom_put( "utrd_zad", putrd )    ! vertical   advection
+                              DEALLOCATE( z3dx , z3dy )
+      CASE( jpdyn_zad )   ;   CALL iom_put( "utrd_zad", putrd )    ! vertical advection
                               CALL iom_put( "vtrd_zad", pvtrd )
       CASE( jpdyn_ldf )   ;   CALL iom_put( "utrd_ldf", putrd )    ! lateral diffusion
+      CASE( jpdyn_ldf )   ;   CALL iom_put( "utrd_ldf", putrd )    ! lateral  diffusion
                               CALL iom_put( "vtrd_ldf", pvtrd )
       CASE( jpdyn_zdf )   ;   CALL iom_put( "utrd_zdf", putrd )    ! vertical diffusion
                               CALL iom_put( "vtrd_zdf", pvtrd )
+                              !
                               !                                    ! wind stress trends
                               CALL wrk_alloc( jpi, jpj, z2dx, z2dy )
+                              ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) )
                               z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 )
                               z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 )
                               CALL iom_put( "utrd_tau", z2dx )
                               CALL iom_put( "vtrd_tau", z2dy )
+                              CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )
+      CASE( jpdyn_bfr )       ! called if ln_bfrimp=T
+                              CALL iom_put( "utrd_bfr", putrd )    ! bottom friction (explicit case)
+                              CALL iom_put( "vtrd_bfr", pvtrd )
+      CASE( jpdyn_atf )   ;   CALL iom_put( "utrd_atf", putrd )        ! asselin filter trends
+                              CALL iom_put( "vtrd_atf", pvtrd )
+      CASE( jpdyn_bfri )  ;   IF( ln_bfrimp ) THEN                     ! bottom friction (implicit case)
+                                 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )
+                              DEALLOCATE( z2dx , z2dy )
+                              !                                    ! bottom stress tends (implicit case)
+                              IF( ln_drgimp ) THEN
+                                 ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) )
                                  z3dx(:,:,:) = 0._wp   ;   z3dy(:,:,:) = 0._wp  ! after velocity known (now filed at this stage)
                                  DO jk = 1, jpkm1
 …
                                           ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
                                           ikbv = mbkv(ji,jj)
                                           z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)
                                           z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)
+                                          z3dx(ji,jj,jk) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )*un(ji,jj,ikbu)/e3u_n(ji,jj,ikbu)
+                                          z3dy(ji,jj,jk) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )*vn(ji,jj,ikbv)/e3v_n(ji,jj,ikbv)
                                        END DO
                                     END DO
                                  END DO
+                                 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. )
+                                 CALL iom_put( "utrd_bfri", z3dx )
+                                 CALL iom_put( "vtrd_bfri", z3dy )
+                                 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )
+                              ENDIF
+                                 CALL lbc_lnk( z3dx, 'U', -1. )   ;   CALL lbc_lnk( z3dy, 'V', -1. )
+                                 CALL iom_put( "utrd_bfr", z3dx )
+                                 CALL iom_put( "vtrd_bfr", z3dy )
+                                 DEALLOCATE( z3dx , z3dy )
+                              ENDIF
+      CASE( jpdyn_bfr )       ! called if ln_drgimp=F
+                              CALL iom_put( "utrd_bfr", putrd )    ! bottom friction (explicit case)
+                              CALL iom_put( "vtrd_bfr", pvtrd )
+      CASE( jpdyn_atf )   ;   CALL iom_put( "utrd_atf", putrd )        ! asselin filter trends
+                              CALL iom_put( "vtrd_atf", pvtrd )
       END SELECT
+      !

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90

-                      r6140
+                      r8215
    !!----------------------------------------------------------------------
    !!   trd_glo      : domain averaged budget of trends (including kinetic energy and T^2 trends)
    !!   glo_dyn_wri  : print dynamic trends in ocean.output file
    !!   glo_tra_wri  : print global T & T^2 trends in ocean.output file
    !!   trd_glo_init : initialization step
+   !!   trd_glo       : domain averaged budget of trends (including kinetic energy and T^2 trends)
+   !!   glo_dyn_wri   : print dynamic trends in ocean.output file
+   !!   glo_tra_wri   : print global T & T^2 trends in ocean.output file
+   !!   trd_glo_init  : initialization step
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables
    USE sbc_oce         ! surface boundary condition: ocean
    USE trd_oce         ! trends: ocean variables
    USE phycst          ! physical constants
    USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff.
    USE ldfdyn          ! ocean dynamics: lateral physics
    USE zdf_oce         ! ocean vertical physics
    USE zdfbfr          ! bottom friction
    USE zdfddm          ! ocean vertical physics: double diffusion
    USE eosbn2          ! equation of state
    USE phycst          ! physical constants
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE trd_oce        ! trends: ocean variables
+   USE phycst         ! physical constants
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfdyn         ! ocean dynamics: lateral physics
+   USE zdf_oce        ! ocean vertical physics
+   USE zdfdrg         ! ocean vertical physics: bottom friction
+   USE zdfddm         ! ocean vertical physics: double diffusion
+   USE eosbn2         ! equation of state
+   USE phycst         ! physical constants
+   !
+   USE lib_mpp         ! distibuted memory computing library
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE wrk_nemo        ! Memory allocation
+   USE lib_mpp        ! distibuted memory computing library
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
    IMPLICIT NONE
 …
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
-#  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
 …
       INTEGER ::   ikbu, ikbv      ! local integers
       REAL(wp)::   zvm, zvt, zvs, z1_2rau0   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace
+      !!----------------------------------------------------------------------
+      CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )
+      REAL(wp), DIMENSION(jpi,jpj)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
       IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
+         !
 …
                DO jj = 1, jpjm1
                   DO ji = 1, jpim1
                      zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
                         &                  * e1u    (ji  ,jj  ) * e2u    (ji,jj) * e3u_n(ji,jj,jk)
                      zvs = ptrdy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
                         &                  * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk)
+                     zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
+                        &                                     * e1e2u  (ji,jj) * e3u_n(ji,jj,jk)
+                     zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
+                        &                                     * e1e2v  (ji,jj) * e3u_n(ji,jj,jk)
                      umo(ktrd) = umo(ktrd) + zvt
                      vmo(ktrd) = vmo(ktrd) + zvs
 …
                DO jj = 1, jpjm1
                   DO ji = 1, jpim1
                      zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
                         &                       * z1_2rau0 * e1u    (ji  ,jj  ) * e2u    (ji,jj)
                      zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
                         &                       * z1_2rau0 * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk)
+                     zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
+                        &                                                     * z1_2rau0       * e1e2u(ji,jj)
+                     zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
+                        &                                                     * z1_2rau0       * e1e2v(ji,jj)
                      umo(jpdyn_tau) = umo(jpdyn_tau) + zvt
                      vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs
 …
             IF( ktrd == jpdyn_atf ) THEN     ! last trend (asselin time filter)
+               !
                IF( ln_bfrimp ) THEN                   ! implicit bfr case: compute separately the bottom friction
+               IF( ln_drgimp ) THEN                   ! implicit drag case: compute separately the bottom friction
                   z1_2rau0 = 0.5_wp / rau0
                   DO jj = 1, jpjm1
 …
                         ikbu = mbku(ji,jj)                  ! deepest ocean u- & v-levels
                         ikbv = mbkv(ji,jj)
                         zvt = bfrua(ji,jj) * un(ji,jj,ikbu) * e1u(ji,jj) * e2v(ji,jj)
                         zvs = bfrva(ji,jj) * vn(ji,jj,ikbv) * e1v(ji,jj) * e2v(ji,jj)
+                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * un(ji,jj,ikbu) * e1e2u(ji,jj)
+                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vn(ji,jj,ikbv) * e1e2v(ji,jj)
                         umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt
                         vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs
 …
                   END DO
                ENDIF
+!!gm top drag case is missing
+               !
                CALL glo_dyn_wri( kt )                 ! print the results in ocean.output
 …
       ENDIF
+      !
-      CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )
+      !
    END SUBROUTINE trd_glo
 …
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zcof         ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:)  ::  zkx, zky, zkz, zkepe
+      !!----------------------------------------------------------------------
+      CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )
+      REAL(wp), DIMENSION(jpi,jpj,jpk)  ::  zkx, zky, zkz, zkepe
+      !!----------------------------------------------------------------------
       ! I. Momentum trends
 …
             &      + vmo(jpdyn_bfr) + vmo(jpdyn_atf) ) / tvolv
             WRITE (numout,9513) umo(jpdyn_tau) / tvolu, vmo(jpdyn_tau) / tvolv
             IF( ln_bfrimp )   WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv
+            IF( ln_drgimp )   WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv
          ENDIF
 …
             &      + hke(jpdyn_bfr) + hke(jpdyn_atf) ) / tvolt
             WRITE (numout,9533) hke(jpdyn_tau) / tvolt
             IF( ln_bfrimp )   WRITE (numout,9534) hke(jpdyn_bfri) / tvolt
+            IF( ln_drgimp )   WRITE (numout,9534) hke(jpdyn_bfri) / tvolt
          ENDIF
 …
       ENDIF
+      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )
+      !
    END SUBROUTINE glo_dyn_wri

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

-                      r7646
+                      r8215
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
+   USE phycst         ! physical constants
    USE sbc_oce        ! surface boundary condition: ocean
    USE zdf_oce        ! ocean vertical physics variables
+   USE zdfdrg         ! ocean vertical physics: bottom friction
+   USE ldftra         ! ocean active tracers lateral physics
    USE trd_oce        ! trends: ocean variables
-!!gm   USE dynhpg          ! hydrostatic pressure gradient
-   USE zdfbfr         ! bottom friction
-   USE ldftra         ! ocean active tracers lateral physics
-   USE phycst         ! physical constants
    USE trdvor         ! ocean vorticity trends
    USE trdglo         ! trends:global domain averaged
 …
    USE iom            ! I/O manager library
    USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory allocation
    USE ldfslp         ! Isopycnal slopes
 …
       !!          diagnose separately the KE trend associated with wind stress
       !!              - bottom friction case (jpdyn_bfr):
       !!          explicit case (ln_bfrimp=F): bottom trend put in the 1st level
+      !!          explicit case (ln_drgimp=F): bottom trend put in the 1st level
       !!                                       of putrd, pvtrd
+      !
 …
       INTEGER ::   ikbu  , ikbv     ! local integers
       INTEGER ::   ikbum1, ikbvm1   !   -       -
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy, zke2d   ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zke                 ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zke )
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   z2dx, z2dy, zke2d   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zke                 ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
       CALL lbc_lnk( putrd, 'U', -1. )   ;   CALL lbc_lnk( pvtrd, 'V', -1. )      ! lateral boundary conditions
 …
          CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf"   , zke )    ! vertical diffusion
          !                   !                                          ! wind stress trends
                                  CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
+                                 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) )
                            z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1)
                            z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1)
 …
                            END DO
                                  CALL iom_put( "ketrd_tau"   , zke2d )  !
                                  CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
+                                 DEALLOCATE( z2dx , z2dy , zke2d )
          CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr"   , zke )    ! bottom friction (explicit case)
 !!gm TO BE DONE properly
 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
 !         IF(.NOT. ln_bfrimp) THEN
+!!gm only valid if ln_drgimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
+!         IF(.NOT. ln_drgimp) THEN
 !            DO jj = 1, jpj    !
 !               DO ji = 1, jpi
 …
 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf....
+!
 !         IF( ln_bfrimp ) THEN                                          ! bottom friction (implicit case)
+!         IF( ln_drgimp ) THEN                                          ! bottom friction (implicit case)
 !            DO jj = 1, jpj                                                  ! after velocity known (now filed at this stage)
 !               DO ji = 1, jpi
 …
       END SELECT
+      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zke )
+      !
    END SUBROUTINE trd_ken
 …
       !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps)
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   pconv
+      !
+      INTEGER  ::   ji, jj, jk                       ! dummy loop indices
+      INTEGER  ::   iku, ikv                         ! temporary integers
+      REAL(wp) ::   zcoef                            ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zconv  ! temporary conv on W-grid
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zconv )
+      INTEGER                   , INTENT(in   ) ::   kt      ! ocean time-step index
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pconv   !
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   iku, ikv     ! local integers
+      REAL(wp) ::   zcoef        ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zconv  ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
       ! Local constant initialization
 …
       END DO
+      !
-      CALL wrk_dealloc( jpi,jpj,jpk, zconv )
+      !
    END SUBROUTINE ken_p2k

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

r6140	r8215
69	69	INTEGER :: ionce, icount
70	70
71		~~!! * Substitutions~~
72		~~# include "zdfddm_substitute.h90"~~
73	71	!!----------------------------------------------------------------------
74	72	!! NEMO/OPA 3.3 , NEMO Consortium (2010)

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

r6140	r8215
37	37
38	38	!! * Substitutions
39		~~# include "zdfddm_substitute.h90"~~
40	39	# include "vectopt_loop_substitute.h90"
41	40	!!----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

-                      r7646
+                      r8215
    !! * Substitutions
-#  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
 …
             DO jk = 2, jpk
                zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
                zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+               zws(:,:,jk) = avs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
             END DO
+            !

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

-                      r7646
+                      r8215
    !! Ocean physics : define vertical mixing variables
    !!=====================================================================
+   !! history :  1.0  !  2002-06  (G. Madec) Original code
+   !!            3.2  !  2009-07  (G.Madec) addition of avm
+   !! history :  1.0  !  2002-06  (G. Madec)  Original code
+   !!            3.2  !  2009-07  (G. Madec)  addition of avm
+   !!            4.0  !  2017-05  (G. Madec)  avm and drag coef. defined at t-point
    !!----------------------------------------------------------------------
    USE par_oce        ! ocean parameters
 …
    PUBLIC  zdf_oce_alloc    ! Called in nemogcm.F90
+#if defined key_zdfcst
+   LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .TRUE.         !: constant vertical mixing flag
+#else
+   LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .FALSE.        !: constant vertical mixing flag
+#endif
+   !                                 !!* namelist namzdf: vertical diffusion *
+   !                            !!* namelist namzdf: vertical physics *
+   !                             ! vertical closure scheme flags
+   LOGICAL , PUBLIC ::   ln_zdfcst   !: constant coefficients
+   LOGICAL , PUBLIC ::   ln_zdfric   !: Richardson depend coefficients
+   LOGICAL , PUBLIC ::   ln_zdftke   !: Turbulent Kinetic Energy closure
+   LOGICAL , PUBLIC ::   ln_zdfgls   !: Generic Length Sclare closure
+   !                             ! convection
+   LOGICAL , PUBLIC ::   ln_zdfevd   !: convection: enhanced vertical diffusion flag
+   INTEGER , PUBLIC ::      nn_evdm     !: =0/1 flag to apply enhanced avm or not
+   REAL(wp), PUBLIC ::      rn_evd      !: vertical eddy coeff. for enhanced vert. diff. (m2/s)
+   LOGICAL , PUBLIC ::   ln_zdfnpc   !: convection: non-penetrative convection flag
+   INTEGER , PUBLIC ::      nn_npc      !: non penetrative convective scheme call  frequency
+   INTEGER , PUBLIC ::      nn_npcp     !: non penetrative convective scheme print frequency
+   !                             ! double diffusion
+   LOGICAL , PUBLIC ::   ln_zdfddm   !: double diffusive mixing flag
+   REAL(wp), PUBLIC ::      rn_avts     !: maximum value of avs for salt fingering
+   REAL(wp), PUBLIC ::      rn_hsbfr    !: heat/salt buoyancy flux ratio
+   !                             ! gravity wave-induced vertical mixing
+   LOGICAL , PUBLIC ::   ln_zdfswm   !: surface  wave-induced mixing flag
+   LOGICAL , PUBLIC ::   ln_zdfiwm   !: internal wave-induced mixing flag
+   !                             ! coefficients
    REAL(wp), PUBLIC ::   rn_avm0     !: vertical eddy viscosity (m2/s)
    REAL(wp), PUBLIC ::   rn_avt0     !: vertical eddy diffusivity (m2/s)
    INTEGER , PUBLIC ::   nn_avb      !: constant or profile background on avt (=0/1)
+   INTEGER , PUBLIC ::   nn_havtb    !: horizontal shape or not for avtb (=0/1)
+   LOGICAL , PUBLIC ::   ln_zdfexp   !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_zdfexp   !: number of sub-time step (explicit time stepping)
+   LOGICAL , PUBLIC ::   ln_zdfevd   !: convection: enhanced vertical diffusion flag
+   INTEGER , PUBLIC ::   nn_evdm     !: =0/1 flag to apply enhanced avm or not
+   REAL(wp), PUBLIC ::   rn_avevd    !: vertical eddy coeff. for enhanced vert. diff. (m2/s)
+   LOGICAL , PUBLIC ::   ln_zdfnpc   !: convection: non-penetrative convection flag
+   INTEGER , PUBLIC ::   nn_npc      !: non penetrative convective scheme call  frequency
+   INTEGER , PUBLIC ::   nn_npcp     !: non penetrative convective scheme print frequency
+   LOGICAL , PUBLIC ::   ln_zdfqiao  !: Enhanced wave vertical mixing Qiao(2010) formulation flag
+   INTEGER , PUBLIC ::   nn_havtb    !: horizontal shape or not for avtb (=0/1)   !                             ! convection
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::   avmb , avtb    !: background profile of avm and avt
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   avtb_2d        !: horizontal shape of background Kz profile
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   tfrua, tfrva   !: top friction coefficients set in zdfbfr
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s]
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en              !: now turbulent kinetic energy   [m2/s2]
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm, avt, avs  !: vertical mixing coefficients (w-point) [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avm_k , avt_k  !: Kz computed by turbulent closure alone [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy          [m2/s2]
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::   avmb , avtb    !: background profile of avm and avt      [m2/s]
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   avtb_2d        !: horizontal shape of background Kz profile [-]
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
       !!----------------------------------------------------------------------
+      !
+      ALLOCATE(avmb(jpk) , bfrua(jpi,jpj) ,                         &
+         &     avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) ,      &
+         &     tfrua(jpi, jpj), tfrva(jpi, jpj)              ,      &
+         &     avmu  (jpi,jpj,jpk), avm   (jpi,jpj,jpk)      ,      &
+         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk)      ,      &
+         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk)      ,      &
+         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk)      ,      &
+         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc )
+      ALLOCATE( avm (jpi,jpj,jpk) , avm_k(jpi,jpj,jpk) , avs(jpi,jpj,jpk) ,   &
+         &      avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) ,   &
+         &      avmb(jpk)         , avtb(jpk)          , avtb_2d(jpi,jpj) , STAT = zdf_oce_alloc )
+         !
       IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays')

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

-                      r7753
+                      r8215
    !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta
+   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only
    !!----------------------------------------------------------------------
+#if defined key_zdfddm
    !!----------------------------------------------------------------------
    !!   'key_zdfddm' :                                     double diffusion
+   !!   zdf_ddm       : compute the Kz for salinity
    !!----------------------------------------------------------------------
+   !!   zdf_ddm       : compute the Ks for salinity
+   !!   zdf_ddm_init  : read namelist and control the parameters
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics variables
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics variables
    USE eosbn2         ! equation of state
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
    IMPLICIT NONE
 …
    PUBLIC   zdf_ddm       ! called by step.F90
-   PUBLIC   zdf_ddm_init  ! called by opa.F90
-   PUBLIC   zdf_ddm_alloc ! called by nemogcm.F90
-   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag
-   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs   !: salinity vertical diffusivity coeff. at w-point
-   !                       !!* Namelist namzdf_ddm : double diffusive mixing *
-   REAL(wp) ::   rn_avts    ! maximum value of avs for salt fingering
-   REAL(wp) ::   rn_hsbfr   ! heat/salt buoyancy flux ratio
    !! * Substitutions
 …
 CONTAINS
+   INTEGER FUNCTION zdf_ddm_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE zdf_ddm_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( avs(jpi,jpj,jpk) , STAT= zdf_ddm_alloc )
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_ddm_alloc )
+      IF( zdf_ddm_alloc /= 0 )   CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays')
+   END FUNCTION zdf_ddm_alloc
+   SUBROUTINE zdf_ddm( kt )
+   SUBROUTINE zdf_ddm( kt, p_avm, p_avt, p_avs )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_ddm  ***
 …
       !!      avt = avt + zavft + zavdt
       !!      avs = avs + zavfs + zavds
       !!      avmu, avmv are required to remain at least above avt and avs.
+      !!      avm is required to remain at least above avt and avs.
       !!
       !! ** Action  :   avt, avs : updated vertical eddy diffusivity coef. for T & S
 …
       !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999.
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step indexocean time step
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step indexocean time step
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm   !  Kz on momentum    (w-points)
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avt   !  Kz on temperature (w-points)
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_avs   !  Kz on salinity    (w-points)
+      !
       INTEGER  ::   ji, jj , jk     ! dummy loop indices
 …
       REAL(wp) ::   zavft, zavfs    !   -      -
       REAL(wp) ::   zavdt, zavds    !   -      -
       REAL(wp), POINTER, DIMENSION(:,:) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
+      REAL(wp), DIMENSION(jpi,jpj) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
       !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_ddm')
+      !
+      CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )
+      IF( nn_timing == 1 )   CALL timing_start('zdf_ddm')
+      !
       !                                                ! ===============
 …
          ! Define the mask
          ! ---------------
+         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s])
+!!gm  WORK to be done:   change the code from vector optimisation to scalar one.
+!!gm                     ==>>>  test in the loop instead of use of mask arrays
+!!gm                            and many acces in memory
+         DO jj = 1, jpj                !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==!
             DO ji = 1, jpi
                zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+!!gm please, use e3w_n below
                   &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )
+               !
 …
          END DO
          DO jj = 1, jpj                                     ! indicators:
+         DO jj = 1, jpj                !==  indicators  ==!
             DO ji = 1, jpi
                ! stability indicator: msks=1 if rn2>0; 0 elsewhere
 …
                   &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  )
                ! add to the eddy viscosity coef. previously computed
+# if defined key_zdftmx_new
+               ! key_zdftmx_new: New internal wave-driven param: use avs value computed by zdftmx
+               avs (ji,jj,jk) = avs(ji,jj,jk) + zavfs + zavds
+# else
+               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds
+# endif
+               avt (ji,jj,jk) = avt(ji,jj,jk) + zavft + zavdt
+               avm (ji,jj,jk) = avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds )
+            END DO
+         END DO
+         ! Increase avmu, avmv if necessary
+         ! --------------------------------
+!!gm to be changed following the definition of avm.
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    &
+                  &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   &
+                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    &
+                  &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   &
+                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * wvmask(ji,jj,jk)
+               p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds
+               p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt
+               p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds )
             END DO
          END DO
 …
       !                                                   ! ===============
+      !
-      CALL lbc_lnk( avt , 'W', 1._wp )     ! Lateral boundary conditions   (unchanged sign)
-      CALL lbc_lnk( avs , 'W', 1._wp )
-      CALL lbc_lnk( avm , 'W', 1._wp )
-      CALL lbc_lnk( avmu, 'U', 1._wp )
-      CALL lbc_lnk( avmv, 'V', 1._wp )
       IF(ln_ctl) THEN
          CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm  - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk)
-         CALL prt_ctl(tab3d_1=avmu, clinfo1=' ddm  - u: ', mask1=umask, &
-            &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk)
       ENDIF
+      !
-      CALL wrk_dealloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_ddm')
 …
    END SUBROUTINE zdf_ddm
-   SUBROUTINE zdf_ddm_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE zdf_ddm_init  ***
-      !!
-      !! ** Purpose :   Initialization of double diffusion mixing scheme
-      !!
-      !! ** Method  :   Read the namzdf_ddm namelist and check the parameter values
-      !!              called by zdf_ddm at the first timestep (nit000)
-      !!----------------------------------------------------------------------
-      INTEGER ::   ios   ! local integer
-      !!
-      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr
-      !!----------------------------------------------------------------------
+      !
-      REWIND( numnam_ref )              ! Namelist namzdf_ddm in reference namelist : Double diffusion mixing scheme
-      READ  ( numnam_ref, namzdf_ddm, IOSTAT = ios, ERR = 901)
-   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in reference namelist', lwp )
-      REWIND( numnam_cfg )              ! Namelist namzdf_ddm in configuration namelist : Double diffusion mixing scheme
-      READ  ( numnam_cfg, namzdf_ddm, IOSTAT = ios, ERR = 902 )
-   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namzdf_ddm )
+      !
-      IF(lwp) THEN                    ! Parameter print
-         WRITE(numout,*)
-         WRITE(numout,*) 'zdf_ddm : double diffusive mixing'
-         WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '   Namelist namzdf_ddm : set dd mixing parameter'
-         WRITE(numout,*) '      maximum avs for dd mixing      rn_avts   = ', rn_avts
-         WRITE(numout,*) '      heat/salt buoyancy flux ratio  rn_hsbfr  = ', rn_hsbfr
-      ENDIF
+      !
-      !                               ! allocate zdfddm arrays
-      IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' )
-      !                               ! initialization to masked Kz
-      avs(:,:,:) = rn_avt0 * wmask(:,:,:)
+      !
-   END SUBROUTINE zdf_ddm_init
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :          Dummy module          No double diffusion
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .FALSE.   !: double diffusion flag
-CONTAINS
-   SUBROUTINE zdf_ddm( kt )           ! Dummy routine
-      WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt
-   END SUBROUTINE zdf_ddm
-   SUBROUTINE zdf_ddm_init            ! Dummy routine
-   END SUBROUTINE zdf_ddm_init
-#endif
    !!======================================================================
 END MODULE zdfddm

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

-                      r7753
+                      r8215
    !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
    !!            3.2  !  2009-03  (M. Leclair, G. Madec, R. Benshila) test on both before & after
+   !!            4.0  !  2017-04  (G. Madec)  evd applied on avm (at t-point)
    !!----------------------------------------------------------------------
 …
    USE iom             ! for iom_put
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! work arrays
    USE timing          ! Timing
 …
 CONTAINS
    SUBROUTINE zdf_evd( kt )
+   SUBROUTINE zdf_evd( kt, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_evd  ***
 …
       !!      sivity coefficients when a static instability is encountered.
       !!
+      !! ** Method  :   avt, avm, and the 4 neighbouring avmu, avmv coefficients
+      !!      are set to avevd (namelist parameter) if the water column is
+      !!      statically unstable (i.e. if rn2 < -1.e-12 )
+      !! ** Method  :   tracer (and momentum if nn_evdm=1) vertical mixing
+      !!              coefficients are set to rn_evd (namelist parameter)
+      !!              if the water column is statically unstable.
+      !!                The test of static instability is performed using
+      !!              Brunt-Vaisala frequency (rn2 < -1.e-12) of to successive
+      !!              time-step (Leap-Frog environnement): before and
+      !!              now time-step.
       !!
+      !! ** Action  :   avt, avm, avmu, avmv updted in static instability cases
+      !!
+      !! References :   Lazar, A., these de l'universite Paris VI, France, 1997
+      !! ** Action  :   avt, avm   enhanced where static instability occurs
       !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step
+      INTEGER                    , INTENT(in   ) ::   kt             ! ocean time-step indexocean time step
+      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points)
+      !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zavt_evd, zavm_evd
       !!----------------------------------------------------------------------
+      !
 …
       ENDIF
+      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zavt_evd, zavm_evd )
+      !
       zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application
+      zavt_evd(:,:,:) = p_avt(:,:,:)         ! set avt prior to evd application
+      !
       SELECT CASE ( nn_evdm )
+      !
       CASE ( 1 )           ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12)
+      CASE ( 1 )           !==  enhance tracer & momentum Kz  ==!   (if rn2<-1.e-12)
+         !
+         zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application
+         zavm_evd(:,:,:) = p_avm(:,:,:)      ! set avm prior to evd application
+         !
+!! change last digits results
+!         WHERE( MAX( rn2(2:jpi,2:jpj,2:jpkm1), rn2b(2:jpi,2:jpj,2:jpkm1) )  <= -1.e-12 ) THEN
+!            p_avt(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1)
+!            p_avm(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1)
+!         END WHERE
+         !
          DO jk = 1, jpkm1
             DO jj = 2, jpj             ! no vector opt.
                DO ji = 2, jpi
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
+                     avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
+                     avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
+                     avmu(ji  ,jj  ,jk) = rn_avevd * umask(ji  ,jj  ,jk)
+                     avmu(ji-1,jj  ,jk) = rn_avevd * umask(ji-1,jj  ,jk)
+                     avmv(ji  ,jj  ,jk) = rn_avevd * vmask(ji  ,jj  ,jk)
+                     avmv(ji  ,jj-1,jk) = rn_avevd * vmask(ji  ,jj-1,jk)
+                     p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
+                     p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
                   ENDIF
                END DO
             END DO
          END DO
-         CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
+         !
          zavm_evd(:,:,:) = avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd
          CALL iom_put( "avm_evd", zavm_evd )              ! output this change
+         zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd
+         CALL iom_put( "avm_evd", zavm_evd )                ! output this change
+         !
+      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)
+      CASE DEFAULT         !==  enhance tracer Kz  ==!   (if rn2<-1.e-12)
+!! change last digits results
+!         WHERE( MAX( rn2(2:jpi,2:jpj,2:jpkm1), rn2b(2:jpi,2:jpj,2:jpkm1) )  <= -1.e-12 )
+!            p_avt(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1)
+!         END WHERE
          DO jk = 1, jpkm1
+!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!
+            DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
+               DO ji = 1, jpi
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
                      avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk)
+                     p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
                END DO
             END DO
 …
+         !
       END SELECT
       zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd
+      !
+      zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd
       CALL iom_put( "avt_evd", zavt_evd )              ! output this change
       IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd )
+      !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zavt_evd, zavm_evd )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_evd')

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

-                      r7646
+                      r8215
    !!                 turbulent closure parameterization
    !!======================================================================
+   !! History :   3.0  !  2009-09  (G. Reffray)  Original code
+   !!             3.3  !  2010-10  (C. Bricaud)  Add in the reference
+   !! History :  3.0  !  2009-09  (G. Reffray)  Original code
+   !!            3.3  !  2010-10  (C. Bricaud)  Add in the reference
+   !!            4.0  !  2017-04  (G. Madec)  remove CPP keys & avm at t-point only
+   !!             -   !  2017-05  (G. Madec)  add top friction as boundary condition
    !!----------------------------------------------------------------------
+#if defined key_zdfgls
+   !!----------------------------------------------------------------------
+   !!   'key_zdfgls'                 Generic Length Scale vertical physics
    !!----------------------------------------------------------------------
    !!   zdf_gls       : update momentum and tracer Kz from a gls scheme
 …
    USE domvvl         ! ocean space and time domain : variable volume layer
    USE zdf_oce        ! ocean vertical physics
+   USE zdfbfr         ! bottom friction (only for rn_bfrz0)
+   USE zdfdrg  , ONLY : r_z0_top , r_z0_bot   ! top/bottom roughness
+   USE zdfdrg  , ONLY : rCdU_top , rCdU_bot   ! top/bottom friction
    USE sbc_oce        ! surface boundary condition: ocean
    USE phycst         ! physical constants
    USE zdfmxl         ! mixed layer
    USE sbcwave ,  ONLY: hsw   ! significant wave height
+   USE sbcwave , ONLY : hsw   ! significant wave height
+   !
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp        ! MPP manager
-   USE wrk_nemo       ! work arrays
    USE prtctl         ! Print control
    USE in_out_manager ! I/O manager
 …
    PRIVATE
+   PUBLIC   zdf_gls        ! routine called in step module
+   PUBLIC   zdf_gls_init   ! routine called in opa module
+   PUBLIC   gls_rst        ! routine called in step module
+   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag
+   PUBLIC   zdf_gls        ! called in zdfphy
+   PUBLIC   zdf_gls_init   ! called in zdfphy
+   PUBLIC   gls_rst        ! called in zdfphy
+   !
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hmxl_n    !: now mixing length
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustar2_surf !: Squared surface velocity scale at T-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustar2_top  !: Squared top     velocity scale at T-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustar2_bot  !: Squared bottom  velocity scale at T-points
    !                              !! ** Namelist  namzdf_gls  **
 …
    REAL(wp) ::   rsc_tke, rsc_psi, rpsi1, rpsi2, rpsi3, rsc_psi0  !     -           -           -        -
    REAL(wp) ::   rpsi3m, rpsi3p, rpp, rmm, rnn                    !     -           -           -        -
+   !
+   REAL(wp) ::   r2_3 = 2._wp/3._wp   ! constant=2/3
    !! * Substitutions
 …
       !!                ***  FUNCTION zdf_gls_alloc  ***
       !!----------------------------------------------------------------------
       ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
          &      ustars2(jpi,jpj) , ustarb2(jpi,jpj)   , STAT= zdf_gls_alloc )
+      ALLOCATE( hmxl_n(jpi,jpj,jpk) , ustar2_surf(jpi,jpj) ,                     &
+         &      zwall (jpi,jpj,jpk) , ustar2_top (jpi,jpj) , ustar2_bot(jpi,jpj) , STAT= zdf_gls_alloc )
+         !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc )
 …
    SUBROUTINE zdf_gls( kt )
+   SUBROUTINE zdf_gls( kt, p_sh2, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_gls  ***
 …
       !!              coefficients using the GLS turbulent closure scheme.
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      INTEGER  ::   ji, jj, jk, ibot, ibotm1, dir  ! dummy loop arguments
+      REAL(wp) ::   zesh2, zsigpsi, zcoef, zex1, zex2   ! local scalars
+      REAL(wp) ::   ztx2, zty2, zup, zdown, zcof        !   -      -
+      REAL(wp) ::   zratio, zrn2, zflxb, sh             !   -      -
+      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step
+      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  ::   ji, jj, jk    ! dummy loop arguments
+      INTEGER  ::   ibot, ibotm1  ! local integers
+      INTEGER  ::   itop, itopp1  !   -       -
+      REAL(wp) ::   zesh2, zsigpsi, zcoef, zex1 , zex2  ! local scalars
+      REAL(wp) ::   ztx2, zty2, zup, zdown, zcof, zdir  !   -      -
+      REAL(wp) ::   zratio, zrn2, zflxb, sh     , z_en  !   -      -
       REAL(wp) ::   prod, buoy, diss, zdiss, sm         !   -      -
+      REAL(wp) ::   gh, gm, shr, dif, zsqen, zav        !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zdep
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zkar
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zflxs       ! Turbulence fluxed induced by internal waves
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhsro       ! Surface roughness (surface waves)
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eb          ! tke at time before
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   mxlb        ! mixing length at time before
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   shear       ! vertical shear
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eps         ! dissipation rate
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi)
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   psi         ! psi at time now
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_a    ! element of the first  matrix diagonal
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_b    ! element of the second matrix diagonal
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_c    ! element of the third  matrix diagonal
+      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,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
       !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_gls')
+      !
+      CALL wrk_alloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_alloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
+      IF( nn_timing == 1 )   CALL timing_start('zdf_gls')
+      !
       ! Preliminary computing
+      ustars2 = 0._wp   ;   ustarb2 = 0._wp   ;   psi  = 0._wp   ;   zwall_psi = 0._wp
+      IF( kt /= nit000 ) THEN   ! restore before value to compute tke
+         avt (:,:,:) = avt_k (:,:,:)
+         avm (:,:,:) = avm_k (:,:,:)
+         avmu(:,:,:) = avmu_k(:,:,:)
+         avmv(:,:,:) = avmv_k(:,:,:)
+      ENDIF
+      ! Compute surface and bottom friction at T-points
+      ustar2_surf(:,:) = 0._wp   ;         psi(:,:,:) = 0._wp
+      ustar2_top (:,:) = 0._wp   ;   zwall_psi(:,:,:) = 0._wp
+      ustar2_bot (:,:) = 0._wp
+      ! Compute surface, top and bottom friction at T-points
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
+            !
             ! surface friction
             ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
+            ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
+            !
+            ! bottom friction (explicit before friction)
+            ! Note that we chose here not to bound the friction as in dynbfr)
+            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &
+               & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )
+            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &
+               & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )
+            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
+         END DO
+      END DO
+      ! Set surface roughness length
+      SELECT CASE ( nn_z0_met )
+      !
+      CASE ( 0 )             ! Constant roughness
+!!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that...
+          ! bottom friction (explicit before friction)
+          zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
+          zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0)
+          ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  &
+             &                                         + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  )
+         END DO
+      END DO
+      IF( ln_isfcav ) THEN       !top friction
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               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)) )     ! (CAUTION: CdU<0)
+               ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  &
+                  &                                         + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  )
+            END DO
+         END DO
+      ENDIF
+      SELECT CASE ( nn_z0_met )      !==  Set surface roughness length  ==!
+      CASE ( 0 )                          ! Constant roughness
          zhsro(:,:) = rn_hsro
       CASE ( 1 )             ! Standard Charnock formula
          zhsro(:,:) = MAX(rsbc_zs1 * ustars2(:,:), rn_hsro)
+         zhsro(:,:) = MAX( rsbc_zs1 * ustar2_surf(:,:) , rn_hsro )
       CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008)
+         zdep(:,:)  = 30.*TANH(2.*0.3/(28.*SQRT(MAX(ustars2(:,:),rsmall))))             ! Wave age (eq. 10)
+         zhsro(:,:) = MAX(rsbc_zs2 * ustars2(:,:) * zdep(:,:)**1.5, rn_hsro) ! zhsro = rn_frac_hs * Hsw (eq. 11)
+!!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)
       CASE ( 3 )             ! Roughness given by the wave model (coupled or read in file)
+!!gm  BUG missing a multiplicative coefficient....
          zhsro(:,:) = hsw(:,:)
       END SELECT
+      ! Compute shear and dissipation rate
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
+                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &
+                  &                            / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) )
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
+                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
+                  &                            / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) )
+               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk)
+      !
+      DO jk = 2, jpkm1              !==  Compute dissipation rate  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk)
             END DO
          END DO
       END DO
+      !
-      ! Lateral boundary conditions (avmu,avmv) (sign unchanged)
-      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
       ! Save tke at before time step
       eb  (:,:,:) = en  (:,:,:)
       mxlb(:,:,:) = mxln(:,:,:)
+      eb    (:,:,:) = en    (:,:,:)
+      hmxl_b(:,:,:) = hmxl_n(:,:,:)
       IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zup   = mxln(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1)
+                  zup   = hmxl_n(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1)
                   zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) )
                   zcoef = ( zup / MAX( zdown, rsmall ) )
 …
       ! The surface boundary condition are set after
       ! The bottom boundary condition are also set after. In standard e(bottom)=0.
       ! z_elem_b : diagonal z_elem_c : upper diagonal z_elem_a : lower diagonal
+      ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
       ! Warning : after this step, en : right hand side of the matrix
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !
+               ! shear prod. at w-point weightened by mask
+               shear(ji,jj,jk) =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1.e0 , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &             + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1.e0 , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
+               !
+               ! stratif. destruction
+               buoy = - avt(ji,jj,jk) * rn2(ji,jj,jk)
+               !
+               ! shear prod. - stratif. destruction
+               diss = eps(ji,jj,jk)
+               !
+               dir = 0.5_wp + SIGN( 0.5_wp, shear(ji,jj,jk) + buoy )   ! dir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = dir*(shear(ji,jj,jk)+buoy)+(1._wp-dir)*shear(ji,jj,jk)          ! production term
+               zdiss = dir*(diss/en(ji,jj,jk))   +(1._wp-dir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
+            DO ji = 2, jpim1
+               !
+               buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction
+               !
+               diss = eps(ji,jj,jk)                         ! dissipation
+               !
+               zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy )   ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk)          ! production term
+               zdiss = zdir*(diss/en(ji,jj,jk))   +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
+!!gm better coding, identical results
+!               zesh2 =   p_sh2(ji,jj,jk) + zdir*buoy               ! production term
+!               zdiss = ( diss - (1._wp-zdir)*buoy ) / en(ji,jj,jk) ! dissipation term
+!!gm
+               !
                ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0
 …
                ! building the matrix
                zcof = rfact_tke * tmask(ji,jj,jk)
+               !
+               ! lower diagonal
+               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
+                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
+               !
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+               !
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + rdt * zdiss * tmask(ji,jj,jk)
+               !
+               ! right hand side in en
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+               !                                               ! lower diagonal
+               zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
+               !                                               ! upper diagonal
+               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+               !                                               ! diagonal
+               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rdt * zdiss * wmask(ji,jj,jk)
+               !                                               ! right hand side in en
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
             END DO
          END DO
       END DO
+      !
       z_elem_b(:,:,jpk) = 1._wp
+      zdiag(:,:,jpk) = 1._wp
+      !
       ! Set surface condition on zwall_psi (1 at the bottom)
       zwall_psi(:,:,1) = zwall_psi(:,:,2)
       zwall_psi(:,:,jpk) = 1.
+      zwall_psi(:,:, 1 ) = zwall_psi(:,:,2)
+      zwall_psi(:,:,jpk) = 1._wp
+      !
       ! Surface boundary condition on tke
 …
       SELECT CASE ( nn_bc_surf )
+      !
       CASE ( 0 )             ! Dirichlet case
+      CASE ( 0 )             ! Dirichlet boundary condition (set e at k=1 & 2)
       ! First level
+      en(:,:,1) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+      en(:,:,1) = MAX(en(:,:,1), rn_emin)
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      en   (:,:,1) = MAX(  rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3  )
+      zd_lw(:,:,1) = en(:,:,1)
+      zd_up(:,:,1) = 0._wp
+      zdiag(:,:,1) = 1._wp
+      !
       ! One level below
+      en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) &
+         &               / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
+      en(:,:,2) = MAX(en(:,:,2), rn_emin )
+      z_elem_a(:,:,2) = 0._wp
+      z_elem_c(:,:,2) = 0._wp
+      z_elem_b(:,:,2) = 1._wp
+      !
+      !
+      CASE ( 1 )             ! Neumann boundary condition on d(e)/dz
+      en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2))   &
+         &                 / 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
+      !
+      !
+      CASE ( 1 )             ! Neumann boundary condition (set d(e)/dz)
+      !
       ! Dirichlet conditions at k=1
+      en(:,:,1)       = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+      en(:,:,1)       = MAX(en(:,:,1), rn_emin)
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      en   (:,:,1) = MAX(  rc02r * ustar2_surf(:,:) * (1._wp + 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
       z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
       z_elem_a(:,:,2) = 0._wp
       zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) ))
       zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) &
           &                       * ((zhsro(:,:)+gdept_n(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf)
       en(:,:,2) = en(:,:,2) + zflxs(:,:)/e3w_n(:,:,2)
+      zdiag(:,:,2) = zdiag(:,:,2) +  zd_lw(:,:,2) ! Remove zd_lw from zdiag
+      zd_lw(:,:,2) = 0._wp
+      zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) ))
+      zflxs(:,:)   = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) &
+          &                    * (  ( zhsro(:,:)+gdept_n(:,:,1) ) / zhsro(:,:)  )**(1.5_wp*ra_sf)
+!!gm why not   :                        * ( 1._wp + gdept_n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf)
+      en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w_n(:,:,2)
+      !
+      !
 …
+      !
       CASE ( 0 )             ! Dirichlet
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
+         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin
          !                      ! Balance between the production and the dissipation terms
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+!!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 ???
+!!   in particular in ocean cavities where top stratification can be large...
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+               !
+               ! Dirichlet condition applied at:
+               !     Bottom level (ibot)      &      Just above it (ibotm1)
+               zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp
+               zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
+               zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = 1._wp
+               en   (ji,jj,ibot) = z_en    ;   en   (ji,jj,ibotm1) = z_en
+            END DO
+         END DO
+         !
+         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  itop   = mikt(ji,jj)       ! k   top w-point
+                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
+                  !                                                ! mask at the ocean surface points
+                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
+                  !
+ !!gm TO BE VERIFIED !!!
+                  ! Dirichlet condition applied at:
+                  !     top level (itop)         &      Just below it (itopp1)
+                  zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp
+                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
+                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp
+                  en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en
+               END DO
+            END DO
+         ENDIF
+         !
+      CASE ( 1 )             ! Neumman boundary condition
+         !
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
 …
                ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin )
+               !
                ! Bottom level Dirichlet condition:
+               z_elem_a(ji,jj,ibot  ) = 0._wp
+               z_elem_c(ji,jj,ibot  ) = 0._wp
+               z_elem_b(ji,jj,ibot  ) = 1._wp
+               en(ji,jj,ibot  ) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
+               !
+               ! Just above last level, Dirichlet condition again
+               z_elem_a(ji,jj,ibotm1) = 0._wp
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+               z_elem_b(ji,jj,ibotm1) = 1._wp
+               en(ji,jj,ibotm1) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
+            END DO
+         END DO
+         !
+      CASE ( 1 )             ! Neumman boundary condition
+         !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               ! Bottom level Dirichlet condition:
+               z_elem_a(ji,jj,ibot) = 0._wp
+               z_elem_c(ji,jj,ibot) = 0._wp
+               z_elem_b(ji,jj,ibot) = 1._wp
+               en(ji,jj,ibot) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
+               !
+               ! Just above last level: Neumann condition
+               z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1)   ! Remove z_elem_c from z_elem_b
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+            END DO
+         END DO
+               !     Bottom level (ibot)      &      Just above it (ibotm1)
+               !         Dirichlet            !         Neumann
+               zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag
+               zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1)
+               zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp
+            END DO
+         END DO
+         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  itop   = mikt(ji,jj)       ! k   top w-point
+                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one
+                  !                                                ! mask at the ocean surface points
+                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )
+                  !
+                  ! Bottom level Dirichlet condition:
+                  !     Bottom level (ibot)      &      Just above it (ibotm1)
+                  !         Dirichlet            !         Neumann
+                  zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag
+                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1)
+                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp
+               END DO
+            END DO
+         ENDIF
+         !
       END SELECT
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
                z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-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 DO
          END DO
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
                z_elem_a(ji,jj,jk) = en(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-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 DO
          END DO
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
                en(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * en(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+               en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
             END DO
          END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   psi(ji,jj,jk)  = eb(ji,jj,jk) * mxlb(ji,jj,jk)
+                  psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk)
                END DO
             END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * mxlb(ji,jj,jk) )
+                  psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) )
                END DO
             END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * mxlb(ji,jj,jk)**rnn
+                  psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn
                END DO
             END DO
 …
       ! Resolution of a tridiagonal linear system by a "methode de chasse"
       ! computation from level 2 to jpkm1  (e(1) already computed and e(jpk)=0 ).
       ! z_elem_b : diagonal z_elem_c : upper diagonal z_elem_a : lower diagonal
+      ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
       ! Warning : after this step, en : right hand side of the matrix
 …
                zratio = psi(ji,jj,jk) / eb(ji,jj,jk)
+               !
                ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 dir = 1 (stable) otherwise dir = 0 (unstable)
                dir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) )
+               !
                rpsi3 = dir * rpsi3m + ( 1._wp - dir ) * rpsi3p
+               ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable)
+               zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) )
+               !
+               rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p
+               !
                ! shear prod. - stratif. destruction
                prod = rpsi1 * zratio * shear(ji,jj,jk)
+               prod = rpsi1 * zratio * p_sh2(ji,jj,jk)
+               !
                ! stratif. destruction
                buoy = rpsi3 * zratio * (- avt(ji,jj,jk) * rn2(ji,jj,jk) )
+               buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) )
+               !
                ! shear prod. - stratif. destruction
                diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk)
+               !
                dir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )   ! dir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
                zesh2 = dir * ( prod + buoy )          + (1._wp - dir ) * prod                        ! production term
                zdiss = dir * ( diss / psi(ji,jj,jk) ) + (1._wp - dir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
+               zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )     ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term
+               zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
+               !
                ! building the matrix
                zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
+               ! lower diagonal
+               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
+                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + rdt * zdiss * tmask(ji,jj,jk)
+               !
+               ! right hand side in psi
+               psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+               !                                               ! lower diagonal
+               zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )
+               !                                               ! upper diagonal
+               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+               !                                               ! diagonal
+               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk)
+               !                                               ! right hand side in psi
+               psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk)
             END DO
          END DO
       END DO
+      !
       z_elem_b(:,:,jpk) = 1._wp
+      zdiag(:,:,jpk) = 1._wp
       ! Surface boundary condition on psi
 …
+      !
       CASE ( 0 )             ! Dirichlet boundary conditions
+      !
+      ! Surface value
+      zdep(:,:)       = zhsro(:,:) * rl_sf ! Cosmetic
+      psi (:,:,1)     = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! One level below
+      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdepw_n(:,:,2)/zhsro(:,:) )))
+      zdep(:,:)       = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:)
+      psi (:,:,2)     = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,2) = 0._wp
+      z_elem_c(:,:,2) = 0._wp
+      z_elem_b(:,:,2) = 1._wp
+      !
+      !
+         !
+         ! 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_n(:,:,2)/zhsro(:,:) )))
+         zdep    (:,:)   = (zhsro(:,:) + gdepw_n(:,:,2)) * 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
+         !
       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)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! Neumann condition at k=2
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0._wp
+      !
+      ! Set psi vertical flux at the surface:
+      zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
+      zdep(:,:) = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
+      zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
+      zdep(:,:) =  rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * &
+             & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.)
+      zflxs(:,:) = zdep(:,:) * zflxs(:,:)
+      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2)
+      !
+      !
+         !
+         ! 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
+         zdiag(:,:,2) = zdiag(:,:,2) +  zd_lw(:,:,2) ! Remove zd_lw from zdiag
+         zd_lw(:,:,2) = 0._wp
+         !
+         ! Set psi vertical flux at the surface:
+         zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
+         zdep (:,:)   = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
+         zflxs(:,:)   = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
+         zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * &
+            &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.)
+         zflxs(:,:)   = zdep(:,:) * zflxs(:,:)
+         psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2)
+         !
       END SELECT
 …
       ! --------------------------------
+      !
+      SELECT CASE ( nn_bc_bot )
+      !
+!!gm should be done for ISF (top boundary cond.)
+!!gm so, totally new staff needed      ===>>> think about that !
+!
+      SELECT CASE ( nn_bc_bot )     ! bottom boundary
+      !
       CASE ( 0 )             ! Dirichlet
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0
+         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot
          !                      ! Balance between the production and the dissipation terms
          DO jj = 2, jpjm1
 …
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
                ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
                zdep(ji,jj) = vkarmn * rn_bfrz0
+               zdep(ji,jj) = vkarmn * r_z0_bot
                psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
                z_elem_a(ji,jj,ibot) = 0._wp
                z_elem_c(ji,jj,ibot) = 0._wp
                z_elem_b(ji,jj,ibot) = 1._wp
+               zd_lw(ji,jj,ibot) = 0._wp
+               zd_up(ji,jj,ibot) = 0._wp
+               zdiag(ji,jj,ibot) = 1._wp
+               !
                ! Just above last level, Dirichlet condition again (GOTM like)
                zdep(ji,jj) = vkarmn * ( rn_bfrz0 + e3t_n(ji,jj,ibotm1) )
+               zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t_n(ji,jj,ibotm1) )
                psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
                z_elem_a(ji,jj,ibotm1) = 0._wp
                z_elem_c(ji,jj,ibotm1) = 0._wp
                z_elem_b(ji,jj,ibotm1) = 1._wp
+               zd_lw(ji,jj,ibotm1) = 0._wp
+               zd_up(ji,jj,ibotm1) = 0._wp
+               zdiag(ji,jj,ibotm1) = 1._wp
             END DO
          END DO
 …
+               !
                ! Bottom level Dirichlet condition:
                zdep(ji,jj) = vkarmn * rn_bfrz0
+               zdep(ji,jj) = vkarmn * r_z0_bot
                psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+               !
                z_elem_a(ji,jj,ibot) = 0._wp
                z_elem_c(ji,jj,ibot) = 0._wp
                z_elem_b(ji,jj,ibot) = 1._wp
+               zd_lw(ji,jj,ibot) = 0._wp
+               zd_up(ji,jj,ibot) = 0._wp
+               zdiag(ji,jj,ibot) = 1._wp
+               !
                ! Just above last level: Neumann condition with flux injection
                z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1) ! Remove z_elem_c from z_elem_b
                z_elem_c(ji,jj,ibotm1) = 0.
+               zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag
+               zd_up(ji,jj,ibotm1) = 0.
+               !
                ! Set psi vertical flux at the bottom:
                zdep(ji,jj) = rn_bfrz0 + 0.5_wp*e3t_n(ji,jj,ibotm1)
                zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) )   &
+               zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t_n(ji,jj,ibotm1)
+               zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) )   &
                   &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
                psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1)
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
                z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-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 DO
          END DO
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
                z_elem_a(ji,jj,jk) = psi(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-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 DO
          END DO
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
                psi(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * psi(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+               psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
             END DO
          END DO
 …
       ! Limit dissipation rate under stable stratification
       ! --------------------------------------------------
       DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time
+      DO jk = 1, jpkm1 ! Note that this set boundary conditions on hmxl_n at the same time
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1    ! vector opt.
                ! limitation
                eps(ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
                mxln(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
+               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) mxln(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk) )
+               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 DO
          END DO
 …
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   ! zcof =  l²/q²
                   zcof = mxlb(ji,jj,jk) * mxlb(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
+                  zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
                   ! Gh = -N²l²/q²
                   gh = - rn2(ji,jj,jk) * zcof
 …
                   sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh)
+                  !
                   ! Store stability function in avmu and avmv
                   avmu(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
                   avmv(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+                  ! Store stability function in zstt and zstm
+                  zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+                  zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
                END DO
             END DO
 …
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   ! zcof =  l²/q²
                   zcof = mxlb(ji,jj,jk)*mxlb(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
+                  zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
                   ! Gh = -N²l²/q²
                   gh = - rn2(ji,jj,jk) * zcof
 …
                   gh = gh * rf6
                   ! Gm =  M²l²/q² Shear number
                   shr = shear(ji,jj,jk) / MAX( avm(ji,jj,jk), rsmall )
+                  shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall )
                   gm = MAX( shr * zcof , 1.e-10 )
                   gm = gm * rf6
 …
                   sh = (rs4 - rs5*gh + rs6*gm) / rcff
+                  !
                   ! Store stability function in avmu and avmv
                   avmu(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
                   avmv(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+                  ! Store stability function in zstt and zstm
+                  zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+                  zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
                END DO
             END DO
 …
       ! Lines below are useless if GOTM style Dirichlet conditions are used
       avmv(:,:,1) = avmv(:,:,2)
+      zstm(:,:,1) = zstm(:,:,2)
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
             avmv(ji,jj,mbkt(ji,jj)+1) = avmv(ji,jj,mbkt(ji,jj))
+            zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj))
          END DO
       END DO
+!!gm should be done for ISF (top boundary cond.)
+!!gm so, totally new staff needed!!gm
       ! Compute diffusivities/viscosities
 …
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zsqen         = SQRT( 2._wp * en(ji,jj,jk) ) * mxln(ji,jj,jk)
                zav           = zsqen * avmu(ji,jj,jk)
                avt(ji,jj,jk) = MAX( zav, avtb(jk) )*tmask(ji,jj,jk) ! apply mask for zdfmxl routine
                zav           = zsqen * avmv(ji,jj,jk)
                avm(ji,jj,jk) = MAX( zav, avmb(jk) ) ! Note that avm is not masked at the surface and the bottom
+               zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk)
+               zavt  = zsqen * zstt(ji,jj,jk)
+               zavm  = zsqen * zstm(ji,jj,jk)
+               p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine
+               p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom
             END DO
          END DO
       END DO
+      !
-      ! Lateral boundary conditions (sign unchanged)
       avt(:,:,1)  = 0._wp
+      CALL lbc_lnk( avm, 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. )
+      DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      avmu(:,:,1) = 0._wp             ;   avmv(:,:,1) = 0._wp                 ! set surface to zero
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )       ! Lateral boundary conditions
+      !
       IF(ln_ctl) THEN
+         CALL prt_ctl( tab3d_1=en  , clinfo1=' gls  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl( tab3d_1=avmu, clinfo1=' gls  - u: ', mask1=umask,                   &
+            &          tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk )
+         CALL prt_ctl( tab3d_1=en , clinfo1=' gls  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl( tab3d_1=avm, clinfo1=' gls  - m: ', ovlap=1, kdim=jpk )
       ENDIF
+      !
+      avt_k (:,:,:) = avt (:,:,:)
+      avm_k (:,:,:) = avm (:,:,:)
+      avmu_k(:,:,:) = avmu(:,:,:)
+      avmv_k(:,:,:) = avmv(:,:,:)
+      !
+      CALL wrk_dealloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_dealloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_gls')
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('zdf_gls')
+      !
    END SUBROUTINE zdf_gls
 …
       !!
       !! ** Purpose :   Initialization of the vertical eddy diffivity and
       !!      viscosity when using a gls turbulent closure scheme
+      !!              viscosity computed using a GLS turbulent closure scheme
       !!
       !! ** Method  :   Read the namzdf_gls namelist and check the parameters
-      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   Namlist namzdf_gls
 …
       !!
       !!----------------------------------------------------------------------
-      USE dynzdf_exp
-      USE trazdf_exp
+      !
       INTEGER ::   jk    ! dummy loop indices
       INTEGER ::   ios   ! Local integer output status for namelist read
 …
       IF(lwp) THEN                     !* Control print
          WRITE(numout,*)
          WRITE(numout,*) 'zdf_gls_init : gls turbulent closure scheme'
+         WRITE(numout,*) 'zdf_gls_init : GLS turbulent closure scheme'
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namzdf_gls : set gls mixing parameters'
 …
          WRITE(numout,*) '      Type of closure                               nn_clos        = ', nn_clos
          WRITE(numout,*) '      Surface roughness (m)                         rn_hsro        = ', rn_hsro
+         WRITE(numout,*) '      Bottom roughness (m) (nambfr namelist)        rn_bfrz0       = ', rn_bfrz0
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdrg_top/_bot:   used values:'
+         WRITE(numout,*) '      top    ocean cavity roughness (m)             rn_z0(_top)   = ', r_z0_top
+         WRITE(numout,*) '      Bottom seafloor     roughness (m)             rn_z0(_bot)   = ', r_z0_bot
+         WRITE(numout,*)
       ENDIF
       !                                !* allocate gls arrays
+      !                                !* allocate GLS arrays
       IF( zdf_gls_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_gls_init : unable to allocate arrays' )
       !                                !* Check of some namelist values
       IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )
       IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )
       IF( nn_z0_met < 0 .OR. nn_z0_met > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_z0_met is 0, 1, 2 or 3' )
       IF( nn_z0_met == 3 .AND. .NOT.ln_wave ) CALL ctl_stop( 'zdf_gls_init: nn_z0_met=3 requires ln_wave=T' )
       IF( nn_stab_func  < 0 .OR. nn_stab_func  > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_stab_func is 0, 1, 2 and 3' )
       IF( nn_clos       < 0 .OR. nn_clos       > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_clos is 0, 1, 2 or 3' )
+      IF( nn_bc_surf < 0   .OR. nn_bc_surf   > 1 )   CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )
+      IF( nn_bc_surf < 0   .OR. nn_bc_surf   > 1 )   CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )
+      IF( nn_z0_met  < 0   .OR. nn_z0_met    > 3 )   CALL ctl_stop( 'zdf_gls_init: bad flag: nn_z0_met is 0, 1, 2 or 3' )
+      IF( nn_z0_met == 3  .AND. .NOT.ln_wave     )   CALL ctl_stop( 'zdf_gls_init: nn_z0_met=3 requires ln_wave=T' )
+      IF( nn_stab_func < 0 .OR. nn_stab_func > 3 )   CALL ctl_stop( 'zdf_gls_init: bad flag: nn_stab_func is 0, 1, 2 and 3' )
+      IF( nn_clos      < 0 .OR. nn_clos      > 3 )   CALL ctl_stop( 'zdf_gls_init: bad flag: nn_clos is 0, 1, 2 or 3' )
       SELECT CASE ( nn_clos )          !* set the parameters for the chosen closure
 …
       CASE( 0 )                              ! k-kl  (Mellor-Yamada)
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-kl closed to the classical Mellor-Yamada'
+         IF(lwp) WRITE(numout,*) '   ==>>   k-kl closure chosen (i.e. closed to the classical Mellor-Yamada)'
+         IF(lwp) WRITE(numout,*)
          rpp     = 0._wp
          rmm     = 1._wp
 …
       CASE( 1 )                              ! k-eps
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-eps'
+         IF(lwp) WRITE(numout,*) '   ==>>   k-eps closure chosen'
+         IF(lwp) WRITE(numout,*)
          rpp     =  3._wp
          rmm     =  1.5_wp
 …
       CASE( 2 )                              ! k-omega
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-omega'
+         IF(lwp) WRITE(numout,*) '   ==>>   k-omega closure chosen'
+         IF(lwp) WRITE(numout,*)
          rpp     = -1._wp
          rmm     =  0.5_wp
 …
       CASE( 3 )                              ! generic
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is generic'
+         IF(lwp) WRITE(numout,*) '   ==>>   generic closure chosen'
+         IF(lwp) WRITE(numout,*)
          rpp     = 2._wp
          rmm     = 1._wp
 …
       CASE ( 0 )                             ! Galperin stability functions
+         !
          IF(lwp) WRITE(numout,*) 'Stability functions from Galperin'
+         IF(lwp) WRITE(numout,*) '   ==>>   Stability functions from Galperin'
          rc2     =  0._wp
          rc3     =  0._wp
 …
       CASE ( 1 )                             ! Kantha-Clayson stability functions
+         !
          IF(lwp) WRITE(numout,*) 'Stability functions from Kantha-Clayson'
+         IF(lwp) WRITE(numout,*) '   ==>>   Stability functions from Kantha-Clayson'
          rc2     =  0.7_wp
          rc3     =  0.2_wp
 …
       CASE ( 2 )                             ! Canuto A stability functions
+         !
          IF(lwp) WRITE(numout,*) 'Stability functions from Canuto A'
+         IF(lwp) WRITE(numout,*) '   ==>>   Stability functions from Canuto A'
          rs0 = 1.5_wp * rl1 * rl5*rl5
          rs1 = -rl4*(rl6+rl7) + 2._wp*rl4*rl5*(rl1-(1._wp/3._wp)*rl2-rl3) + 1.5_wp*rl1*rl5*rl8
 …
       CASE ( 3 )                             ! Canuto B stability functions
+         !
          IF(lwp) WRITE(numout,*) 'Stability functions from Canuto B'
+         IF(lwp) WRITE(numout,*) '   ==>>   Stability functions from Canuto B'
          rs0 = 1.5_wp * rm1 * rm5*rm5
          rs1 = -rm4 * (rm6+rm7) + 2._wp * rm4*rm5*(rm1-(1._wp/3._wp)*rm2-rm3) + 1.5_wp * rm1*rm5*rm8
 …
       IF(lwp) THEN                     !* Control print
          WRITE(numout,*)
+         WRITE(numout,*) 'Limit values'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Parameter  m = ',rmm
+         WRITE(numout,*) 'Parameter  n = ',rnn
+         WRITE(numout,*) 'Parameter  p = ',rpp
+         WRITE(numout,*) 'rpsi1   = ',rpsi1
+         WRITE(numout,*) 'rpsi2   = ',rpsi2
+         WRITE(numout,*) 'rpsi3m  = ',rpsi3m
+         WRITE(numout,*) 'rpsi3p  = ',rpsi3p
+         WRITE(numout,*) 'rsc_tke = ',rsc_tke
+         WRITE(numout,*) 'rsc_psi = ',rsc_psi
+         WRITE(numout,*) 'rsc_psi0 = ',rsc_psi0
+         WRITE(numout,*) 'rc0     = ',rc0
+         WRITE(numout,*) '   Limit values :'
+         WRITE(numout,*) '      Parameter  m = ', rmm
+         WRITE(numout,*) '      Parameter  n = ', rnn
+         WRITE(numout,*) '      Parameter  p = ', rpp
+         WRITE(numout,*) '      rpsi1    = ', rpsi1
+         WRITE(numout,*) '      rpsi2    = ', rpsi2
+         WRITE(numout,*) '      rpsi3m   = ', rpsi3m
+         WRITE(numout,*) '      rpsi3p   = ', rpsi3p
+         WRITE(numout,*) '      rsc_tke  = ', rsc_tke
+         WRITE(numout,*) '      rsc_psi  = ', rsc_psi
+         WRITE(numout,*) '      rsc_psi0 = ', rsc_psi0
+         WRITE(numout,*) '      rc0      = ', rc0
          WRITE(numout,*)
+         WRITE(numout,*) 'Shear free turbulence parameters:'
+         WRITE(numout,*) 'rcm_sf  = ',rcm_sf
+         WRITE(numout,*) 'ra_sf   = ',ra_sf
+         WRITE(numout,*) 'rl_sf   = ',rl_sf
+         WRITE(numout,*)
+         WRITE(numout,*) '   Shear free turbulence parameters:'
+         WRITE(numout,*) '      rcm_sf   = ', rcm_sf
+         WRITE(numout,*) '      ra_sf    = ', ra_sf
+         WRITE(numout,*) '      rl_sf    = ', rl_sf
       ENDIF
 …
       rsbc_psi1 = -0.5_wp * rdt * rc0**(rpp-2._wp*rmm) / rsc_psi
       rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking
+      !
       rfact_tke = -0.5_wp / rsc_tke * rdt                                ! Cst used for the Diffusion term of tke
       rfact_psi = -0.5_wp / rsc_psi * rdt                                ! Cst used for the Diffusion term of tke
+      !
       !                                !* Wall proximity function
+      zwall (:,:,:) = 1._wp * tmask(:,:,:)
+      !                                !* set vertical eddy coef. to the background value
+      DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+      !
+      CALL gls_rst( nit000, 'READ' )   !* read or initialize all required files
+!!gm tmask or wmask ????
+      zwall(:,:,:) = 1._wp * tmask(:,:,:)
+      !                                !* read or initialize all required files
+      CALL gls_rst( nit000, 'READ' )      ! (en, avt_k, avm_k, hmxl_n)
+      !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_gls_init')
 …
       !!                set to rn_emin or recomputed (nn_igls/=0)
       !!----------------------------------------------------------------------
       INTEGER         , INTENT(in) ::   kt         ! ocean time-step
       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      !
       INTEGER ::   jit, jk   ! dummy loop indices
       INTEGER ::   id1, id2, id3, id4, id5, id6
+      INTEGER ::   id1, id2, id3, id4
       INTEGER ::   ji, jj, ikbu, ikbv
       REAL(wp)::   cbx, cby
 …
          !                                   ! ---------------
          IF( ln_rstart ) THEN                   !* Read the restart file
+            id1 = iom_varid( numror, 'en'   , ldstop = .FALSE. )
+            id2 = iom_varid( numror, 'avt'  , ldstop = .FALSE. )
+            id3 = iom_varid( numror, 'avm'  , ldstop = .FALSE. )
+            id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. )
+            id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. )
+            id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. )
+            id1 = iom_varid( numror, 'en'    , ldstop = .FALSE. )
+            id2 = iom_varid( numror, 'avt_k' , ldstop = .FALSE. )
+            id3 = iom_varid( numror, 'avm_k' , ldstop = .FALSE. )
+            id4 = iom_varid( numror, 'hmxl_n', ldstop = .FALSE. )
+            !
             IF( MIN( id1, id2, id3, id4, id5, id6 ) > 0 ) THEN        ! all required arrays exist
+            IF( MIN( id1, id2, id3, id4 ) > 0 ) THEN        ! all required arrays exist
                CALL iom_get( numror, jpdom_autoglo, 'en'    , en     )
+               CALL iom_get( numror, jpdom_autoglo, 'avt'   , avt    )
+               CALL iom_get( numror, jpdom_autoglo, 'avm'   , avm    )
+               CALL iom_get( numror, jpdom_autoglo, 'avmu'  , avmu   )
+               CALL iom_get( numror, jpdom_autoglo, 'avmv'  , avmv   )
+               CALL iom_get( numror, jpdom_autoglo, 'mxln'  , mxln   )
+               CALL iom_get( numror, jpdom_autoglo, 'avt_k' , avt_k  )
+               CALL iom_get( numror, jpdom_autoglo, 'avm_k' , avm_k  )
+               CALL iom_get( numror, jpdom_autoglo, 'hmxl_n', hmxl_n )
             ELSE
+               IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop'
+               en  (:,:,:) = rn_emin
+               mxln(:,:,:) = 0.05
+               avt_k (:,:,:) = avt (:,:,:)
+               avm_k (:,:,:) = avm (:,:,:)
+               avmu_k(:,:,:) = avmu(:,:,:)
+               avmv_k(:,:,:) = avmv(:,:,:)
+               DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_gls( jit )   ;   END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '   ==>>   previous run without GLS scheme, set en and hmxl_n to background values'
+               en    (:,:,:) = rn_emin
+               hmxl_n(:,:,:) = 0.05_wp
+               ! avt_k, avm_k already set to the background value in zdf_phy_init
             ENDIF
          ELSE                                   !* Start from rest
+            IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values'
+            en  (:,:,:) = rn_emin
+            mxln(:,:,:) = 0.05
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '   ==>>   start from rest, set en and hmxl_n by background values'
+            en    (:,:,:) = rn_emin
+            hmxl_n(:,:,:) = 0.05_wp
+            ! avt_k, avm_k already set to the background value in zdf_phy_init
          ENDIF
+         !
 …
          !                                   ! -------------------
          IF(lwp) WRITE(numout,*) '---- gls-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     )
+         CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  )
+         CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
+         CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln   )
+         CALL iom_rstput( kt, nitrst, numrow, 'en'    , en     )
+         CALL iom_rstput( kt, nitrst, numrow, 'avt_k' , avt_k  )
+         CALL iom_rstput( kt, nitrst, numrow, 'avm_k' , avm_k  )
+         CALL iom_rstput( kt, nitrst, numrow, 'hmxl_n', hmxl_n )
+         !
       ENDIF
+      !
    END SUBROUTINE gls_rst
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                        NO TKE scheme
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfgls = .FALSE.   !: TKE flag
-CONTAINS
-   SUBROUTINE zdf_gls_init           ! Empty routine
-      WRITE(*,*) 'zdf_gls_init: You should not have seen this print! error?'
-   END SUBROUTINE zdf_gls_init
-   SUBROUTINE zdf_gls( kt )          ! Empty routine
-      WRITE(*,*) 'zdf_gls: You should not have seen this print! error?', kt
-   END SUBROUTINE zdf_gls
-   SUBROUTINE gls_rst( kt, cdrw )          ! Empty routine
-      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
-      WRITE(*,*) 'gls_rst: You should not have seen this print! error?', kt, cdrw
-   END SUBROUTINE gls_rst
-#endif
    !!======================================================================

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

-                      r7753
+                      r8215
    !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
    !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trc_oce, ONLY: l_offline         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE phycst          ! physical constants
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE trc_oce  , ONLY: l_offline         ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE phycst         ! physical constants
+   USE iom            ! I/O library
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
    IMPLICIT NONE
    PRIVATE
    PUBLIC   zdf_mxl       ! called by step.F90
+   PUBLIC   zdf_mxl   ! called by zdfphy.F90
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: depth of the last T-point inside the mixed layer [m]
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by LDF, ZDF, TRD, TOP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]   (used by TOP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]   (used by LDF)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: depth of the last T-point inside the mixed layer [m] (used by LDF)
    REAL(wp), PUBLIC ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth
 …
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
       INTEGER  ::   iikn, iiki, ikt ! local integer
       REAL(wp) ::   zN2_c           ! local scalar
       INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace
+      INTEGER, DIMENSION(jpi,jpj) ::   imld   ! 2D workspace
       !!----------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )  CALL timing_start('zdf_mxl')
+      !
-      CALL wrk_alloc( jpi,jpj, imld )
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
 …
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
+      !
-      CALL wrk_dealloc( jpi,jpj, imld )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl')
+      !

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

-                      r7646
+                      r8215
    !!                 Richardson number dependent formulation
    !!======================================================================
+   !! History :  OPA  ! 1987-09  (P. Andrich)  Original code
+   !!            4.0  ! 1991-11  (G. Madec)
+   !!            7.0  ! 1996-01  (G. Madec)  complete rewriting of multitasking suppression of common work arrays
+   !!            8.0  ! 1997-06  (G. Madec)  complete rewriting of zdfmix
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1! 2011-09  (P. Oddo) Mixed layer depth parameterization
+   !!----------------------------------------------------------------------
+#if defined key_zdfric
+   !!----------------------------------------------------------------------
+   !!   'key_zdfric'                                             Kz = f(Ri)
+   !!----------------------------------------------------------------------
+   !!   zdf_ric       : update momentum and tracer Kz from the Richardson
+   !!                  number computation
+   !! History :  OPA  !  1987-09  (P. Andrich)  Original code
+   !!            4.0  !  1991-11  (G. Madec)
+   !!            7.0  !  1996-01  (G. Madec)  complete rewriting of multitasking suppression of common work arrays
+   !!            8.0  !  1997-06  (G. Madec)  complete rewriting of zdfmix
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1!  2011-09  (P. Oddo) Mixed layer depth parameterization
+   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    !!   zdf_ric_init  : initialization, namelist read, & parameters control
+   !!   zdf_ric       : update momentum and tracer Kz from the Richardson number
+   !!   ric_rst       : read/write RIC restart in ocean restart file
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics
+   USE zdf_oce        ! vertical physics: variables
+   USE phycst         ! physical constants
+   USE sbc_oce,  ONLY :   taum
+   !
    USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE iom            ! I/O manager library
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-   USE eosbn2, ONLY : neos
    IMPLICIT NONE
    PRIVATE
+   PUBLIC   zdf_ric         ! called by step.F90
+   PUBLIC   zdf_ric_init    ! called by opa.F90
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.   !: Richardson vertical mixing flag
+   !                           !!* Namelist namzdf_ric : Richardson number dependent Kz *
+   INTEGER  ::   nn_ric         ! coefficient of the parameterization
+   REAL(wp) ::   rn_avmri       ! maximum value of the vertical eddy viscosity
+   REAL(wp) ::   rn_alp         ! coefficient of the parameterization
+   REAL(wp) ::   rn_ekmfc       ! Ekman Factor Coeff
+   REAL(wp) ::   rn_mldmin      ! minimum mixed layer (ML) depth
+   REAL(wp) ::   rn_mldmax      ! maximum mixed layer depth
+   REAL(wp) ::   rn_wtmix       ! Vertical eddy Diff. in the ML
+   REAL(wp) ::   rn_wvmix       ! Vertical eddy Visc. in the ML
+   LOGICAL  ::   ln_mldw        ! Use or not the MLD parameters
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric   !: coef. for the horizontal mean at t-point
+   PUBLIC   zdf_ric         ! called by zdfphy.F90
+   PUBLIC   ric_rst         ! called by zdfphy.F90
+   PUBLIC   zdf_ric_init    ! called by nemogcm.F90
+   !                        !!* Namelist namzdf_ric : Richardson number dependent Kz *
+   INTEGER  ::   nn_ric      ! coefficient of the parameterization
+   REAL(wp) ::   rn_avmri    ! maximum value of the vertical eddy viscosity
+   REAL(wp) ::   rn_alp      ! coefficient of the parameterization
+   REAL(wp) ::   rn_ekmfc    ! Ekman Factor Coeff
+   REAL(wp) ::   rn_mldmin   ! minimum mixed layer (ML) depth
+   REAL(wp) ::   rn_mldmax   ! maximum mixed layer depth
+   REAL(wp) ::   rn_wtmix    ! Vertical eddy Diff. in the ML
+   REAL(wp) ::   rn_wvmix    ! Vertical eddy Visc. in the ML
+   LOGICAL  ::   ln_mldw     ! Use or not the MLD parameters
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
 CONTAINS
+   INTEGER FUNCTION zdf_ric_alloc()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION zdf_ric_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( tmric(jpi,jpj,jpk)   , STAT= zdf_ric_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_ric_alloc )
+      IF( zdf_ric_alloc /= 0 )   CALL ctl_warn('zdf_ric_alloc: failed to allocate arrays')
+   END FUNCTION zdf_ric_alloc
+   SUBROUTINE zdf_ric( kt )
+   SUBROUTINE zdf_ric_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdf_ric_init  ***
+      !!
+      !! ** Purpose :   Initialization of the vertical eddy diffusivity and
+      !!      viscosity coef. for the Richardson number dependent formulation.
+      !!
+      !! ** Method  :   Read the namzdf_ric namelist and check the parameter values
+      !!
+      !! ** input   :   Namelist namzdf_ric
+      !!
+      !! ** Action  :   increase by 1 the nstop flag is setting problem encounter
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ios        ! Local integer output status for namelist read
+      !!
+      NAMELIST/namzdf_ric/ rn_avmri, rn_alp   , nn_ric  , rn_ekmfc,  &
+         &                rn_mldmin, rn_mldmax, rn_wtmix, rn_wvmix, ln_mldw
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_ric in reference namelist : Vertical diffusion Kz depends on Richardson number
+      READ  ( numnam_ref, namzdf_ric, IOSTAT = ios, ERR = 901)
+   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist namzdf_ric in configuration namelist : Vertical diffusion Kz depends on Richardson number
+      READ  ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 )
+   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_ric )
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_ric_init : Ri depend vertical mixing scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_ric : set Kz=F(Ri) parameters'
+         WRITE(numout,*) '      maximum vertical viscosity        rn_avmri  = ', rn_avmri
+         WRITE(numout,*) '      coefficient                       rn_alp    = ', rn_alp
+         WRITE(numout,*) '      exponent                          nn_ric    = ', nn_ric
+         WRITE(numout,*) '      Ekman layer enhanced mixing       ln_mldw   = ', ln_mldw
+         WRITE(numout,*) '         Ekman Factor Coeff             rn_ekmfc  = ', rn_ekmfc
+         WRITE(numout,*) '         minimum mixed layer depth      rn_mldmin = ', rn_mldmin
+         WRITE(numout,*) '         maximum mixed layer depth      rn_mldmax = ', rn_mldmax
+         WRITE(numout,*) '         Vertical eddy Diff. in the ML  rn_wtmix  = ', rn_wtmix
+         WRITE(numout,*) '         Vertical eddy Visc. in the ML  rn_wvmix  = ', rn_wvmix
+      ENDIF
+      !
+      CALL ric_rst( nit000, 'READ' )  !* read or initialize all required files
+      !
+   END SUBROUTINE zdf_ric_init
+   SUBROUTINE zdf_ric( kt, pdept, p_sh2, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE zdfric  ***
 …
       !!                with ri  = N^2 / dz(u)**2
       !!                         = e3w**2 * rn2/[ mi( dk(ub) )+mj( dk(vb) ) ]
+      !!                    avm0= rn_avmri / (1 + rn_alp*ri)**nn_ric
+      !!      Where ri is the before local Richardson number,
+      !!            rn_avmri is the maximum value reaches by avm and avt
+      !!            avmb and avtb are the background (or minimum) values
+      !!            and rn_alp, nn_ric are adjustable parameters.
+      !!      Typical values used are : avm0=1.e-2 m2/s, avmb=1.e-6 m2/s
+      !!      avtb=1.e-7 m2/s, rn_alp=5. and nn_ric=2.
+      !!      a numerical threshold is impose on the vertical shear (1.e-20)
+      !!                    avm0= rn_avmri / (1 + rn_alp*Ri)**nn_ric
+      !!                where ri is the before local Richardson number,
+      !!                rn_avmri is the maximum value reaches by avm and avt
+      !!                and rn_alp, nn_ric are adjustable parameters.
+      !!                Typical values : rn_alp=5. and nn_ric=2.
+      !!
       !!      As second step compute Ekman depth from wind stress forcing
       !!      and apply namelist provided vertical coeff within this depth.
 …
       !!              Ustar = SQRT(Taum/rho0)
       !!              ekd= rn_ekmfc * Ustar / f0
       !!      Large et al. (1994, eq.29) suggest rn_ekmfc=0.7; however, the derivation
+      !!      Large et al. (1994, eq.24) suggest rn_ekmfc=0.7; however, the derivation
       !!      of the above equation indicates the value is somewhat arbitrary; therefore
       !!      we allow the freedom to increase or decrease this value, if the
 …
       !!      namelist
       !!        N.B. the mask are required for implicit scheme, and surface
+      !!      and bottom value already set in zdfini.F90
+      !!      and bottom value already set in zdfphy.F90
+      !!
+      !! ** Action  :   avm, avt  mixing coeff (inner domain values only)
       !!
       !! References : Pacanowski & Philander 1981, JPO, 1441-1451.
       !!              PFJ Lermusiaux 2001.
       !!----------------------------------------------------------------------
+      USE phycst,   ONLY:   rsmall,rau0
+      USE sbc_oce,  ONLY:   taum
+      !!
+      INTEGER, INTENT( in ) ::   kt                           ! ocean time-step
+      !!
+      INTEGER  ::   ji, jj, jk                                ! dummy loop indices
+      REAL(wp) ::   zcoef, zdku, zdkv, zri, z05alp, zflageos  ! temporary scalars
+      REAL(wp) ::   zrhos, zustar
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, ekm_dep
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_ric')
+      !
+      CALL wrk_alloc( jpi,jpj, zwx, ekm_dep )
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Richardson number (put in zwx(ji,jj))
+         ! -----------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zcoef = 0.5 / e3w_n(ji,jj,jk)
+               !                                            ! shear of horizontal velocity
+               zdku = zcoef * (  ub(ji-1,jj,jk-1) + ub(ji,jj,jk-1)   &
+                  &             -ub(ji-1,jj,jk  ) - ub(ji,jj,jk  )  )
+               zdkv = zcoef * (  vb(ji,jj-1,jk-1) + vb(ji,jj,jk-1)   &
+                  &             -vb(ji,jj-1,jk  ) - vb(ji,jj,jk  )  )
+               !                                            ! richardson number (minimum value set to zero)
+               zri = rn2(ji,jj,jk) / ( zdku*zdku + zdkv*zdkv + 1.e-20 )
+               zwx(ji,jj) = MAX( zri, 0.e0 )
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'W', 1. )                       ! Boundary condition   (sign unchanged)
+         ! Vertical eddy viscosity and diffusivity coefficients
+         ! -------------------------------------------------------
+         z05alp = 0.5_wp * rn_alp
+         DO jj = 1, jpjm1                                   ! Eddy viscosity coefficients (avm)
+            DO ji = 1, fs_jpim1
+               avmu(ji,jj,jk) = umask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric
+               avmv(ji,jj,jk) = vmask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric
+            END DO
+         END DO
+         DO jj = 2, jpjm1                                   ! Eddy diffusivity coefficients (avt)
+            DO ji = fs_2, fs_jpim1
+               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1._wp + rn_alp * zwx(ji,jj) )           &
+                  &                            * (  avmu(ji,jj,jk) + avmu(ji-1,jj,jk)      &
+                  &                               + avmv(ji,jj,jk) + avmv(ji,jj-1,jk)  )   &
+                  &          + avtb(jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+         DO jj = 2, jpjm1                                   ! Add the background coefficient on eddy viscosity
+            DO ji = fs_2, fs_jpim1
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + avmb(jk) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + avmb(jk) * vmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      !
+      IF( ln_mldw ) THEN
+      !  Compute Ekman depth from wind stress forcing.
+      ! -------------------------------------------------------
+      zflageos = ( 0.5 + SIGN( 0.5, neos - 1. ) ) * rau0
+      DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+            zrhos          = rhop(ji,jj,1) + zflageos * ( 1. - tmask(ji,jj,1) )
+            zustar         = SQRT( taum(ji,jj) / ( zrhos +  rsmall ) )
+            ekm_dep(ji,jj) = rn_ekmfc * zustar / ( ABS( ff(ji,jj) ) + rsmall )
+            ekm_dep(ji,jj) = MAX(ekm_dep(ji,jj),rn_mldmin) ! Minimun allowed
+            ekm_dep(ji,jj) = MIN(ekm_dep(ji,jj),rn_mldmax) ! Maximum allowed
+         END DO
+      END DO
+      ! In the first model level vertical diff/visc coeff.s
+      ! are always equal to the namelist values rn_wtmix/rn_wvmix
+      ! -------------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            avmv(ji,jj,1) = MAX( avmv(ji,jj,1), rn_wvmix )
+            avmu(ji,jj,1) = MAX( avmu(ji,jj,1), rn_wvmix )
+            avt( ji,jj,1) = MAX(  avt(ji,jj,1), rn_wtmix )
+         END DO
+      END DO
+      !  Force the vertical mixing coef within the Ekman depth
+      ! -------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time-step
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdept          ! depth of t-point  [m]
+      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  ::   ji, jj, jk                  ! dummy loop indices
+      REAL(wp) ::   zcfRi, zav, zustar, zhek    ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zh_ekm  ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('zdf_ric')
+      !
+      !                       !==  avm and avt = F(Richardson number)  ==!
       DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
                IF( gdept_n(ji,jj,jk) < ekm_dep(ji,jj) ) THEN
                   avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix )
                   avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), rn_wvmix )
                   avt( ji,jj,jk) = MAX(  avt(ji,jj,jk), rn_wtmix )
                ENDIF
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1              ! 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
+               !                          ! avm and avt coefficients
+               p_avm(ji,jj,jk) = MAX(  zav         , avmb(jk)  ) * wmask(ji,jj,jk)
+               p_avt(ji,jj,jk) = MAX(  zav * zcfRi , avtb(jk)  ) * wmask(ji,jj,jk)
             END DO
          END DO
       END DO
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) * vmask(ji,jj,jk)
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) * umask(ji,jj,jk)
+               avt( ji,jj,jk) = avt( ji,jj,jk) * tmask(ji,jj,jk)
+      !
+!!gm BUG <<<<====  This param can't work at low latitude
+!!gm               it provides there much to thick mixed layer ( summer 150m in GYRE configuration !!! )
+      !
+      IF( ln_mldw ) THEN      !==  set a minimum value in the Ekman layer  ==!
+         !
+         DO jj = 2, jpjm1        !* Ekman depth
+            DO ji = 2, jpim1
+               zustar = SQRT( taum(ji,jj) * r1_rau0 )
+               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 DO
          END DO
+      END DO
+     ENDIF
+      CALL lbc_lnk( avt , 'W', 1. )                         ! Boundary conditions   (unchanged sign)
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
+      !
+      CALL wrk_dealloc( jpi,jpj, zwx, ekm_dep )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_ric')
+      !
+   END SUBROUTINE zdf_ric
+   SUBROUTINE zdf_ric_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdfbfr_init  ***
+      !!
+      !! ** Purpose :   Initialization of the vertical eddy diffusivity and
+      !!      viscosity coef. for the Richardson number dependent formulation.
+      !!
+      !! ** Method  :   Read the namzdf_ric namelist and check the parameter values
+      !!
+      !! ** input   :   Namelist namzdf_ric
+      !!
+      !! ** Action  :   increase by 1 the nstop flag is setting problem encounter
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ios        ! Local integer output status for namelist read
+      !!
+      NAMELIST/namzdf_ric/ rn_avmri, rn_alp   , nn_ric  , rn_ekmfc,  &
+         &                rn_mldmin, rn_mldmax, rn_wtmix, rn_wvmix, ln_mldw
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_ric in reference namelist : Vertical diffusion Kz depends on Richardson number
+      READ  ( numnam_ref, namzdf_ric, IOSTAT = ios, ERR = 901)
+   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist namzdf_ric in configuration namelist : Vertical diffusion Kz depends on Richardson number
+      READ  ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 )
+   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_ric )
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_ric : Ri depend vertical mixing scheme'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_ric : set Kz(Ri) parameters'
+         WRITE(numout,*) '      maximum vertical viscosity     rn_avmri  = ', rn_avmri
+         WRITE(numout,*) '      coefficient                    rn_alp    = ', rn_alp
+         WRITE(numout,*) '      coefficient                    nn_ric    = ', nn_ric
+         WRITE(numout,*) '      Ekman Factor Coeff             rn_ekmfc  = ', rn_ekmfc
+         WRITE(numout,*) '      minimum mixed layer depth      rn_mldmin = ', rn_mldmin
+         WRITE(numout,*) '      maximum mixed layer depth      rn_mldmax = ', rn_mldmax
+         WRITE(numout,*) '      Vertical eddy Diff. in the ML  rn_wtmix  = ', rn_wtmix
+         WRITE(numout,*) '      Vertical eddy Visc. in the ML  rn_wvmix  = ', rn_wvmix
+         WRITE(numout,*) '      Use the MLD parameterization   ln_mldw   = ', ln_mldw
+      ENDIF
+      !
+      !                              ! allocate zdfric arrays
+      IF( zdf_ric_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ric_init : unable to allocate arrays' )
+      !
+      DO jk = 1, jpk                 ! weighting mean array tmric for 4 T-points
+         DO jj = 2, jpj              ! which accounts for coastal boundary conditions
+            DO ji = 2, jpi
+               tmric(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)  )
+         DO jk = 2, jpkm1        !* minimum mixing coeff. within the Ekman layer
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  IF( pdept(ji,jj,jk) < zh_ekm(ji,jj) ) THEN
+                     p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk)
+                     p_avt(ji,jj,jk) = MAX(  p_avt(ji,jj,jk), rn_wtmix  ) * wmask(ji,jj,jk)
+                  ENDIF
+               END DO
             END DO
          END DO
+      END DO
+      tmric(:,1,:) = 0._wp
+      !
+      DO jk = 1, jpk                 ! Initialization of vertical eddy coef. to the background value
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+      !
+   END SUBROUTINE zdf_ric_init
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :              NO Richardson dependent vertical mixing
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .FALSE.   !: Richardson mixing flag
+CONTAINS
+   SUBROUTINE zdf_ric_init         ! Dummy routine
+   END SUBROUTINE zdf_ric_init
+   SUBROUTINE zdf_ric( kt )        ! Dummy routine
+      WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('zdf_ric')
+      !
    END SUBROUTINE zdf_ric
+#endif
+   SUBROUTINE ric_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ric_rst  ***
+      !!
+      !! ** Purpose :   Read or write TKE file (en) in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!                if the restart does not contain TKE, en is either
+      !!                set to rn_emin or recomputed
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      !
+      INTEGER ::   jit, jk    ! dummy loop indices
+      INTEGER ::   id1, id2   ! local integers
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
+         !                                   ! ---------------
+         !           !* Read the restart file
+         IF( ln_rstart ) THEN
+            id1 = iom_varid( numror, 'avt_k', ldstop = .FALSE. )
+            id2 = iom_varid( numror, 'avm_k', ldstop = .FALSE. )
+            !
+            IF( MIN( id1, id2 ) > 0 ) THEN         ! restart exists => read it
+               CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k )
+               CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k )
+            ENDIF
+         ENDIF
+         !           !* otherwise Kz already set to the background value in zdf_phy_init
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- ric-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k )
+         CALL iom_rstput( kt, nitrst, numrow, 'avm_k', avm_k )
+         !
+      ENDIF
+      !
+   END SUBROUTINE ric_rst
    !!======================================================================

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

-                      r7813
+                      r8215
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
+   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only
+   !!             -   !  2017-05  (G. Madec)  add top/bottom friction as boundary condition (ln_drg)
    !!----------------------------------------------------------------------
+#if defined key_zdftke
+   !!----------------------------------------------------------------------
+   !!   'key_zdftke'                                   TKE vertical physics
    !!----------------------------------------------------------------------
    !!   zdf_tke       : update momentum and tracer Kz from a tke scheme
 …
    USE sbc_oce        ! surface boundary condition: ocean
    USE zdf_oce        ! vertical physics: ocean variables
+   USE zdfdrg         ! vertical physics: top/bottom drag coef.
    USE zdfmxl         ! vertical physics: mixed layer
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl         ! Print control
-   USE in_out_manager ! I/O manager
-   USE iom            ! I/O manager library
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 #if defined key_agrif
    USE agrif_opa_interp
    USE agrif_opa_update
 #endif
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    IMPLICIT NONE
 …
    PUBLIC   zdf_tke_init   ! routine called in opa module
    PUBLIC   tke_rst        ! routine called in step module
-   LOGICAL , PUBLIC, PARAMETER ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag
    !                      !!** Namelist  namzdf_tke  **
 …
    REAL(wp) ::   rn_emin0  ! surface minimum value of tke   [m2/s2]
    REAL(wp) ::   rn_bshear ! background shear (>0) currently a numerical threshold (do not change it)
+   LOGICAL  ::   ln_drg    ! top/bottom friction forcing flag
    INTEGER  ::   nn_etau   ! type of depth penetration of surface tke (=0/1/2/3)
    INTEGER  ::   nn_htau   ! type of tke profile of penetration (=0/1)
    REAL(wp) ::   rn_efr    ! fraction of TKE surface value which penetrates in the ocean
+   INTEGER  ::      nn_htau   ! type of tke profile of penetration (=0/1)
+   REAL(wp) ::      rn_efr    ! fraction of TKE surface value which penetrates in the ocean
    LOGICAL  ::   ln_lc     ! Langmuir cells (LC) as a source term of TKE or not
    REAL(wp) ::   rn_lc     ! coef to compute vertical velocity of Langmuir cells
+   REAL(wp) ::      rn_lc     ! coef to compute vertical velocity of Langmuir cells
    REAL(wp) ::   ri_cri    ! critic Richardson number (deduced from rn_ediff and rn_ediss values)
 …
    REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr          ! now mixing lenght of dissipation
+#if defined key_c1d
+   !                                                                        !!** 1D cfg only  **   ('key_c1d')
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
+#endif
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau    ! depth of tke penetration (nn_htau)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl   ! now mixing lenght of dissipation
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr   ! now mixing lenght of dissipation
    !! * Substitutions
 …
       !!                ***  FUNCTION zdf_tke_alloc  ***
       !!----------------------------------------------------------------------
+      ALLOCATE(                                                                    &
+#if defined key_c1d
+         &      e_dis(jpi,jpj,jpk) , e_mix(jpi,jpj,jpk) ,                          &
+         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          &
+#endif
+         &      htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     &
+         &      apdlr(jpi,jpj,jpk) ,                                           STAT= zdf_tke_alloc      )
+      ALLOCATE( htau(jpi,jpj) , dissl(jpi,jpj,jpk) , apdlr(jpi,jpj,jpk) ,   STAT= zdf_tke_alloc )
+         !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc )
 …
    SUBROUTINE zdf_tke( kt )
+   SUBROUTINE zdf_tke( kt, p_sh2, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_tke  ***
 …
       !!
       !! ** Action  :   compute en (now turbulent kinetic energy)
       !!                update avt, avmu, avmv (before vertical eddy coef.)
+      !!                update avt, avm (before vertical eddy coef.)
       !!
       !! References : Gaspar et al., JGR, 1990,
 …
       !!              Bruchard OM 2002
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER                    , INTENT(in   ) ::   kt             ! ocean time step
+      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)
       !!----------------------------------------------------------------------
+      !
 …
 #endif
+      !
+      IF( kt /= nit000 ) THEN   ! restore before value to compute tke
+         avt (:,:,:) = avt_k (:,:,:)
+         avm (:,:,:) = avm_k (:,:,:)
+         avmu(:,:,:) = avmu_k(:,:,:)
+         avmv(:,:,:) = avmv_k(:,:,:)
+      ENDIF
+      !
+      CALL tke_tke      ! now tke (en)
+      !
+      CALL tke_avn      ! now avt, avm, avmu, avmv
+      !
+      avt_k (:,:,:) = avt (:,:,:)
+      avm_k (:,:,:) = avm (:,:,:)
+      avmu_k(:,:,:) = avmu(:,:,:)
+      avmv_k(:,:,:) = avmv(:,:,:)
+      CALL tke_tke( gdepw_n, e3t_n, e3w_n, p_sh2, p_avm, p_avt )   ! now tke (en)
+      !
+      CALL tke_avn( gdepw_n, e3t_n, e3w_n,        p_avm, p_avt )   ! now avt, avm, dissl
+      !
 #if defined key_agrif
 …
       IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only
 #endif
+     !
+      !
   END SUBROUTINE zdf_tke
+   SUBROUTINE tke_tke
+   SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2    &
+      &                            , p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tke_tke  ***
 …
       !! ** Method  : - TKE surface boundary condition
       !!              - source term due to Langmuir cells (Axell JGR 2002) (ln_lc=T)
       !!              - source term due to shear (saved in avmu, avmv arrays)
+      !!              - source term due to shear (= Kz dz[Ub] * dz[Un] )
       !!              - Now TKE : resolution of the TKE equation by inverting
       !!                a tridiagonal linear system by a "methode de chasse"
 …
       !!
       !! ** Action  : - en : now turbulent kinetic energy)
-      !!              - avmu, avmv : production of TKE by shear at u and v-points
-      !!                (= Kz dz[Ub] * dz[Un] )
       !! ---------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
+!!bfr      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1      ! temporary scalar
+!!bfr      INTEGER  ::   ikbt, ikbumm1, ikbvmm1          ! temporary scalar
+      REAL(wp) ::   zrhoa  = 1.22                   ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3                 ! drag coefficient
+      REAL(wp) ::   zbbrau, zesh2                   ! temporary scalars
+      REAL(wp) ::   zfact1, zfact2, zfact3          !    -         -
+      REAL(wp) ::   ztx2  , zty2  , zcof            !    -         -
+      REAL(wp) ::   ztau  , zdif                    !    -         -
+      REAL(wp) ::   zus   , zwlc  , zind            !    -         -
+      REAL(wp) ::   zzd_up, zzd_lw                  !    -         -
+!!bfr      REAL(wp) ::   zebot                           !    -         -
+      INTEGER , POINTER, DIMENSION(:,:  ) ::   imlc
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhlc
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv
+      REAL(wp)                            ::   zri  !   local Richardson number
+      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pdepw          ! depth of w-points
+      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points)
+      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 ::   ji, jj, jk              ! dummy loop arguments
+      REAL(wp) ::   zetop, zebot, zmsku, zmskv ! local scalars
+      REAL(wp) ::   zrhoa  = 1.22              ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3            ! drag coefficient
+      REAL(wp) ::   zbbrau, zri                ! local scalars
+      REAL(wp) ::   zfact1, zfact2, zfact3     !   -         -
+      REAL(wp) ::   ztx2  , zty2  , zcof       !   -         -
+      REAL(wp) ::   ztau  , zdif               !   -         -
+      REAL(wp) ::   zus   , zwlc  , zind       !   -         -
+      REAL(wp) ::   zzd_up, zzd_lw             !   -         -
+      INTEGER , DIMENSION(jpi,jpj)     ::   imlc
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw
       !!--------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )  CALL timing_start('tke_tke')
+      !
-      CALL wrk_alloc( jpi,jpj,       imlc )    ! integer
-      CALL wrk_alloc( jpi,jpj,       zhlc )
-      CALL wrk_alloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )
+      !
       zbbrau = rn_ebb / rau0       ! Local constant initialisation
 …
+      !
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Surface boundary condition on tke
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Surface/top/bottom boundary condition on tke
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
       IF ( ln_isfcav ) THEN
          DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin
 …
             END DO
          END DO
+      END IF
+      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+      ENDIF
-!!bfr   - start commented area
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !                     !  Bottom boundary condition on tke
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! Tests to date have found the bottom boundary condition on tke to have very little effect.
+      ! The condition is coded here for completion but commented out until there is proof that the
+      ! computational cost is justified
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     en(bot)   = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
+!!    DO jj = 2, jpjm1
+!!       DO ji = fs_2, fs_jpim1   ! vector opt.
+!!          ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + &
+!!                 bfrua(ji  ,jj) * ub(ji  ,jj,mbku(ji  ,jj) )
+!!          zty2 = bfrva(ji,jj  ) * vb(ji,jj  ,mbkv(ji,jj  )) + &
+!!                 bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1) )
+!!          zebot = 0.001875_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 )   !  where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.
+!!          en (ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * tmask(ji,jj,1)
+!!       END DO
+!!    END DO
+!!bfr   - end commented area
+      !
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke       (Axell JGR 2002)
+      !   en(bot)   = (ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
+      ! where ebb0 does not includes surface wave enhancement (i.e. ebb0=3.75)
+      ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2
+      !
+      IF( ln_drg ) THEN       !== friction used as top/bottom boundary condition on TKE
+         !
+         DO jj = 2, jpjm1           ! bottom friction
+            DO ji = fs_2, fs_jpim1     ! vector opt.
+               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)) )
+               !                       ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)
+               zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  &
+                  &                                           + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  )
+               en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj)
+            END DO
+         END DO
+         IF( ln_isfcav ) THEN       ! top friction
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  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)) )
+                  !                             ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0)
+                  zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  &
+                     &                                           + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  )
+                  en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1))   ! masked at ocean surface
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke   !   (Axell JGR 2002)
          !                  !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+         !
          !                        !* total energy produce by LC : cumulative sum over jk
          zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1)
+         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * pdepw(:,:,1) * p_e3w(:,:,1)
          DO jk = 2, jpk
             zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk)
+            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * pdepw(:,:,jk) * p_e3w(:,:,jk)
          END DO
          !                        !* finite Langmuir Circulation depth
 …
          DO jj = 1, jpj
             DO ji = 1, jpi
                zhlc(ji,jj) = gdepw_n(ji,jj,imlc(ji,jj))
+               zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj))
             END DO
          END DO
 …
                   zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
                   !                                           ! vertical velocity due to LC
                   zind = 0.5 - SIGN( 0.5, gdepw_n(ji,jj,jk) - zhlc(ji,jj) )
                   zwlc = zind * rn_lc * zus * SIN( rpi * gdepw_n(ji,jj,jk) / zhlc(ji,jj) )
+                  zind = 0.5 - SIGN( 0.5, pdepw(ji,jj,jk) - zhlc(ji,jj) )
+                  zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) )
                   !                                           ! TKE Langmuir circulation source term
                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   &
 …
       !                     ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
+      !
+      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form)
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji+1,jj,jk) )   &
+                  &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   &
+                  &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) &
+                  &                 / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) )
+               z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   &
+                  &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   &
+                  &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) &
+                  &                 / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: compute apdlr
+         ! Note that zesh2 is also computed in the next loop.
+         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number = F( Ri )
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                                          ! 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 ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear )
+               DO ji = 2, jpim1
+                  !                             ! local Richardson number
+                  zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear )
+                  !                             ! inverse of Prandtl number
                   apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
+               END DO
+            END DO
+         END DO
+         !
+               END DO
+            END DO
+         END DO
       ENDIF
+      !
 …
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zcof   = zfact1 * tmask(ji,jj,jk)
+# if defined key_zdftmx_new
+               ! key_zdftmx_new: New internal wave-driven param: set a minimum value for Kz on TKE (ensure numerical stability)
+               zzd_up = zcof * MAX( avm(ji,jj,jk+1) + avm(ji,jj,jk), 2.e-5_wp )   &  ! upper diagonal
+                  &          / (  e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  )  )
+               zzd_lw = zcof * MAX( avm(ji,jj,jk) + avm(ji,jj,jk-1), 2.e-5_wp )   &  ! lower diagonal
+                  &          / (  e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  )  )
+# else
+               zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal
+                  &          / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  ) )
+               zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal
+                  &          / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
+# endif
+               !                                   ! 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) )
+               !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical
+               !                                   ! eddy coefficient (ensure numerical stability)
+               zzd_up = zcof * MAX(  p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal
+                  &          /    (  p_e3t(ji,jj,jk  ) * p_e3w(ji,jj,jk  )  )
+               zzd_lw = zcof * MAX(  p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal
+                  &          /    (  p_e3t(ji,jj,jk-1) * p_e3w(ji,jj,jk  )  )
+               !
                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
                zd_lw(ji,jj,jk) = zzd_lw
                zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * tmask(ji,jj,jk)
+               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk)
+               !
                !                                   ! right hand side in en
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  zesh2  -   avt(ji,jj,jk) * rn2(ji,jj,jk)    &
+                  &                                 + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk)  ) &
+                  &                                 * wmask(ji,jj,jk)
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  p_sh2(ji,jj,jk)                          &   ! shear
+                  &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification
+                  &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation
+                  &                                ) * wmask(ji,jj,jk)
             END DO
          END DO
 …
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 !!gm BUG : in the exp  remove the depth of ssh !!!
+!!gm       i.e. use gde3w in argument (pdepw)
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
+                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
                      &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
 …
             DO ji = fs_2, fs_jpim1   ! vector opt.
                jk = nmln(ji,jj)
                en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
+               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
                   &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
             END DO
 …
                   zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean
                   zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
                   en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
+                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   &
                      &                        * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
 …
          END DO
       ENDIF
-      CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
+      !
-      CALL wrk_dealloc( jpi,jpj,       imlc )    ! integer
-      CALL wrk_dealloc( jpi,jpj,       zhlc )
-      CALL wrk_dealloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('tke_tke')
 …
    SUBROUTINE tke_avn
+   SUBROUTINE tke_avn( pdepw, p_e3t, p_e3w, p_avm, p_avt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tke_avn  ***
 …
       !!      with pdlr=1 if nn_pdl=0, pdlr=1/pdl=F(Ri) otherwise.
       !!
+      !! ** Action  : - avt : now vertical eddy diffusivity (w-point)
+      !!              - avmu, avmv : now vertical eddy viscosity at uw- and vw-points
+      !!----------------------------------------------------------------------
+      !! ** Action  : - avt, avm : now vertical eddy diffusivity and viscosity (w-point)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdepw          ! depth (w-points)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points)
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points)
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars
       REAL(wp) ::   zdku, zri, zsqen            !   -      -
       REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld
+      REAL(wp) ::   zrn2, zraug, zcoef, zav   ! local scalars
+      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      -
+      REAL(wp) ::   zemxl, zemlm, zemlp       !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld
       !!--------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )  CALL timing_start('tke_avn')
-      CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 …
+      !
       IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
+         zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
                zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) )
             END DO
 …
+      !
  !!gm Not sure of that coding for ISF....
       ! where wmask = 0 set zmxlm == e3w_n
+      ! where wmask = 0 set zmxlm == p_e3w
       CASE ( 0 )           ! bounded by the distance to surface and bottom
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemxl = MIN( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
                   &            gdepw_n(ji,jj,mbkt(ji,jj)+1) - gdepw_n(ji,jj,jk) )
+                  zemxl = MIN( pdepw(ji,jj,jk) - pdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
+                  &            pdepw(ji,jj,mbkt(ji,jj)+1) - pdepw(ji,jj,jk) )
                   ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
                   zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
                   zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
+                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
+                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk))
                END DO
             END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemxl = MIN( e3w_n(ji,jj,jk), zmxlm(ji,jj,jk) )
+                  zemxl = MIN( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
                   zmxld(ji,jj,jk) = zemxl
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
                END DO
             END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+                  zemxl = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
                   zmxld(ji,jj,jk) = zemxl
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
                END DO
             END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
                END DO
             END DO
 …
       END SELECT
+      !
+# if defined key_c1d
+      e_dis(:,:,:) = zmxld(:,:,:)      ! c1d configuration : save mixing and dissipation turbulent length scales
+      e_mix(:,:,:) = zmxlm(:,:,:)
+# endif
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt)
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt)
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
 …
                zsqen = SQRT( en(ji,jj,jk) )
                zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
                avm  (ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
                avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+               p_avm(ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
+               p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
                dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
             END DO
          END DO
       END DO
+      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
+      !
+      DO jk = 2, jpkm1            !* vertical eddy viscosity at wu- and wv-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions
+      !
+      !
       IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+# if defined key_c1d
+                  e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number
+!!gm bug NO zri here....
+!!gm remove the specific diag for c1d !
+                  e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk)                            ! c1d config. : save Ri
+# endif
+                  p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
               END DO
             END DO
          END DO
       ENDIF
-      CALL lbc_lnk( avt, 'W', 1. )                      ! Lateral boundary conditions on avt  (sign unchanged)
       IF(ln_ctl) THEN
+         CALL prt_ctl( tab3d_1=en  , clinfo1=' tke  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl( tab3d_1=avmu, clinfo1=' tke  - u: ', mask1=umask,                   &
+            &          tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )
+         CALL prt_ctl( tab3d_1=en , clinfo1=' tke  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl( tab3d_1=avm, clinfo1=' tke  - m: ', ovlap=1, kdim=jpk )
+      ENDIF
+      !
       IF( nn_timing == 1 )  CALL timing_stop('tke_avn')
 …
       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,   &
          &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,   &
          &                 rn_mxl0 , nn_pdl   , ln_lc  , rn_lc    ,   &
+         &                 rn_mxl0 , nn_pdl   , ln_drg , ln_lc    , rn_lc    ,   &
          &                 nn_etau , nn_htau  , rn_efr
       !!----------------------------------------------------------------------
 …
+      !
       ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number
-# if defined key_zdftmx_new
-      ! key_zdftmx_new: New internal wave-driven param: specified value of rn_emin & rmxl_min are used
-      rn_emin  = 1.e-10_wp
-      rmxl_min = 1.e-03_wp
-      IF(lwp) THEN                  ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'zdf_tke_init :  New tidal mixing case: force rn_emin = 1.e-10 and rmxl_min = 1.e-3 '
-         WRITE(numout,*) '~~~~~~~~~~~~'
-      ENDIF
-# else
-      rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity
-# endif
+      !
       IF(lwp) THEN                    !* Control print
 …
          WRITE(numout,*) '      minimum value of tke                        rn_emin   = ', rn_emin
          WRITE(numout,*) '      surface minimum value of tke                rn_emin0  = ', rn_emin0
+         WRITE(numout,*) '      prandl number flag                          nn_pdl    = ', nn_pdl
          WRITE(numout,*) '      background shear (>0)                       rn_bshear = ', rn_bshear
          WRITE(numout,*) '      mixing length type                          nn_mxl    = ', nn_mxl
          WRITE(numout,*) '      prandl number flag                          nn_pdl    = ', nn_pdl
          WRITE(numout,*) '      surface mixing length = F(stress) or not    ln_mxl0   = ', ln_mxl0
          WRITE(numout,*) '      surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0
          WRITE(numout,*) '      flag to take into acc.  Langmuir circ.      ln_lc     = ', ln_lc
          WRITE(numout,*) '      coef to compute verticla velocity of LC     rn_lc     = ', rn_lc
+         WRITE(numout,*) '         surface mixing length = F(stress) or not    ln_mxl0   = ', ln_mxl0
+         WRITE(numout,*) '         surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0
+         WRITE(numout,*) '      top/bottom friction forcing flag            ln_drg    = ', ln_drg
+         WRITE(numout,*) '      Langmuir cells parametrization              ln_lc     = ', ln_lc
+         WRITE(numout,*) '         coef to compute vertical velocity of LC     rn_lc  = ', rn_lc
          WRITE(numout,*) '      test param. to add tke induced by wind      nn_etau   = ', nn_etau
          WRITE(numout,*) '      flag for computation of exp. tke profile    nn_htau   = ', nn_htau
          WRITE(numout,*) '      fraction of en which pene. the thermocline  rn_efr    = ', rn_efr
+         WRITE(numout,*) '          type of tke penetration profile            nn_htau   = ', nn_htau
+         WRITE(numout,*) '          fraction of TKE that penetrates            rn_efr    = ', rn_efr
          WRITE(numout,*)
+         WRITE(numout,*) '      critical Richardson nb with your parameters  ri_cri = ', ri_cri
+         IF( ln_drg ) THEN
+            WRITE(numout,*) '   Namelist namdrg_top/_bot:   used values:'
+            WRITE(numout,*) '      top    ocean cavity roughness (m)          rn_z0(_top)= ', r_z0_top
+            WRITE(numout,*) '      Bottom seafloor     roughness (m)          rn_z0(_bot)= ', r_z0_bot
+         ENDIF
+         WRITE(numout,*)
+         WRITE(numout,*)
+         WRITE(numout,*) '   ==>> critical Richardson nb with your parameters  ri_cri = ', ri_cri
+         WRITE(numout,*)
+      ENDIF
+      !
+      IF( ln_zdfiwm ) THEN          ! Internal wave-driven mixing
+         rn_emin  = 1.e-10_wp             ! specific values of rn_emin & rmxl_min are used
+         rmxl_min = 1.e-03_wp             ! associated avt minimum = molecular salt diffusivity (10^-9 m2/s)
+         IF(lwp) WRITE(numout,*) '      Internal wave-driven mixing case:   force   rn_emin = 1.e-10 and rmxl_min = 1.e-3 '
+      ELSE                          ! standard case : associated avt minimum = molecular viscosity (10^-6 m2/s)
+         rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity
+         IF(lwp) WRITE(numout,*) '      minimum mixing length with your parameters rmxl_min = ', rmxl_min
       ENDIF
+      !
 …
       !                               !* set vertical eddy coef. to the background value
       DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+         avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
+         avt(:,:,jk) = avtb(jk) * wmask(:,:,jk)
+         avm(:,:,jk) = avmb(jk) * wmask(:,:,jk)
       END DO
       dissl(:,:,:) = 1.e-12_wp
 …
    SUBROUTINE tke_rst( kt, cdrw )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE tke_rst  ***
+     !!
+     !! ** Purpose :   Read or write TKE file (en) in restart file
+     !!
+     !! ** Method  :   use of IOM library
+     !!                if the restart does not contain TKE, en is either
+     !!                set to rn_emin or recomputed
+     !!----------------------------------------------------------------------
+     INTEGER         , INTENT(in) ::   kt     ! ocean time-step
+     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+     !
+     INTEGER ::   jit, jk   ! dummy loop indices
+     INTEGER ::   id1, id2, id3, id4, id5, id6   ! local integers
+     !!----------------------------------------------------------------------
+     !
+     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
+        !                                   ! ---------------
+        IF( ln_rstart ) THEN                   !* Read the restart file
+           id1 = iom_varid( numror, 'en'   , ldstop = .FALSE. )
+           id2 = iom_varid( numror, 'avt'  , ldstop = .FALSE. )
+           id3 = iom_varid( numror, 'avm'  , ldstop = .FALSE. )
+           id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. )
+           id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. )
+           id6 = iom_varid( numror, 'dissl', ldstop = .FALSE. )
+           !
+           IF( id1 > 0 ) THEN                       ! 'en' exists
+              CALL iom_get( numror, jpdom_autoglo, 'en', en )
+              IF( MIN( id2, id3, id4, id5, id6 ) > 0 ) THEN        ! all required arrays exist
+                 CALL iom_get( numror, jpdom_autoglo, 'avt'  , avt   )
+                 CALL iom_get( numror, jpdom_autoglo, 'avm'  , avm   )
+                 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu  )
+                 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv  )
+                 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl )
+              ELSE                                                 ! one at least array is missing
+                 CALL tke_avn                                          ! compute avt, avm, avmu, avmv and dissl (approximation)
+              ENDIF
+           ELSE                                     ! No TKE array found: initialisation
+              IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme, en computed by iterative loop'
+              en (:,:,:) = rn_emin * tmask(:,:,:)
+              CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation)
+              !
+              avt_k (:,:,:) = avt (:,:,:)
+              avm_k (:,:,:) = avm (:,:,:)
+              avmu_k(:,:,:) = avmu(:,:,:)
+              avmv_k(:,:,:) = avmv(:,:,:)
+              !
+              DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO
+           ENDIF
+        ELSE                                   !* Start from rest
+           en(:,:,:) = rn_emin * tmask(:,:,:)
+           DO jk = 1, jpk                           ! set the Kz to the background value
+              avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+              avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+              avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+              avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
+           END DO
+        ENDIF
+        !
+     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+        !                                   ! -------------------
+        IF(lwp) WRITE(numout,*) '---- tke-rst ----'
+        CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     )
+        CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  )
+        CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  )
+        CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
+        CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
+        CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl  )
+        !
+     ENDIF
+     !
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE tke_rst  ***
+      !!
+      !! ** Purpose :   Read or write TKE file (en) in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!                if the restart does not contain TKE, en is either
+      !!                set to rn_emin or recomputed
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      !
+      INTEGER ::   jit, jk              ! dummy loop indices
+      INTEGER ::   id1, id2, id3, id4   ! local integers
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
+         !                                   ! ---------------
+         IF( ln_rstart ) THEN                   !* Read the restart file
+            id1 = iom_varid( numror, 'en'   , ldstop = .FALSE. )
+            id2 = iom_varid( numror, 'avt_k', ldstop = .FALSE. )
+            id3 = iom_varid( numror, 'avm_k', ldstop = .FALSE. )
+            id4 = iom_varid( numror, 'dissl', ldstop = .FALSE. )
+            !
+            IF( MIN( id1, id2, id3, id4 ) > 0 ) THEN      ! fields exist
+               CALL iom_get( numror, jpdom_autoglo, 'en', en )
+               CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k )
+               CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k )
+               CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl )
+            ELSE                                          ! start TKE from rest
+               IF(lwp) WRITE(numout,*) '   ==>>   previous run without TKE scheme, set en to background values'
+               en(:,:,:) = rn_emin * wmask(:,:,:)
+               ! avt_k, avm_k already set to the background value in zdf_phy_init
+            ENDIF
+         ELSE                                   !* Start from rest
+            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set en to the background value'
+            en(:,:,:) = rn_emin * wmask(:,:,:)
+            ! avt_k, avm_k already set to the background value in zdf_phy_init
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- tke-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    )
+         CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k )
+         CALL iom_rstput( kt, nitrst, numrow, 'avm_k', avm_k )
+         CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl )
+         !
+      ENDIF
+      !
    END SUBROUTINE tke_rst
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                        NO TKE scheme
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag
-CONTAINS
-   SUBROUTINE zdf_tke_init           ! Dummy routine
-   END SUBROUTINE zdf_tke_init
-   SUBROUTINE zdf_tke( kt )          ! Dummy routine
-      WRITE(*,*) 'zdf_tke: You should not have seen this print! error?', kt
-   END SUBROUTINE zdf_tke
-   SUBROUTINE tke_rst( kt, cdrw )
-     CHARACTER(len=*) ::   cdrw
-     WRITE(*,*) 'tke_rst: You should not have seen this print! error?', kt, cdwr
-   END SUBROUTINE tke_rst
-#endif
    !!======================================================================

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/module_example

-                      r4147
+                      r8215
       !!                Give references if exist otherwise suppress these lines
       !!----------------------------------------------------------------------
-      USE toto_module      ! description of the module
-      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY:   zztab => wrk_2d_5                     ! 2D workspace
-      USE wrk_nemo, ONLY:   zwx => wrk_3d_12 , zwy => wrk_3d_13   ! 3D workspace
-      !!
       INTEGER , INTENT(in   )                     ::   kt      ! short description
       INTEGER , INTENT(inout)                     ::   pvar1   !   -         -
 …
       REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z)
       REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwrk_2d   ! 2D workspace
       !!--------------------------------------------------------------------
+      IF( wrk_in_use(3, 12,13) .OR. wrk_in_use(2, 5 ) THEN
+         CALL ctl_stop('exa_mpl: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
+      !
       IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   avmv(ji,jj,jk) = ....
+                  avm(ji,jj,jk) = ....
                END DO
             END DO
 …
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   avmv(ji,jj,jk) = ...
+                  avm(ji,jj,jk) = ...
                END DO
             END DO
 …
       END SELECT
+      !
+      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign)
+      !
+      IF( wrk_not_released(3, 12,13) .OR. wrk_not_released(2, 5 ) THEN
+         CALL ctl_stop('exa_mpl: failed to release workspace arrays')   ;   RETURN
+      ENDIF
+      CALL lbc_lnk( avm, 'T', 1. )              ! Lateral boundary conditions (unchanged sign)
+      !
    END SUBROUTINE exa_mpl

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

-                      r7761
+                      r8215
    USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine)
    USE ldftra         ! lateral diffusivity setting    (ldftra_init routine)
-   USE zdfini         ! vertical physics setting          (zdf_init routine)
    USE trdini         ! dyn/tra trends initialization     (trd_init routine)
    USE asminc         ! assimilation increments
 …
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
       CALL diurnal_sst_bulk_init            ! diurnal sst
+      CALL diurnal_sst_bulk_init             ! diurnal sst
       IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin
 …
                             CALL     sbc_init   ! surface boundary conditions (including sea-ice)
                             CALL     bdy_init   ! Open boundaries initialisation
       !                                      ! Ocean physics
+      !                                         ! Vertical physics
+                            CALL     zdf_init      ! namelist read
+                            CALL zdf_bfr_init      ! bottom friction
+      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz
+      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme
+      IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme
+      IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing
+      IF( lk_zdfddm     )   CALL zdf_ddm_init      ! double diffusive mixing
+                            CALL zdf_phy_init   ! Vertical physics
       !                                         ! Lateral physics
                             CALL ldf_tra_init      ! Lateral ocean tracer physics
 …
                             CALL ldf_dyn_init      ! Lateral ocean momentum physics
       !                                         ! Active tracers
+      !                                      ! Active tracers
                             CALL tra_qsr_init      ! penetrative solar radiation qsr
                             CALL tra_bbc_init      ! bottom heat flux
       IF( lk_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme
                             CALL tra_dmp_init      ! internal tracer damping
                             CALL tra_adv_init      ! horizontal & vertical advection
                             CALL tra_ldf_init      ! lateral mixing
+                            CALL tra_zdf_init      ! vertical mixing and after tracer fields
+      !                                         ! Dynamics
+      !                                      ! Dynamics
       IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping
                             CALL dyn_adv_init      ! advection (vector or flux form)
 …
                             CALL dyn_ldf_init      ! lateral mixing
                             CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure
-                            CALL dyn_zdf_init      ! vertical diffusion
                             CALL dyn_spg_init      ! surface pressure gradient
 …
       IF( ln_diaobs     )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
       !                                         ! Assimilation increments
+      !                                      ! Assimilation increments
       IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
 …
+      !
       IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
       IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
+      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
       IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
       IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/oce.F90

-                      r7646
+                      r8215
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riceload
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
    !! arrays relating to embedding ice in the ocean. These arrays need to be declared
    !! even if no ice model is required. In the no ice model or traditional levitating
 …
          &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE(rke(jpi,jpj,jpk)  ,                                         &
+         &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
+         &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
+         &     vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     &
+         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &     gru(jpi,jpj)      , grv(jpi,jpj)      ,                     &
+         &     gtui(jpi,jpj,jpts), gtvi(jpi,jpj,jpts),                     &
+         &     grui(jpi,jpj)     , grvi(jpi,jpj)     ,                     &
+         &     riceload(jpi,jpj),                             STAT=ierr(2) )
+      ALLOCATE( sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
+         &      ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
+         &      vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     &
+         &      spgu  (jpi,jpj)   , spgv(jpi,jpj)                     ,     &
+         &      gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts)                ,     &
+         &      gru(jpi,jpj)      , grv(jpi,jpj)                      ,     &
+         &      gtui(jpi,jpj,jpts), gtvi(jpi,jpj,jpts)                ,     &
+         &      grui(jpi,jpj)     , grvi(jpi,jpj)                     ,     &
+         &      riceload(jpi,jpj)                                     , STAT=ierr(2) )
+         !
       ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) )

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/step.F90

-                      r7753
+                      r8215
    !!            3.7  !  2014-10  (G. Madec)  LDF simplication
    !!             -   !  2014-12  (G. Madec) remove KPP scheme
+   !!             -   !  2015-11  (J. Chanut) free surface simplification
+   !!             -   !  2015-11  (J. Chanut) free surface simplification (remove filtered free surface)
+   !!            4.0  !  2017-05  (G. Madec)  introduction of the vertical physics manager (zdfphy)
    !!----------------------------------------------------------------------
 …
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 …
       !!              -8- Outputs and diagnostics
       !!----------------------------------------------------------------------
       INTEGER ::   ji,jj,jk ! dummy loop indice
       INTEGER ::   indic    ! error indicator if < 0
       INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt)
+      INTEGER ::   ji, jj, jk   ! dummy loop indice
+      INTEGER ::   indic        ! error indicator if < 0
+      INTEGER ::   kcall        ! optional integer argument (dom_vvl_sf_nxt)
       !! ---------------------------------------------------------------------
 #if defined key_agrif
 …
                          CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+      !
       !  VERTICAL PHYSICS
+                         CALL zdf_bfr( kstp )         ! bottom friction (if quadratic)
+      !                                               ! Vertical eddy viscosity and diffusivity coefficients
+      IF( lk_zdfric  )   CALL zdf_ric ( kstp )             ! Richardson number dependent Kz
+      IF( lk_zdftke  )   CALL zdf_tke ( kstp )             ! TKE closure scheme for Kz
+      IF( lk_zdfgls  )   CALL zdf_gls ( kstp )             ! GLS closure scheme for Kz
+      IF( ln_zdfqiao )   CALL zdf_qiao( kstp )             ! Qiao vertical mixing
+      !
+      IF( lk_zdfcst  ) THEN                                ! Constant Kz (reset avt, avm[uv] to the background value)
+         avt (:,:,:) = rn_avt0 * wmask (:,:,:)
+         avmu(:,:,:) = rn_avm0 * wumask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:)
+      ENDIF
+      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
+      ENDIF
+      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
+      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
+      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
+                         CALL zdf_mxl( kstp )         ! mixed layer depth
+                                                      ! write TKE or GLS information in the restart file
+      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
+      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
+      !
+                         CALL zdf_phy( kstp )         ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
       !  LATERAL  PHYSICS
+      !
 …
       ENDIF
+                         CALL dyn_bfr       ( kstp )  ! bottom friction
+      IF( .NOT.ln_drgimp)   CALL dyn_bfr    ( kstp )  ! bottom friction
                          CALL dyn_zdf       ( kstp )  ! vertical diffusion
 …
       IF( ln_traqsr  )   CALL tra_qsr       ( kstp )  ! penetrative solar radiation qsr
       IF( ln_trabbc  )   CALL tra_bbc       ( kstp )  ! bottom heat flux
       IF( lk_trabbl  )   CALL tra_bbl       ( kstp )  ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_trabbl  )   CALL tra_bbl       ( kstp )  ! advective (and/or diffusive) bottom boundary layer scheme
       IF( ln_tradmp  )   CALL tra_dmp       ( kstp )  ! internal damping trends
       IF( ln_bdy     )   CALL bdy_tra_dmp   ( kstp )  ! bdy damping trends
 …
    END SUBROUTINE stp
+   !!======================================================================
 END MODULE step

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

-                      r7646
+                      r8215
    !!             3.7  !  2014-01  (G. Madec) LDF simplication
    !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers variables
+   USE dom_oce          ! ocean space and time domain variables
+   USE zdf_oce          ! ocean vertical physics variables
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics variables
+   USE zdfdrg  ,  ONLY : ln_drgimp   ! implicit top/bottom friction
    USE daymod           ! calendar                         (day     routine)
+   USE daymod          ! calendar                         (day     routine)
    USE sbc_oce          ! surface boundary condition: ocean
    USE sbcmod           ! surface boundary condition       (sbc     routine)
    USE sbcrnf           ! surface boundary condition: runoff variables
    USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
    USE sbcapr           ! surface boundary condition: atmospheric pressure
    USE sbctide          ! Tide initialisation
    USE sbcwave          ! Wave intialisation
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE sbcmod          ! surface boundary condition       (sbc     routine)
+   USE sbcrnf          ! surface boundary condition: runoff variables
+   USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step)
+   USE sbcapr          ! surface boundary condition: atmospheric pressure
+   USE sbctide         ! Tide initialisation
+   USE sbcwave         ! Wave intialisation
    USE traqsr           ! solar radiation penetration      (tra_qsr routine)
    USE trasbc           ! surface boundary condition       (tra_sbc routine)
    USE trabbc           ! bottom boundary condition        (tra_bbc routine)
    USE trabbl           ! bottom boundary layer            (tra_bbl routine)
    USE tradmp           ! internal damping                 (tra_dmp routine)
    USE traadv           ! advection scheme control     (tra_adv_ctl routine)
    USE traldf           ! lateral mixing                   (tra_ldf routine)
    USE trazdf           ! vertical mixing                  (tra_zdf routine)
    USE tranxt           ! time-stepping                    (tra_nxt routine)
    USE tranpc           ! non-penetrative convection       (tra_npc routine)
+   USE traqsr          ! solar radiation penetration      (tra_qsr routine)
+   USE trasbc          ! surface boundary condition       (tra_sbc routine)
+   USE trabbc          ! bottom boundary condition        (tra_bbc routine)
+   USE trabbl          ! bottom boundary layer            (tra_bbl routine)
+   USE tradmp          ! internal damping                 (tra_dmp routine)
+   USE traadv          ! advection scheme control     (tra_adv_ctl routine)
+   USE traldf          ! lateral mixing                   (tra_ldf routine)
+   USE trazdf          ! vertical mixing                  (tra_zdf routine)
+   USE tranxt          ! time-stepping                    (tra_nxt routine)
+   USE tranpc          ! non-penetrative convection       (tra_npc routine)
    USE eosbn2           ! equation of state                (eos_bn2 routine)
+   USE eosbn2          ! equation of state                (eos_bn2 routine)
    USE divhor           ! horizontal divergence            (div_hor routine)
    USE dynadv           ! advection                        (dyn_adv routine)
    USE dynbfr           ! Bottom friction terms            (dyn_bfr routine)
    USE dynvor           ! vorticity term                   (dyn_vor routine)
    USE dynhpg           ! hydrostatic pressure grad.       (dyn_hpg routine)
    USE dynldf           ! lateral momentum diffusion       (dyn_ldf routine)
    USE dynzdf           ! vertical diffusion               (dyn_zdf routine)
    USE dynspg           ! surface pressure gradient        (dyn_spg routine)
+   USE divhor          ! horizontal divergence            (div_hor routine)
+   USE dynadv          ! advection                        (dyn_adv routine)
+   USE dynbfr          ! Bottom friction terms            (dyn_bfr routine)
+   USE dynvor          ! vorticity term                   (dyn_vor routine)
+   USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine)
+   USE dynldf          ! lateral momentum diffusion       (dyn_ldf routine)
+   USE dynzdf          ! vertical diffusion               (dyn_zdf routine)
+   USE dynspg          ! surface pressure gradient        (dyn_spg routine)
    USE dynnxt           ! time-stepping                    (dyn_nxt routine)
+   USE dynnxt          ! time-stepping                    (dyn_nxt routine)
    USE stopar           ! Stochastic parametrization       (sto_par routine)
+   USE stopar          ! Stochastic parametrization       (sto_par routine)
    USE stopts
    USE bdy_oce    , ONLY: ln_bdy
    USE bdydta           ! open boundary condition data     (bdy_dta routine)
    USE bdytra           ! bdy cond. for tracers            (bdy_tra routine)
    USE bdydyn3d         ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine)
+   USE bdy_oce  , ONLY : ln_bdy
+   USE bdydta          ! open boundary condition data     (bdy_dta routine)
+   USE bdytra          ! bdy cond. for tracers            (bdy_tra routine)
+   USE bdydyn3d        ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine)
    USE sshwzv           ! vertical velocity and ssh        (ssh_nxt routine)
+   USE sshwzv          ! vertical velocity and ssh        (ssh_nxt routine)
    !                                                       (ssh_swp routine)
    !                                                       (wzv     routine)
    USE domvvl           ! variable vertical scale factors  (dom_vvl_sf_nxt routine)
+   USE domvvl          ! variable vertical scale factors  (dom_vvl_sf_nxt routine)
    !                                                       (dom_vvl_sf_swp routine)
    USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
    USE ldfdyn           ! lateral eddy viscosity coef.     (ldf_dyn routine)
    USE ldftra           ! lateral eddy diffusive coef.     (ldf_tra routine)
+   USE ldfslp          ! iso-neutral slopes               (ldf_slp routine)
+   USE ldfdyn          ! lateral eddy viscosity coef.     (ldf_dyn routine)
+   USE ldftra          ! lateral eddy diffusive coef.     (ldf_tra routine)
+   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
+   USE zdfbfr           ! bottom friction                  (zdf_bfr routine)
+   USE zdftke           ! TKE vertical mixing              (zdf_tke routine)
+   USE zdfgls           ! GLS vertical mixing              (zdf_gls routine)
+   USE zdfddm           ! double diffusion mixing          (zdf_ddm routine)
+   USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine)
+   USE zdfric           ! Richardson vertical mixing       (zdf_ric routine)
+   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine)
+   USE zdfqiao          !Qiao module wave induced mixing   (zdf_qiao routine)
+   USE zdfphy          ! vertical physics manager      (zdf_phy_init routine)
    USE step_diu        ! Time stepping for diurnal sst
 …
    USE sbc_oce         ! surface fluxes
    USE zpshde           ! partial step: hor. derivative     (zps_hde routine)
+   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
    USE diawri           ! Standard run outputs             (dia_wri routine)
    USE diaptr           ! poleward transports              (dia_ptr routine)
    USE diadct           ! sections transports              (dia_dct routine)
    USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine)
    USE diahth           ! thermocline depth                (dia_hth routine)
    USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine)
+   USE diawri          ! Standard run outputs             (dia_wri routine)
+   USE diaptr          ! poleward transports              (dia_ptr routine)
+   USE diadct          ! sections transports              (dia_dct routine)
+   USE diaar5          ! AR5 diagnosics                   (dia_ar5 routine)
+   USE diahth          ! thermocline depth                (dia_hth routine)
+   USE diahsb          ! heat, salt and volume budgets    (dia_hsb routine)
    USE diaharm
    USE diacfl
    USE flo_oce          ! floats variables
    USE floats           ! floats computation               (flo_stp routine)
+   USE flo_oce         ! floats variables
+   USE floats          ! floats computation               (flo_stp routine)
    USE crsfld           ! Standard output on coarse grid   (crs_fld routine)
+   USE crsfld          ! Standard output on coarse grid   (crs_fld routine)
    USE asminc           ! assimilation increments      (tra_asm_inc routine)
+   USE asminc          ! assimilation increments      (tra_asm_inc routine)
    !                                                   (dyn_asm_inc routine)
    USE asmbkg
    USE stpctl           ! time stepping control            (stp_ctl routine)
    USE restart          ! ocean restart                    (rst_wri routine)
    USE prtctl           ! Print control                    (prt_ctl routine)
+   USE stpctl          ! time stepping control            (stp_ctl routine)
+   USE restart         ! ocean restart                    (rst_wri routine)
+   USE prtctl          ! Print control                    (prt_ctl routine)
    USE diaobs           ! Observation operator
+   USE diaobs          ! Observation operator
    USE in_out_manager   ! I/O manager
    USE iom              !
+   USE in_out_manager  ! I/O manager
+   USE iom             !
    USE lbclnk
    USE timing           ! Timing
+   USE timing          ! Timing
 #if defined key_iomput
    USE xios
+   USE xios            ! I/O server
 #endif
 #if defined key_agrif

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

-                      r7852
+                      r8215
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
    !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
+   !!            3.7  ! 2016-09  (G. Madec)  Remove solver
+   !!            4.0  ! 2017-04  (G. Madec)  regroup global communications
    !!----------------------------------------------------------------------
 …
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! distributed memory computing
-   USE lib_fortran     ! Fortran routines library
    IMPLICIT NONE
 …
    PUBLIC stp_ctl           ! routine called by step.F90
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
       !! ** Method  : - Save the time step in numstp
       !!              - Print it each 50 time steps
+      !!              - Stop the run IF problem ( indic < 0 )
+      !!              - Stop the run IF problem encountered by setting indic=-3
+      !!                Problems checked: |ssh| maximum larger than 10 m
+      !!                                  |U|   maximum larger than 10 m/s
+      !!                                  negative sea surface salinity
       !!
       !! ** Actions :   'time.step' file containing the last ocean time-step
       !!
+      !! ** Actions :   "time.step" file = last ocean time-step
+      !!                "run.stat"  file = run statistics
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
 …
       !!
       INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ii, ij, ik             ! local integers
+      REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars
+      INTEGER, DIMENSION(3) ::   ilocu     !
+      INTEGER, DIMENSION(2) ::   ilocs     !
+      INTEGER  ::   iih, ijh               ! local integers
+      INTEGER  ::   iiu, iju, iku          !   -       -
+      INTEGER  ::   iis, ijs               !   -       -
+      REAL(wp) ::   zzz                    ! local real
+      INTEGER , DIMENSION(3) ::   ilocu
+      INTEGER , DIMENSION(2) ::   ilocs, iloch
+      REAL(wp), DIMENSION(3) ::   zmax
       !!----------------------------------------------------------------------
+      !
 …
          WRITE(numout,*) 'stp_ctl : time-stepping control'
          WRITE(numout,*) '~~~~~~~'
          ! open time.step file
+         !                                ! open time.step file
          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         !                                ! open run.stat file
+         CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       !  --------------------------
+      IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file)
+         WRITE ( numstp, '(1x, i8)' )   kt
+         REWIND( numstp )
+      ENDIF
+      !
+      !                                              !* Test maximum of velocity (zonal only)
+      !                                              !  ------------------------
+      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
+      zumax = 0.e0
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
+          END DO
+        END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
+      !                                   !==  test of extrema  ==!
+      zmax(1) = MAXVAL(  ABS( sshn(:,:) )  )                                  ! ssh max
+      zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only)
+      zmax(3) = MAXVAL( -tsn(:,:,1,jp_sal) , mask = tmask(:,:,1) == 1._wp )   ! minus surface salinity max
+      !
       IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
+      IF( lk_mpp )   CALL mpp_max_multiple( zmax(:), 3 ) ! max over the global domain
+      !
+      IF( zumax > 20.e0 ) THEN
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN
+         WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ',   zmax(1), ' |U| max: ', zmax(2),   &
+            &                                     ' SSS min: '  , - zmax(3)
+      ENDIF
+      !
+      IF ( zmax(1) > 10._wp .OR.   &                     ! too large sea surface height ( > 10 m)
+         & zmax(2) > 10._wp .OR.   &                     ! too large velocity ( > 10 m/s)
+         & zmax(3) >  0._wp ) THEN                       ! negative sea surface salinity
          IF( lk_mpp ) THEN
+            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
+            CALL mpp_maxloc( ABS(sshn)        , tmask(:,:,1), zzz, iih, ijh )
+            CALL mpp_maxloc( ABS(un)          , umask       , zzz, iiu, iju, iku )
+            CALL mpp_minloc( tsn(:,:,1,jp_sal), tmask(:,:,1), zzz, iis, ijs )
          ELSE
+            iloch = MINLOC( ABS( sshn(:,:) ) )
             ilocu = MAXLOC( ABS( un(:,:,:) ) )
+            ii = ilocu(1) + nimpp - 1
+            ij = ilocu(2) + njmpp - 1
+            ik = ilocu(3)
+            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1._wp )
+            iih = iloch(1) + nimpp - 1   ;   ijh = iloch(2) + njmpp - 1
+            iiu = ilocu(1) + nimpp - 1   ;   iju = ilocu(2) + njmpp - 1   ;   iku = ilocu(3)
+            iis = ilocs(1) + nimpp - 1   ;   ijs = ilocs(2) + njmpp - 1
          ENDIF
          IF(lwp) THEN
             WRITE(numout,cform_err)
             WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
+            WRITE(numout,*) ' stpctl: |ssh| > 10 m   or   |U| > 10 m/s   or   SSS < 0'
             WRITE(numout,*) ' ====== '
+            WRITE(numout,9400) kt, zumax, ii, ij, ik
+            WRITE(numout,9100) kt,   zmax(1), iih, ijh
+            WRITE(numout,9200) kt,   zmax(2), iiu, iju, iku
+            WRITE(numout,9300) kt, - zmax(3), iis, ijs
             WRITE(numout,*)
             WRITE(numout,*) '          output of last fields in numwso'
+            WRITE(numout,*) '          output of last computed fields in output.abort.nc file'
          ENDIF
          kindic = -3
       ENDIF
+  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
+  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5)
+  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5)
+  FORMAT (' kt=',i8,'   SSS   min: ',1pg11.4,', at  i j  : ',2i5)
+      !
+      !                                              !* Test minimum of salinity
+      !                                              !  ------------------------
+      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
+      zsmin = 100._wp
+      DO jj = 2, jpjm1
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
+      !                                            !==  run statistics  ==!   ("run.stat" file)
+      IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3)
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
+      !
+      IF( zsmin < 0.) THEN
+         IF (lk_mpp) THEN
+            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
+         ELSE
+            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9500) kt, zsmin, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
+      !
+      !
+      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
+      ! log file (ssh statistics)
+      ! --------                                   !* ssh statistics (and others...)
+      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
+         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      zsshmax = 0.e0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_max( zsshmax )                ! min over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax
+      !
+      IF( zsshmax > 10.e0 ) THEN
+         IF (lk_mpp) THEN
+            CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij)
+         ELSE
+            ilocs = MAXLOC( ABS(sshn(:,:)) )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9600) kt, zsshmax, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+  FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5)
+      !
+      zssh2 = glob_sum( sshn(:,:) * sshn(:,:) )
+      !
+      IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics
+      !
+  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16)
+  FORMAT(' it :', i8, '    |ssh|_max: ', e16.10, ' |U|_max: ',e16.10,' SSS_min: ',e16.10)
+      !
    END SUBROUTINE stp_ctl

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

-                      r7681
+                      r8215
       !                                          ! --------------
       neln(:,:) = 1                                   ! euphotic layer level
       DO jk = 1, jpk                                  ! (i.e. 1rst T-level strictly below EL bottom)
+      DO jk = 1, jpkm1                                ! (i.e. 1rst T-level strictly below EL bottom)
          DO jj = 1, jpj
            DO ji = 1, jpi
 …
    END SUBROUTINE p2z_opt
    SUBROUTINE p2z_opt_init
       !!----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

-                      r7753
+                      r8215
    !!                                  layer scheme
    !!======================================================================
-   !!==============================================================================
    !! History :  OPA  !  1996-06  (L. Mortier)  Original code
    !!            8.0  !  1997-11  (G. Madec)    Optimization
 …
    !!             -   !  2010-04  (G. Madec)  Campin & Goosse advective bbl
    !!             -   !  2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
+   !!            4.0  !  2017-04  (G. Madec)  ln_trabbl namelist variable instead of a CPP key
    !!----------------------------------------------------------------------
 #if  defined key_top &&  defined key_trabbl
+#if  defined key_top
    !!----------------------------------------------------------------------
    !!   'key_trabbl                      diffusive or/and adevective bottom boundary layer
+   !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
    !!    trc_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
+   !!    trc_bbl      : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
    !!----------------------------------------------------------------------
    USE oce_trc             ! ocean dynamics and active tracers variables
    USE trc                 ! ocean passive tracers variables
    USE trabbl              !
    USE prtctl_trc          ! Print control for debbuging
    USE trd_oce
    USE trdtra
+   USE oce_trc        ! ocean dynamics and active tracers variables
+   USE trc            ! ocean passive tracers variables
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! tracer trends
+   USE trabbl         ! bottom boundary layer
+   USE prtctl_trc     ! Print control for debbuging
    PUBLIC   trc_bbl       !  routine called by step.F90
+   PUBLIC   trc_bbl   !  routine called by trctrp.F90
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! NEMO/TOP 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
    SUBROUTINE trc_bbl( kt )
 …
          ENDIF
+         !
       END IF
+      ENDIF
       !* Advective bbl : bbl upstream advective trends added to the tracer trends
 …
          ENDIF
+         !
       END IF
+      ENDIF
       IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
 …
    END SUBROUTINE trc_bbl
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                      No bottom boundary layer scheme
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_bbl( kt )              ! Empty routine
-      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bbl
 #endif

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

r7646	r8215
121	121	DO jj = 2, jpjm1
122	122	DO ji = fs_2, fs_jpim1 ! vector opt.
123		IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
	123	IF( avs(ji,jj,jk) <= 5.e-4_wp ) THEN
124	124	tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
125	125	ENDIF

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

-                      r7646
+                      r8215
    USE oce_trc         ! ocean dynamics and active tracers variables
    USE trc             ! ocean passive tracers variables
-   USE trabbl          ! bottom boundary layer               (trc_bbl routine)
    USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
    USE trcdmp          ! internal damping                    (trc_dmp routine)
 …
+         !
                                 CALL trc_sbc    ( kt )      ! surface boundary condition
          IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme
+         IF( ln_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme
          IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends
          IF( ln_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

-                      r7753
+                      r8215
    !! Ocean Passive tracers : vertical diffusive trends
    !!=====================================================================
    !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !! History :  9.0  ! 2005-11  (G. Madec)  Original code
    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!            4.0  ! 2017-04  (G. Madec)  remove the explicit case
    !!----------------------------------------------------------------------
 #if defined key_top
 …
    !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
+   !!   trc_zdf      : update the tracer trend with the lateral diffusion
+   !!   trc_zdf_ini  : initialization, namelist read, and parameters control
+   !!   trc_zdf      : update the tracer trend with the vertical diffusion
    !!----------------------------------------------------------------------
    USE trc           ! ocean passive tracers variables
    USE oce_trc       ! ocean dynamics and active tracers
    USE trd_oce       ! trends: ocean variables
    USE trazdf_exp    ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp    ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE trazdf        ! tracer: vertical diffusion
+!!gm do we really need this ?
    USE trcldf        ! passive tracers: lateral diffusion
+!!gm
    USE trdtra        ! trends manager: tracers
    USE prtctl_trc    ! Print control
 …
    PUBLIC   trc_zdf         ! called by step.F90
-   PUBLIC   trc_zdf_ini     ! called by nemogcm.F90
-   !                                        !!** Vertical diffusion (nam_trczdf) **
-   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag
-   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping)
-   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
-      !                                ! defined from ln_zdf...  namlist logicals)
-   !! * Substitutions
-#  include "zdfddm_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.7 , NEMO Consortium (2015)
 …
       !!                  ***  ROUTINE trc_zdf  ***
       !!
+      !! ** Purpose :   compute the vertical ocean tracer physics.
+      !! ** Purpose :   compute the vertical ocean tracer physics using
+      !!              an implicit time-stepping scheme.
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
 …
       INTEGER               ::  jk, jn
       CHARACTER (len=22)    :: charout
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd   ! 4D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   ztrtrd   ! 4D workspace
       !!---------------------------------------------------------------------
+      !
       IF( nn_timing == 1 )  CALL timing_start('trc_zdf')
+      !
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme
+      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc,                trb, tra, jptra )    !   implicit scheme
+      END SELECT
+      IF( l_trdtrc )   ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      !
+      CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra )    !   implicit scheme
+      !
       IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics
          DO jn = 1, jptra
 …
             CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) )
          END DO
-         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
       ENDIF
       !                                          ! print mean trends (used for debugging)
       IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('zdf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         WRITE(charout, FMT="('zdf ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       END IF
+      !
 …
+      !
    END SUBROUTINE trc_zdf
-   SUBROUTINE trc_zdf_ini
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE trc_zdf_ini  ***
-      !!
-      !! ** Purpose :   Choose the vertical mixing scheme
-      !!
-      !! ** Method  :   Set nzdf from ln_zdfexp
-      !!      nzdf = 0   explicit (time-splitting) scheme (ln_trczdf_exp=T)
-      !!           = 1   implicit (euler backward) scheme (ln_trczdf_exp=F)
-      !!      NB: The implicit scheme is required when using :
-      !!             - rotated lateral mixing operator
-      !!             - TKE, GLS vertical mixing scheme
-      !!----------------------------------------------------------------------
-      INTEGER ::  ios                 ! Local integer output status for namelist read
-      !!
-      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
-      !!----------------------------------------------------------------------
+      !
-      REWIND( numnat_ref )             ! namtrc_zdf in reference namelist
-      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905)
-   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp )
+      !
-      REWIND( numnat_cfg )             ! namtrc_zdf in configuration namelist
-      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 )
-   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_zdf )
+      !
-      IF(lwp) THEN                     ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion  parameters'
-         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
-         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
-      ENDIF
-      !                                ! Define the vertical tracer physics scheme
-      IF( ln_trczdf_exp ) THEN   ;   nzdf = 0     ! explicit scheme
-      ELSE                       ;   nzdf = 1     ! implicit scheme
-      ENDIF
-      !                                ! Force implicit schemes
-      IF( ln_trcldf_iso              )   nzdf = 1      ! iso-neutral lateral physics
-      IF( ln_trcldf_hor .AND. ln_sco )   nzdf = 1      ! horizontal lateral physics in s-coordinate
-#if defined key_zdftke || defined key_zdfgls
-                                         nzdf = 1      ! TKE or GLS physics
-#endif
-      IF( ln_trczdf_exp .AND. nzdf == 1 )  &
-         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', &
-            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
-         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
-      ENDIF
+      !
-   END SUBROUTINE trc_zdf_ini
 #else

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

-                      r7646
+                      r8215
    USE dom_oce           ! domain definition
    USE zdfmxl  , ONLY : nmln ! number of level in the mixed layer
+   USE zdf_oce , ONLY : avt  ! vert. diffusivity coef. at w-point for temp
+# if defined key_zdfddm
+   USE zdfddm  , ONLY : avs  ! salinity vertical diffusivity coeff. at w-point
+# endif
+   USE zdf_oce , ONLY : avs  ! vert. diffusivity coef. at w-point for temp
    USE trdtrc_oce    ! definition of main arrays used for trends computations
    USE in_out_manager    ! I/O manager
 …
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   !
-   !! * Substitutions
-#  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
 …
       IF( ln_trcldf_iso ) THEN
+         !
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ik = nmld_trc(ji,jj)
+               zavt = fsavs(ji,jj,ik)
+               DO jn = 1, jptra
+         DO jn = 1, jptra
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ik = nmld_trc(ji,jj)
                   IF( ln_trdtrc(jn) )    &
                   tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  &
+                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  &
                        &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            &
                        &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1)

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

-                      r7881
+                      r8215
    !* vertical diffusion *
+   USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp
+# if defined key_zdfddm
+   USE zdfddm  , ONLY :   avs        =>   avs         !: salinity vertical diffusivity coeff. at w-point
+# endif
+   USE zdf_oce , ONLY :   avs        =>   avs         !: vert. diffusivity coef. for salinity (w-point)
    !* mixing & mixed layer depth *

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/trc.F90

-                      r7881
+                      r8215
    PUBLIC   trc_alloc   ! called by nemogcm.F90
+   !! parameters for the control of passive tracers
+   !! ---------------------------------------------
+   INTEGER, PUBLIC                                                 ::   numnat_ref = -1   !: logical unit for the reference passive tracer namelist_top_ref
+   INTEGER, PUBLIC                                                 ::   numnat_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg
+   INTEGER, PUBLIC                                                 ::   numont     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top
+   INTEGER, PUBLIC                                                 ::   numtrc_ref = -1   !: logical unit for the reference passive tracer namelist_top_ref
+   INTEGER, PUBLIC                                                 ::   numtrc_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg
+   INTEGER, PUBLIC                                                 ::   numonr     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top
+   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics
+   INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read )
+   INTEGER, PUBLIC                                                 ::   numrtw        !: logical unit for trc restart ( write )
+   !                                     !!- logical units of passive tracers
+   INTEGER, PUBLIC ::   numnat_ref = -1   !: reference passive tracer namelist_top_ref
+   INTEGER, PUBLIC ::   numnat_cfg = -1   !: reference passive tracer namelist_top_cfg
+   INTEGER, PUBLIC ::   numont     = -1   !: reference passive tracer namelist output output.namelist.top
+   INTEGER, PUBLIC ::   numtrc_ref = -1   !: reference passive tracer namelist_top_ref
+   INTEGER, PUBLIC ::   numtrc_cfg = -1   !: reference passive tracer namelist_top_cfg
+   INTEGER, PUBLIC ::   numonr     = -1   !: reference passive tracer namelist output output.namelist.top
+   INTEGER, PUBLIC ::   numstr            !: tracer statistics
+   INTEGER, PUBLIC ::   numrtr            !: trc restart (read )
+   INTEGER, PUBLIC ::   numrtw            !: trc restart ( write )
    !! passive tracers fields (before,now,after)
    !! --------------------------------------------------
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)               ::  trai           !: initial total tracer
    REAL(wp), PUBLIC                                                ::  areatot        !: total volume
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option-
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: tracer concentration for now time step
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: tracer concentration for next time step
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: tracer concentration for before time step
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc_b      !: Before sbc fluxes for tracers
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc        !: Now sbc fluxes for tracers
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  trai           !: initial total tracer
+   REAL(wp), PUBLIC                                        ::  areatot        !: total volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  cvol           !: volume correction -degrad option-
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trn            !: tracer concentration for now time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tra            !: tracer concentration for next time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trb            !: tracer concentration for before time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc_b      !: Before sbc fluxes for tracers
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc        !: Now sbc fluxes for tracers
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_i          !: prescribed tracer concentration in sea ice for SBC
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_o          !: prescribed tracer concentration in ocean for SBC
    INTEGER             , PUBLIC                                    ::  nn_ice_tr      !: handling of sea ice tracers
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  trc_i          !: prescribed tracer concentration in sea ice for SBC
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  trc_o          !: prescribed tracer concentration in ocean for SBC
+   INTEGER             , PUBLIC                            ::  nn_ice_tr      !: handling of sea ice tracers
    !! interpolated gradient
    !!--------------------------------------------------
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtru           !: hor. gradient at u-points at bottom ocean level
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrv           !: hor. gradient at v-points at bottom ocean level
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrvi          !: hor. gradient at v-points at top    ocean level
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)             ::  qsr_mean        !: daily mean qsr
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gtru           !: hor. gradient at u-points at bottom ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gtrv           !: hor. gradient at v-points at bottom ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gtrui          !: hor. gradient at u-points at top    ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gtrvi          !: hor. gradient at v-points at top    ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_mean        !: daily mean qsr
    !! passive tracers  (input and output)
    !! ------------------------------------------
    LOGICAL             , PUBLIC                                    ::  ln_rsttr       !: boolean term for restart i/o for passive tracers (namelist)
    LOGICAL             , PUBLIC                                    ::  lrst_trc       !: logical to control the trc restart write
    INTEGER             , PUBLIC                                    ::  nn_writetrc    !: time step frequency for concentration outputs (namelist)
    INTEGER             , PUBLIC                                    ::  nutwrs         !: output FILE for passive tracers restart
    INTEGER             , PUBLIC                                    ::  nutrst         !: logical unit for restart FILE for passive tracers
    INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr.
    CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input)
    CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory
    CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
    CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory
    REAL(wp)            , PUBLIC                                    ::  rdttrc         !: passive tracer time step
    REAL(wp)            , PUBLIC                                    ::  r2dttrc        !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0
    LOGICAL             , PUBLIC                                    ::  ln_top_euler   !: boolean term for euler integration
    LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files
    LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag
    LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas
    INTEGER             , PUBLIC                                    ::  nittrc000      !: first time step of passive tracers model
    LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP
+   LOGICAL             , PUBLIC ::   ln_rsttr           !: boolean term for restart i/o for passive tracers (namelist)
+   LOGICAL             , PUBLIC ::   lrst_trc           !: logical to control the trc restart write
+   INTEGER             , PUBLIC ::   nn_writetrc        !: time step frequency for concentration outputs (namelist)
+   INTEGER             , PUBLIC ::   nutwrs             !: output FILE for passive tracers restart
+   INTEGER             , PUBLIC ::   nutrst             !: logical unit for restart FILE for passive tracers
+   INTEGER             , PUBLIC ::   nn_rsttr           !: control of the time step ( 0 or 1 ) for pass. tr.
+   CHARACTER(len = 80) , PUBLIC ::   cn_trcrst_in       !: suffix of pass. tracer restart name (input)
+   CHARACTER(len = 256), PUBLIC ::   cn_trcrst_indir    !: restart input directory
+   CHARACTER(len = 80) , PUBLIC ::   cn_trcrst_out      !: suffix of pass. tracer restart name (output)
+   CHARACTER(len = 256), PUBLIC ::   cn_trcrst_outdir   !: restart output directory
+   REAL(wp)            , PUBLIC ::   rdttrc             !: passive tracer time step
+   REAL(wp)            , PUBLIC ::   r2dttrc            !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0
+   LOGICAL             , PUBLIC ::   ln_top_euler       !: boolean term for euler integration
+   LOGICAL             , PUBLIC ::   ln_trcdta          !: Read inputs data from files
+   LOGICAL             , PUBLIC ::   ln_trcdmp          !: internal damping flag
+   LOGICAL             , PUBLIC ::   ln_trcdmp_clo      !: internal damping flag on closed seas
+   INTEGER             , PUBLIC ::   nittrc000          !: first time step of passive tracers model
+   LOGICAL             , PUBLIC ::   l_trcdm2dc         !: Diurnal cycle for TOP
    !! Information for the ice module for tracers
 …
          CHARACTER(len=2) :: ctrc_o     ! choice of ocean trc cc
    END TYPE
    REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: trc_ice_ratio      ! ice-ocean tracer ratio
    REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: trc_ice_prescr     ! prescribed ice trc cc
    CHARACTER(len=2), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: cn_trc_o ! choice of ocean tracer cc
+   !
+   REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   trc_ice_ratio    !: ice-ocean tracer ratio
+   REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   trc_ice_prescr   !: prescribed ice trc cc
+   CHARACTER(len=2), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   cn_trc_o         !: choice of ocean tracer cc
    !! information for outputs
    !! --------------------------------------------------
    TYPE, PUBLIC :: PTRACER                                                            !: Passive tracer type
+   TYPE, PUBLIC :: PTRACER                                                         !: Passive tracer type
        CHARACTER(len = 20)  :: clsname  !: short name
        CHARACTER(len = 80)  :: cllname  !: long name
 …
        LOGICAL              :: llobc   !: read in a file or not
    END TYPE PTRACER
    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name
    CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name
    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit
    TYPE, PUBLIC :: DIAG                                                               !: passive trcacer ddditional diagnostic type
+   !
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm     !: tracer name
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln     !: trccer field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun     !: tracer unit
+   !
+   TYPE, PUBLIC :: DIAG                                                           !: passive trcacer ddditional diagnostic type
       CHARACTER(len = 20)  :: sname    !: short name
       CHARACTER(len = 80)  :: lname    !: long name
       CHARACTER(len = 20)  :: units    !: unit
    END TYPE DIAG
+   !
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trc3d          !: 3D diagnostics for tracers
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trc2d          !: 2D diagnostics for tracers
 …
    !! information for inputs
    !! --------------------------------------------------
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_obc     !: Use open boundary condition data
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_sbc     !: Use surface boundary condition data
    LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_cbc     !: Use coastal boundary condition data
    LOGICAL , PUBLIC                                     ::  ln_rnf_ctl     !: remove runoff dilution on tracers
    REAL(wp), PUBLIC                                     ::  rn_bc_time     !: Time scaling factor for SBC and CBC data (seconds in a day)
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::   ln_trc_ini     !: Initialisation from data input file
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::   ln_trc_obc     !: Use open boundary condition data
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::   ln_trc_sbc     !: Use surface boundary condition data
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::   ln_trc_cbc     !: Use coastal boundary condition data
+   LOGICAL , PUBLIC                                     ::   ln_rnf_ctl     !: remove runoff dilution on tracers
+   REAL(wp), PUBLIC                                     ::   rn_bc_time     !: Time scaling factor for SBC and CBC data (seconds in a day)
-   !! variables to average over physics over passive tracer sub-steps.
-   !! ----------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_tm       !: i-horizontal velocity average     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vn_tm       !: j-horizontal velocity average     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_tm      !: vertical diffusivity coeff. at  w-point   [m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !:
-# if defined key_zdfddm
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s]
-# endif
-#if defined key_trabbl
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm  !: j-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm  !: j-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm  !: j-direction slope at u-, w-points
-#endif
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm     !: average ssh for the now step [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  rnf_tm     !: river runoff
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm   !: depth in metres to the bottom of the relevant grid box
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_tm    !: mixed layer depth average [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fr_i_tm    !: average ice fraction     [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_tm     !: freshwater budget: volume flux [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fmmflx_tm  !: freshwater budget: freezing/melting [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_b_hold !: hold emp from the beginning of each sub-stepping[m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_tm     !: solar radiation average [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  wndm_tm    !: 10m wind average [m]
+   !
-   ! Temporary physical arrays for sub_stepping
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_temp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_temp,vn_temp,wn_temp     !: hold current values of avt, un, vn, wn
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp, rhop_temp     !: hold current values of avt, un, vn, wn
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_temp, qsr_temp, fr_i_temp,wndm_temp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_temp, fmmflx_temp, emp_b_temp
+   !
-#if defined key_trabbl
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values
-#endif
+   !
-# if defined key_zdfddm
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s]
-# endif
+   !
    CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/trcini.F90

-                      r7753
+                      r8215
       USE trcadv , ONLY:  trc_adv_ini
       USE trcldf , ONLY:  trc_ldf_ini
-      USE trczdf , ONLY:  trc_zdf_ini
       USE trcrad , ONLY:  trc_rad_ini
+      !
 …
                        CALL  trc_adv_ini          ! advection
                        CALL  trc_ldf_ini          ! lateral diffusion
                        CALL  trc_zdf_ini          ! vertical diffusion
+                       !                          ! vertical diffusion: always implicit time stepping scheme
                        CALL  trc_rad_ini          ! positivity of passive tracers
+      !
 …
       !!----------------------------------------------------------------------
+      !
+      ! Initialisation of tracers Initial Conditions
       IF( ln_trcdta )      CALL trc_dta_ini(jptra)
       ! Initialisation of tracers Boundary Conditions
+      IF( ln_my_trc )     CALL trc_bc_ini(jptra)
       IF( ln_rsttr ) THEN
+      IF( ln_trcdta )   CALL trc_dta_ini( jptra )      ! set initial tracers values
+      IF( ln_my_trc )   CALL trc_bc_ini ( jptra )      ! set tracers Boundary Conditions
+      IF( ln_rsttr ) THEN              ! restart from a file
+        !
         CALL trc_rst_read              ! restart from a file
+        CALL trc_rst_read
+        !
       ELSE
+        ! Initialisation of tracer from a file that may also be used for damping
+      ELSE                             ! Initialisation of tracer from a file that may also be used for damping
+!!gm BUG ?   if damping and restart, what's happening ?
         IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN
             ! update passive tracers arrays with input data read from file
 …
                   ENDIF
                ENDIF
             ENDDO
+            END DO
+            !
         ENDIF
 …
    END SUBROUTINE trc_ini_state
    SUBROUTINE top_alloc
       !!----------------------------------------------------------------------

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

-                      r7812
+                      r8215
 #if defined key_top
    !!----------------------------------------------------------------------
    !!   trc_stp      : passive tracer system time-stepping
    !!----------------------------------------------------------------------
    USE oce_trc          ! ocean dynamics and active tracers variables
+   !!   trc_stp       : passive tracer system time-stepping
+   !!----------------------------------------------------------------------
+   USE oce_trc        ! ocean dynamics and active tracers variables
    USE sbc_oce
    USE trc
    USE trctrp           ! passive tracers transport
    USE trcsms           ! passive tracers sources and sinks
+   USE trctrp         ! passive tracers transport
+   USE trcsms         ! passive tracers sources and sinks
    USE trcwri
    USE trcrst
+   USE trcsub         !
    USE trdtrc_oce
    USE trdmxl_trc
    USE prtctl_trc       ! Print control for debbuging
    USE iom
    USE in_out_manager
    USE trcsub
+   !
+   USE prtctl_trc     ! Print control for debbuging
+   USE iom            !
+   USE in_out_manager !
    IMPLICIT NONE
 …
    PUBLIC   trc_stp    ! called by step
    REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step
    REAL(wp) :: rdt_sampl
    INTEGER  :: nb_rec_per_day, ktdcy
    REAL(wp) :: rsecfst, rseclast
    LOGICAL  :: llnew
+   LOGICAL  ::   llnew                   ! ???
+   REAL(wp) ::   rdt_sampl               ! ???
+   INTEGER  ::   nb_rec_per_day, ktdcy   ! ???
+   REAL(wp) ::   rsecfst, rseclast       ! ???
+   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr   ! save qsr during TOP time-step
    !!----------------------------------------------------------------------
 …
       !!                     ***  ROUTINE trc_stp  ***
       !!
       !! ** Purpose : Time loop of opa for passive tracer
+      !! ** Purpose :   Time loop of opa for passive tracer
       !!
+      !! ** Method  :
+      !!              Compute the passive tracers trends
+      !!              Update the passive tracers
+      !! ** Method  :   Compute the passive tracers trends
+      !!                Update the passive tracers
       !!-------------------------------------------------------------------
       INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
       INTEGER               ::  jk, jn  ! dummy loop indices
       REAL(wp)              ::  ztrai
       CHARACTER (len=25)    ::  charout
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk, jn   ! dummy loop indices
+      REAL(wp)::   ztrai    ! local scalar
+      CHARACTER (len=25) ::   charout   !
       !!-------------------------------------------------------------------
+      !
 …
+      !
    END SUBROUTINE trc_stp
    SUBROUTINE trc_mean_qsr( kt )
 …
       !!              In coupled mode, the sampling is done at every coupling frequency
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      INTEGER  :: jn
+      REAL(wp) :: zkt, zrec
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 2 characters
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   jn   ! dummy loop indices
+      REAL(wp) ::   zkt, zrec     ! local scalars
+      CHARACTER(len=1) ::   cl1   ! 1 character
+      CHARACTER(len=2) ::   cl2   ! 2 characters
+      !!----------------------------------------------------------------------
+      !
       IF( kt == nittrc000 ) THEN
          IF( ln_cpl )  THEN
 …
          ENDIF
+         !
          IF( lwp ) THEN
+         IF(lwp) THEN
             WRITE(numout,*)
             WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
 …
                     CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr
                   ENDIF
               ENDDO
+              END DO
             ELSE
                DO jn = 1, nb_rec_per_day
 …
             DO jn = 1, nb_rec_per_day
                qsr_arr(:,:,jn) = qsr_mean(:,:)
             ENDDO
+            END DO
          ENDIF
+         !
 …
                CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
              ENDIF
          ENDDO
+         END DO
          CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
       ENDIF

branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

-                      r7646
+                      r8215
    !!======================================================================
    !!                       ***  MODULE trcsubstp  ***
    !!TOP :   Averages physics variables for TOP substepping.
+   !!   TOP :   Averages physics variables for TOP substepping.
    !!======================================================================
    !! History :  1.0  !  2011-10  (K. Edwards)  Original
 …
 #if defined key_top
    !!----------------------------------------------------------------------
    !!   trc_sub    : passive tracer system sub-stepping
+   !!   trc_sub       : passive tracer system sub-stepping
    !!----------------------------------------------------------------------
    USE oce_trc          ! ocean dynamics and active tracers variables
+   USE oce_trc        ! ocean dynamics and active tracers variables
    USE trc
+   USE prtctl_trc       ! Print control for debbuging
+   USE iom
+   USE in_out_manager
+   USE lbclnk
+   USE trabbl
+   USE trabbl         ! bottom boundary layer
    USE zdf_oce
    USE domvvl
+   USE divhor          ! horizontal divergence            (div_hor routine)
+   USE sbcrnf    , ONLY: h_rnf, nk_rnf    ! River runoff
+   USE bdy_oce   , ONLY: ln_bdy, bdytmask ! BDY
+   USE divhor         ! horizontal divergence
+   USE sbcrnf   , ONLY: h_rnf, nk_rnf    ! River runoff
+   USE bdy_oce  , ONLY: ln_bdy, bdytmask ! BDY
+   !
+   USE prtctl_trc     ! Print control for debbuging
+   USE in_out_manager !
+   USE iom
+   USE lbclnk
 #if defined key_agrif
    USE agrif_opa_update
 …
    IMPLICIT NONE
+   PUBLIC   trc_sub_stp      ! called by trc_stp
+   PUBLIC   trc_sub_ini      ! called by trc_ini to initialize substepping arrays.
+   PUBLIC   trc_sub_reset    ! called by trc_stp to reset physics variables
+   PUBLIC   trc_sub_ssh      ! called by trc_stp to reset physics variables
+   REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc
+   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1)
+   !                                                       !* iso-neutral slopes (if l_ldfslp=T)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean
+   PUBLIC   trc_sub_stp     ! called by trc_stp
+   PUBLIC   trc_sub_ini     ! called by trc_ini to initialize substepping arrays.
+   PUBLIC   trc_sub_reset   ! called by trc_stp to reset physics variables
+   PUBLIC   trc_sub_ssh     ! called by trc_stp to reset physics variables
+   REAL(wp) :: r1_ndttrc     ! = 1 /  nn_dttrc
+   REAL(wp) :: r1_ndttrcp1   ! = 1 / (nn_dttrc+1)
+   !! averaged and temporary saved variables  (needed when a larger passive tracer time-step is used)
+   !! ----------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::    un_tm ,   un_temp   !: i-horizontal velocity average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::    vn_tm ,   vn_temp   !: j-horizontal velocity average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::              wn_temp   !: hold current values of avt, un, vn, wn
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsn_tm ,  tsn_temp   !: t/s average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   avs_tm ,  avs_temp   !: vertical diffusivity coeff. at  w-point   [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm , rhop_temp   !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm , sshn_temp   !: average ssh for the now step [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::    rnf_tm ,    rnf_temp   !: river runoff
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm ,  h_rnf_temp   !: depth in metres to the bottom of the relevant grid box
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hmld_tm ,   hmld_temp   !: mixed layer depth average [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   fr_i_tm ,   fr_i_temp   !: average ice fraction     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::    emp_tm ,    emp_temp   !: freshwater budget: volume flux [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     :: fmmflx_tm , fmmflx_temp   !: freshwater budget: freezing/melting [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     :: emp_b_hold,  emp_b_temp   !: hold emp from the beginning of each sub-stepping[m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::    qsr_tm ,    qsr_temp   !: solar radiation average [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   wndm_tm ,   wndm_temp   !: 10m wind average [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sshb_temp, ssha_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp
+   !
+   !                                                    !!- bottom boundary layer param (ln_trabbl=T)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm, ahu_bbl_temp  ! BBL diffusive i-coef.
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm, ahv_bbl_temp  ! BBL diffusive j-coef.
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm, utr_bbl_temp  ! BBL u-advection
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm, vtr_bbl_temp  ! BBL v-advection
+   !                                                      !!- iso-neutral slopes (if l_ldfslp=T)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! NEMO/TOP 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
 …
       !!              on TOP steps, calculate averages.
       !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt        ! ocean time-step index
+      INTEGER               ::  ji,jj,jk  ! dummy loop indices
+      REAL(wp)              ::  z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp)::   z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w   ! local scalars
       !!-------------------------------------------------------------------
+      !
 …
            r1_ndttrc        = 1._wp / REAL( nn_dttrc    , wp )
            r1_ndttrcp1      = 1._wp / REAL( nn_dttrc + 1, wp )
+           !
       ENDIF
+       IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
+          !
+          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:)
+          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:)
+          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)
+          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)
+          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)
+          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)
+# if defined key_zdfddm
+          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)
+# endif
+      IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
+         !
+         un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:)
+         vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:)
+         tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)
+         tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)
+         rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)
+         avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)
          IF( l_ldfslp ) THEN
             uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:)
 …
             wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:)
          ENDIF
+# if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
              ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:)
              ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:)
           ENDIF
           IF( nn_bbl_adv == 1 ) THEN
              utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:)
              vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:)
           ENDIF
+# endif
+          !
           sshn_tm  (:,:)         = sshn_tm  (:,:)         + sshn  (:,:)
           rnf_tm   (:,:)         = rnf_tm   (:,:)         + rnf   (:,:)
           h_rnf_tm (:,:)         = h_rnf_tm (:,:)         + h_rnf (:,:)
           hmld_tm  (:,:)         = hmld_tm  (:,:)         + hmld  (:,:)
           fr_i_tm  (:,:)         = fr_i_tm  (:,:)         + fr_i  (:,:)
           emp_tm   (:,:)         = emp_tm   (:,:)         + emp   (:,:)
           fmmflx_tm(:,:)         = fmmflx_tm(:,:)         + fmmflx(:,:)
           qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:)
           wndm_tm  (:,:)         = wndm_tm  (:,:)         + wndm  (:,:)
+         IF( ln_trabbl ) THEN
+            IF( nn_bbl_ldf == 1 ) THEN
+               ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:)
+               ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:)
+            ENDIF
+            IF( nn_bbl_adv == 1 ) THEN
+               utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:)
+               vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:)
+            ENDIF
+         ENDIF
+         !
+         sshn_tm  (:,:)         = sshn_tm  (:,:)         + sshn  (:,:)
+         rnf_tm   (:,:)         = rnf_tm   (:,:)         + rnf   (:,:)
+         h_rnf_tm (:,:)         = h_rnf_tm (:,:)         + h_rnf (:,:)
+         hmld_tm  (:,:)         = hmld_tm  (:,:)         + hmld  (:,:)
+         fr_i_tm  (:,:)         = fr_i_tm  (:,:)         + fr_i  (:,:)
+         emp_tm   (:,:)         = emp_tm   (:,:)         + emp   (:,:)
+         fmmflx_tm(:,:)         = fmmflx_tm(:,:)         + fmmflx(:,:)
+         qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:)
+         wndm_tm  (:,:)         = wndm_tm  (:,:)         + wndm  (:,:)
+         !
       ELSE                           !  It is time to substep
          !   1. set temporary arrays to hold physics variables
+         !   1. set temporary arrays to hold physics/dynamical variables
          un_temp    (:,:,:)      = un    (:,:,:)
          vn_temp    (:,:,:)      = vn    (:,:,:)
 …
          tsn_temp   (:,:,:,:)    = tsn   (:,:,:,:)
          rhop_temp  (:,:,:)      = rhop  (:,:,:)
-         avt_temp   (:,:,:)      = avt   (:,:,:)
-# if defined key_zdfddm
          avs_temp   (:,:,:)      = avs   (:,:,:)
-# endif
          IF( l_ldfslp ) THEN
             uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:)
             vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:)
          ENDIF
+# if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
              ahu_bbl_temp(:,:)   = ahu_bbl(:,:)
              ahv_bbl_temp(:,:)   = ahv_bbl(:,:)
           ENDIF
           IF( nn_bbl_adv == 1 ) THEN
              utr_bbl_temp(:,:)   = utr_bbl(:,:)
              vtr_bbl_temp(:,:)   = vtr_bbl(:,:)
           ENDIF
+# endif
+         IF( ln_trabbl ) THEN
+            IF( nn_bbl_ldf == 1 ) THEN
+               ahu_bbl_temp(:,:)   = ahu_bbl(:,:)
+               ahv_bbl_temp(:,:)   = ahv_bbl(:,:)
+            ENDIF
+            IF( nn_bbl_adv == 1 ) THEN
+               utr_bbl_temp(:,:)   = utr_bbl(:,:)
+               vtr_bbl_temp(:,:)   = vtr_bbl(:,:)
+            ENDIF
+         ENDIF
          sshn_temp  (:,:)        = sshn  (:,:)
          sshb_temp  (:,:)        = sshb  (:,:)
 …
          tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)
          rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)
-         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)
-# if defined key_zdfddm
          avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)
-# endif
          IF( l_ldfslp ) THEN
             uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:)
 …
             wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:)
          ENDIF
+# if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
              ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:)
              ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:)
           ENDIF
           IF( nn_bbl_adv == 1 ) THEN
              utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:)
              vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:)
           ENDIF
+# endif
+         IF( ln_trabbl ) THEN
+            IF( nn_bbl_ldf == 1 ) THEN
+               ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:)
+               ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:)
+            ENDIF
+            IF( nn_bbl_adv == 1 ) THEN
+               utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:)
+               vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:)
+            ENDIF
+         ENDIF
          sshn_tm  (:,:)          = sshn_tm    (:,:)       + sshn  (:,:)
          rnf_tm   (:,:)          = rnf_tm     (:,:)       + rnf   (:,:)
 …
             fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrc
             fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrc
+# if defined key_trabbl
             IF( nn_bbl_ldf == 1 ) THEN
                ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrc
                ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrc
             ENDIF
             IF( nn_bbl_adv == 1 ) THEN
                utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrc
                vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrc
             ENDIF
+# endif
+            IF( ln_trabbl ) THEN
+               IF( nn_bbl_ldf == 1 ) THEN
+                  ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrc
+                  ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrc
+               ENDIF
+               IF( nn_bbl_adv == 1 ) THEN
+                  utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrc
+                  vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrc
+               ENDIF
+            ENDIF
          ELSE
             wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrcp1
 …
             fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrcp1
             fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrcp1
+# if defined key_trabbl
             IF( nn_bbl_ldf == 1 ) THEN
                ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrcp1
                ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrcp1
             ENDIF
             IF( nn_bbl_adv == 1 ) THEN
                utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrcp1
                vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrcp1
             ENDIF
+# endif
+            IF( ln_trabbl ) THEN
+               IF( nn_bbl_ldf == 1 ) THEN
+                  ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrcp1
+                  ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrcp1
+               ENDIF
+               IF( nn_bbl_adv == 1 ) THEN
+                  utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrcp1
+                  vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrcp1
+               ENDIF
+            ENDIF
          ENDIF
+         !
 …
                   tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t
                   rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t
+!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
+                  avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w
+# if defined key_zdfddm
+!!gm : BUG ==>> for avs I don't understand the division by e3w
                   avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w
-# endif
                END DO
             END DO
 …
       rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)
 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
-      avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)
-# if defined key_zdfddm
       avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)
-# endif
       IF( l_ldfslp ) THEN
          wslpi_tm(:,:,:)     = wslpi(:,:,:)
 …
       ! Physics variables that are set after initialization:
       fr_i_tm(:,:) = 0._wp
       emp_tm (:,:) = 0._wp
+      fr_i_tm  (:,:) = 0._wp
+      emp_tm   (:,:) = 0._wp
       fmmflx_tm(:,:)  = 0._wp
       qsr_tm (:,:) = 0._wp
       wndm_tm(:,:) = 0._wp
+# if defined key_trabbl
       IF( nn_bbl_ldf == 1 ) THEN
          ahu_bbl_tm(:,:) = 0._wp
          ahv_bbl_tm(:,:) = 0._wp
       ENDIF
       IF( nn_bbl_adv == 1 ) THEN
          utr_bbl_tm(:,:) = 0._wp
          vtr_bbl_tm(:,:) = 0._wp
       ENDIF
+# endif
+      qsr_tm   (:,:) = 0._wp
+      wndm_tm  (:,:) = 0._wp
+      IF( ln_trabbl ) THEN
+         IF( nn_bbl_ldf == 1 ) THEN
+            ahu_bbl_tm(:,:) = 0._wp
+            ahv_bbl_tm(:,:) = 0._wp
+         ENDIF
+         IF( nn_bbl_adv == 1 ) THEN
+            utr_bbl_tm(:,:) = 0._wp
+            vtr_bbl_tm(:,:) = 0._wp
+         ENDIF
+      ENDIF
+      !
       IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ini')
 …
       tsn   (:,:,:,:) =  tsn_temp   (:,:,:,:)
       rhop  (:,:,:)   =  rhop_temp  (:,:,:)
-      avt   (:,:,:)   =  avt_temp   (:,:,:)
-# if defined key_zdfddm
       avs   (:,:,:)   =  avs_temp   (:,:,:)
-# endif
       IF( l_ldfslp ) THEN
          wslpi (:,:,:)=  wslpi_temp (:,:,:)
 …
       qsr   (:,:)     =  qsr_temp   (:,:)
       wndm  (:,:)     =  wndm_temp  (:,:)
+# if defined key_trabbl
       IF( nn_bbl_ldf == 1 ) THEN
          ahu_bbl(:,:) = ahu_bbl_temp(:,:)
          ahv_bbl(:,:) = ahv_bbl_temp(:,:)
       ENDIF
       IF( nn_bbl_adv == 1 ) THEN
          utr_bbl(:,:) = utr_bbl_temp(:,:)
          vtr_bbl(:,:) = vtr_bbl_temp(:,:)
       ENDIF
+# endif
+      IF( ln_trabbl ) THEN
+         IF( nn_bbl_ldf == 1 ) THEN
+            ahu_bbl(:,:) = ahu_bbl_temp(:,:)
+            ahv_bbl(:,:) = ahv_bbl_temp(:,:)
+         ENDIF
+         IF( nn_bbl_adv == 1 ) THEN
+            utr_bbl(:,:) = utr_bbl_temp(:,:)
+            vtr_bbl(:,:) = vtr_bbl_temp(:,:)
+         ENDIF
+      ENDIF
+      !
       hdivn (:,:,:)   =  hdivn_temp (:,:,:)
 …
          tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)
          rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)
-         avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)
-# if defined key_zdfddm
          avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)
-# endif
       IF( l_ldfslp ) THEN
          uslp_tm (:,:,:)        = uslp (:,:,:)
 …
       qsr_tm     (:,:) = qsr   (:,:)
       wndm_tm    (:,:) = wndm  (:,:)
+# if defined key_trabbl
       IF( nn_bbl_ldf == 1 ) THEN
          ahu_bbl_tm(:,:) = ahu_bbl(:,:)
          ahv_bbl_tm(:,:) = ahv_bbl(:,:)
       ENDIF
       IF( nn_bbl_adv == 1 ) THEN
          utr_bbl_tm(:,:) = utr_bbl(:,:)
          vtr_bbl_tm(:,:) = vtr_bbl(:,:)
       ENDIF
+# endif
+      IF( ln_trabbl ) THEN
+         IF( nn_bbl_ldf == 1 ) THEN
+            ahu_bbl_tm(:,:) = ahu_bbl(:,:)
+            ahv_bbl_tm(:,:) = ahv_bbl(:,:)
+         ENDIF
+         IF( nn_bbl_adv == 1 ) THEN
+            utr_bbl_tm(:,:) = utr_bbl(:,:)
+            vtr_bbl_tm(:,:) = vtr_bbl(:,:)
+         ENDIF
+      ENDIF
+      !
+      !
 …
       !!-------------------------------------------------------------------
       USE lib_mpp, ONLY: ctl_warn
+      INTEGER ::  ierr
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE( un_temp(jpi,jpj,jpk)        ,  vn_temp(jpi,jpj,jpk)  ,   &
+         &      wn_temp(jpi,jpj,jpk)        ,  avt_temp(jpi,jpj,jpk) ,   &
+         &      rhop_temp(jpi,jpj,jpk)      ,  rhop_tm(jpi,jpj,jpk) ,   &
+         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      &
+         &      ssha_temp(jpi,jpj)          ,                           &
+#if defined key_trabbl
+         &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    &
+         &      utr_bbl_temp(jpi,jpj)       ,  vtr_bbl_temp(jpi,jpj),    &
+#endif
+         &      rnf_temp(jpi,jpj)           ,  h_rnf_temp(jpi,jpj) ,     &
+         &      tsn_temp(jpi,jpj,jpk,2)     ,  emp_b_temp(jpi,jpj),      &
+         &      emp_temp(jpi,jpj)           ,  fmmflx_temp(jpi,jpj),     &
+         &      hmld_temp(jpi,jpj)          ,  qsr_temp(jpi,jpj) ,       &
+         &      fr_i_temp(jpi,jpj)          ,  fr_i_tm(jpi,jpj) ,        &
+         &      wndm_temp(jpi,jpj)          ,  wndm_tm(jpi,jpj) ,        &
+# if defined key_zdfddm
+         &      avs_tm(jpi,jpj,jpk)         ,  avs_temp(jpi,jpj,jpk) ,   &
+# endif
+         &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  &
+         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     &
+         &      avt_tm(jpi,jpj,jpk)                                ,     &
+         &      sshn_tm(jpi,jpj)            ,  sshb_hold(jpi,jpj) ,      &
+         &      tsn_tm(jpi,jpj,jpk,2)       ,                            &
+         &      emp_tm(jpi,jpj)             ,  fmmflx_tm(jpi,jpj)  ,     &
+         &      emp_b_hold(jpi,jpj)         ,                            &
+         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         &
+#if defined key_trabbl
+         &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      &
+         &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      &
+#endif
+         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc )
+      INTEGER ::  ierr(3)
+      !!-------------------------------------------------------------------
+      !
+      ierr(:) = 0
+      !
+      ALLOCATE( un_temp(jpi,jpj,jpk)      ,  vn_temp(jpi,jpj,jpk)   ,     &
+         &      wn_temp(jpi,jpj,jpk)      ,                               &
+         &      rhop_temp(jpi,jpj,jpk)    ,  rhop_tm(jpi,jpj,jpk)   ,     &
+         &      sshn_temp(jpi,jpj)        ,  sshb_temp(jpi,jpj)     ,     &
+         &      ssha_temp(jpi,jpj)        ,                               &
+         &      rnf_temp(jpi,jpj)         ,  h_rnf_temp(jpi,jpj)    ,     &
+         &      tsn_temp(jpi,jpj,jpk,2)   ,  emp_b_temp(jpi,jpj)    ,     &
+         &      emp_temp(jpi,jpj)         ,  fmmflx_temp(jpi,jpj)   ,     &
+         &      hmld_temp(jpi,jpj)        ,  qsr_temp(jpi,jpj)      ,     &
+         &      fr_i_temp(jpi,jpj)        ,  fr_i_tm(jpi,jpj)       ,     &
+         &      wndm_temp(jpi,jpj)        ,  wndm_tm(jpi,jpj)       ,     &
+         &      avs_tm(jpi,jpj,jpk)       ,  avs_temp(jpi,jpj,jpk)  ,     &
+         &      hdivn_temp(jpi,jpj,jpk)   ,  hdivb_temp(jpi,jpj,jpk),     &
+         &      un_tm(jpi,jpj,jpk)        ,  vn_tm(jpi,jpj,jpk)     ,     &
+         &      sshn_tm(jpi,jpj)          ,  sshb_hold(jpi,jpj)     ,     &
+         &      tsn_tm(jpi,jpj,jpk,2)     ,                               &
+         &      emp_tm(jpi,jpj)           ,  fmmflx_tm(jpi,jpj)     ,     &
+         &      emp_b_hold(jpi,jpj)       ,                               &
+         &      hmld_tm(jpi,jpj)          ,  qsr_tm(jpi,jpj)        ,     &
+         &      rnf_tm(jpi,jpj)           ,  h_rnf_tm(jpi,jpj)      , STAT=ierr(1) )
+      !
+      IF( l_ldfslp ) THEN
+         ALLOCATE( uslp_temp(jpi,jpj,jpk) ,  wslpi_temp(jpi,jpj,jpk),     &
+            &      vslp_temp(jpi,jpj,jpk) ,  wslpj_temp(jpi,jpj,jpk),     &
+            &      uslp_tm  (jpi,jpj,jpk) ,  wslpi_tm  (jpi,jpj,jpk),     &
+            &      vslp_tm  (jpi,jpj,jpk) ,  wslpj_tm  (jpi,jpj,jpk), STAT=ierr(2) )
+      ENDIF
+      IF( ln_trabbl ) THEN
+         ALLOCATE( ahu_bbl_temp(jpi,jpj)  , utr_bbl_temp(jpi,jpj)   ,     &
+            &      ahv_bbl_temp(jpi,jpj)  , vtr_bbl_temp(jpi,jpj)   ,     &
+            &      ahu_bbl_tm  (jpi,jpj)  , utr_bbl_tm  (jpi,jpj)   ,     &
+            &      ahv_bbl_tm  (jpi,jpj)  , vtr_bbl_tm  (jpi,jpj)   , STAT=ierr(3) )
+      ENDIF
+      !
+      trc_sub_alloc = MAXVAL( ierr )
+      !
       IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
+      !
-      IF( l_ldfslp ) THEN
-         ALLOCATE( uslp_temp(jpi,jpj,jpk)   ,  wslpi_temp(jpi,jpj,jpk),      &
-            &      vslp_temp(jpi,jpj,jpk)   ,  wslpj_temp(jpi,jpj,jpk),      &
-            &      uslp_tm  (jpi,jpj,jpk)   ,  wslpi_tm  (jpi,jpj,jpk),      &
-            &      vslp_tm  (jpi,jpj,jpk)   ,  wslpj_tm  (jpi,jpj,jpk),  STAT=trc_sub_alloc )
-      ENDIF
+      !
-      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays')
+      !
    END FUNCTION trc_sub_alloc

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

Context Navigation

Legend:

Download in other formats: