Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/diawri.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/diawri.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/diawri.F90	(revision 13562)
@@ -0,0 +1,1007 @@
+MODULE diawri
+   !!======================================================================
+   !!                     ***  MODULE  diawri  ***
+   !! Ocean diagnostics :  write ocean output files
+   !!=====================================================================
+   !! History :  OPA  ! 1991-03  (M.-A. Foujols)  Original code
+   !!            4.0  ! 1991-11  (G. Madec)
+   !!                 ! 1992-06  (M. Imbard)  correction restart file
+   !!                 ! 1992-07  (M. Imbard)  split into diawri and rstwri
+   !!                 ! 1993-03  (M. Imbard)  suppress writibm
+   !!                 ! 1998-01  (C. Levy)  NETCDF format using ioipsl INTERFACE
+   !!                 ! 1999-02  (E. Guilyardi)  name of netCDF files + variables
+   !!            8.2  ! 2000-06  (M. Imbard)  Original code (diabort.F)
+   !!   NEMO     1.0  ! 2002-06  (A.Bozec, E. Durand)  Original code (diainit.F)
+   !!             -   ! 2002-09  (G. Madec)  F90: Free form and module
+   !!             -   ! 2002-12  (G. Madec)  merge of diabort and diainit, F90
+   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri
+   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output
+   !!                 !                     change name of output variables in dia_wri_state
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dia_wri       : create the standart output files
+   !!   dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE isf_oce
+   USE isfcpl
+   USE abl            ! abl variables in case ln_abl = .true.
+   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 dia25h         ! 25h Mean output
+   USE iom            !
+   USE ioipsl         !
+
+#if defined key_si3
+   USE ice
+   USE icewri
+#endif
+   USE lib_mpp         ! MPP library
+   USE timing          ! preformance summary
+   USE diu_bulk        ! diurnal warm layer
+   USE diu_coolskin    ! Cool skin
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_wri                 ! routines called by step.F90
+   PUBLIC   dia_wri_state
+   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
+#if ! defined key_iomput
+   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.)
+#endif
+   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
+   INTEGER ::          nb_T              , ndim_bT   ! grid_T file
+   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
+   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
+   INTEGER ::   nid_F, nz_F, nh_F, ndim_F, ndim_hF   ! grid_F file
+   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
+   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file
+   INTEGER ::   ndex(1)                              ! ???
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV, ndex_hF
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V, ndex_F
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+!!st12
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: diawri.F90 13416 2020-08-20 10:10:55Z gm $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_iomput'                                        use IOM library
+   !!----------------------------------------------------------------------
+   INTEGER FUNCTION dia_wri_alloc()
+      !
+      dia_wri_alloc = 0
+      !
+   END FUNCTION dia_wri_alloc
+
+
+   SUBROUTINE dia_wri( kt, Kmm )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri  ***
+      !!
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
+      !!      NETCDF format is used by default
+      !!
+      !! ** Method  :  use iom_put
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index
+      !!
+      INTEGER ::   ji, jj, jk       ! dummy loop indices
+      INTEGER ::   ikbot            ! local integer
+      REAL(wp)::   zztmp , zztmpx   ! local scalar
+      REAL(wp)::   zztmp2, zztmpy   !   -      -
+      REAL(wp)::   ze3              !   -      -
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('dia_wri')
+      !
+      ! Output the initial state and forcings
+      IF( ninist == 1 ) THEN
+         CALL dia_wri_state( Kmm, 'output.init' )
+         ninist = 0
+      ENDIF
+
+      ! Output of initial vertical scale factor
+      CALL iom_put("e3t_0", e3t_0(:,:,:) )
+      CALL iom_put("e3u_0", e3u_0(:,:,:) )
+      CALL iom_put("e3v_0", e3v_0(:,:,:) )
+      CALL iom_put("e3f_0", e3f_0(:,:,:) )
+      !
+!!st13
+#if ! defined key_qco
+      IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN  ! time-varying e3t
+         DO jk = 1, jpk
+            z3d(:,:,jk) =  e3t(:,:,jk,Kmm)
+         END DO
+         CALL iom_put( "e3t"     ,     z3d(:,:,:) )
+         CALL iom_put( "e3tdef"  , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
+      ENDIF
+      IF ( iom_use("e3u") ) THEN                         ! time-varying e3u
+         DO jk = 1, jpk
+            z3d(:,:,jk) =  e3u(:,:,jk,Kmm)
+         END DO
+         CALL iom_put( "e3u" , z3d(:,:,:) )
+      ENDIF
+      IF ( iom_use("e3v") ) THEN                         ! time-varying e3v
+         DO jk = 1, jpk
+            z3d(:,:,jk) =  e3v(:,:,jk,Kmm)
+         END DO
+         CALL iom_put( "e3v" , z3d(:,:,:) )
+      ENDIF
+      IF ( iom_use("e3w") ) THEN                         ! time-varying e3w
+         DO jk = 1, jpk
+            z3d(:,:,jk) =  e3w(:,:,jk,Kmm)
+         END DO
+         CALL iom_put( "e3w" , z3d(:,:,:) )
+      ENDIF
+#endif
+!!st13
+
+# if defined key_bvp
+      IF( iom_use("rpo" ) )   CALL iom_put( "rpo",  rpo (:,:,1) )
+      IF( iom_use("rpou") )   CALL iom_put( "rpou", rpou(:,:,1) )
+      IF( iom_use("rpov") )   CALL iom_put( "rpov", rpov(:,:,1) )
+      IF( iom_use("rpof") )   CALL iom_put( "rpof", rpof(:,:,1) )
+      IF( iom_use("bmpt") )   CALL iom_put( "bmpt", bmpt(:,:,1) )
+      IF( iom_use("bmpu") )   CALL iom_put( "bmpu", bmpu(:,:,1) )
+      IF( iom_use("bmpv") )   CALL iom_put( "bmpv", bmpv(:,:,1) )
+#endif
+
+# if ! defined key_bvp
+      IF( ll_wd ) THEN
+         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying)
+      ELSE
+         CALL iom_put( "ssh" , ssh(:,:,Kmm) )                          ! sea surface height
+      ENDIF
+# else
+      IF( ll_wd ) THEN
+         CALL iom_put( "ssh" , (r1_rpo(:,:,1) * ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying)
+      ELSE
+         CALL iom_put( "ssh" , r1_rpo(:,:,1) * ssh(:,:,Kmm) )                          ! sea surface height
+      ENDIF
+
+#endif
+
+      !
+      IF( iom_use("ht") )   &                  ! water column at t-point
+         CALL iom_put( "ht" , ht_0(:,:) + ssh(:,:,Kmm) )
+      !
+      IF( iom_use("hu") )   THEN                   ! water column at u-point
+         z2d(:,:) = 0._wp
+         DO_2D_10_10
+            z2d(ji,jj) = 0.5_wp * ( e3t(ji  ,jj,1,Kmm) * e1e2t(ji  ,jj)  &
+               &                  + e3t(ji+1,jj,1,Kmm) * e1e2t(ji+1,jj)  ) * r1_e1e2u(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'diawri', z2d, 'U', 1._wp )
+         CALL iom_put( "hu", z2d )
+      ENDIF
+     !
+      IF( iom_use("hv") )   THEN                  ! water column at v-point
+         z2d(:,:) = 0._wp
+         DO_2D_10_10
+            z2d(ji,jj) = 0.5_wp * (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1)   &
+              &                    + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  )   ) * r1_e1e2v(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'diawri', z2d, 'V', 1._wp )
+         CALL iom_put( "hv", z2d )
+      ENDIF
+      !
+      IF( iom_use("hf") )  THEN                    ! water column at f-point
+         z2d(:,:) = 0._wp
+         DO_2D_10_10
+            z2d(ji,jj) = 0.25_wp * (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1)    &
+              &                     + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  ) + e3t(ji+1,jj  ,1,Kmm) * e1e2t(ji+1,jj  )  ) * r1_e1e2f(ji,jj)
+         END_2D
+         z2d(:,:) = z2d(:,:) * ssfmask(:,:)
+         CALL lbc_lnk( 'diawri', z2d, 'F', 1._wp )
+         CALL iom_put( "hf", z2d )
+      ENDIF
+!!an
+
+      IF( iom_use("wetdep") )   &                  ! wet depth
+         CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) )
+
+      IF ( iom_use("taubot") ) THEN                ! bottom stress
+         zztmp = rho0 * 0.25
+         z2d(:,:) = 0._wp
+         DO_2D_00_00
+            zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   &
+               &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2
+            z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)
+            !
+         END_2D
+         CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
+         CALL iom_put( "taubot", z2d )
+      ENDIF
+      !
+      CALL iom_put(  "ssu" , uu(:,:,1,Kmm) )            ! surface i-current
+      CALL iom_put(  "ssv" , vv(:,:,1,Kmm) )            ! surface j-current
+      CALL iom_put(  "woce", ww )                       ! vertical velocity
+      !
+
+      IF ( iom_use("sKE") ) THEN                        ! surface kinetic energy at T point
+         z2d(:,:) = 0._wp
+         DO_2D_00_00
+            z2d(ji,jj) =    0.25_wp * ( uu(ji  ,jj,1,Kmm) * uu(ji  ,jj,1,Kmm) * e1e2u(ji  ,jj) * e3u(ji  ,jj,1,Kmm)  &
+               &                      + uu(ji-1,jj,1,Kmm) * uu(ji-1,jj,1,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,1,Kmm)  &
+               &                      + vv(ji,jj  ,1,Kmm) * vv(ji,jj  ,1,Kmm) * e1e2v(ji,jj  ) * e3v(ji,jj  ,1,Kmm)  &
+               &                      + vv(ji,jj-1,1,Kmm) * vv(ji,jj-1,1,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,1,Kmm)  )  &
+               &                    * r1_e1e2t(ji,jj) / e3t(ji,jj,1,Kmm) * tmask(ji,jj,1)
+         END_2D
+         !
+         CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
+         IF ( iom_use("sKE" ) )  CALL iom_put( "sKE" , z2d )
+
+      ENDIF
+
+!!an sKEf
+      IF ( iom_use("sKEf") ) THEN                        ! surface kinetic energy at F point
+         z2d(:,:) = 0._wp                                ! CAUTION : only valid in SWE, not with bathymetry
+         DO_2D_00_00
+            z2d(ji,jj) =    0.25_wp * ( uu(ji,jj  ,1,Kmm) * uu(ji,jj  ,1,Kmm) * e1e2u(ji,jj  ) * e3u(ji,jj  ,1,Kmm)  &
+               &                      + uu(ji,jj+1,1,Kmm) * uu(ji,jj+1,1,Kmm) * e1e2u(ji,jj+1) * e3u(ji,jj+1,1,Kmm)  &
+               &                      + vv(ji  ,jj,1,Kmm) * vv(ji,jj  ,1,Kmm) * e1e2v(ji  ,jj) * e3v(ji  ,jj,1,Kmm)  &
+               &                      + vv(ji+1,jj,1,Kmm) * vv(ji+1,jj,1,Kmm) * e1e2v(ji+1,jj) * e3v(ji+1,jj,1,Kmm)  )  &
+               &                    * r1_e1e2f(ji,jj) / e3f(ji,jj,1) * ssfmask(ji,jj)
+         END_2D
+         !
+         CALL lbc_lnk( 'diawri', z2d, 'F', 1. )
+         CALL iom_put( "sKEf", z2d )
+      ENDIF
+!!an
+      !
+      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence
+      !
+      ! Output of vorticity terms
+      IF ( iom_use("relvor")    .OR. iom_use("plavor")    .OR.   &
+         & iom_use("relpotvor") .OR. iom_use("abspotvor") .OR.   &
+         & iom_use("Ens")                                        ) THEN
+         !
+         z2d(:,:) = 0._wp
+         ze3 = 0._wp
+         DO_2D_10_10
+            z2d(ji,jj) = (   e2v(ji+1,jj  ) * vv(ji+1,jj  ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm)    &
+            &              - e1u(ji  ,jj+1) * uu(ji  ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm)  ) * r1_e1e2f(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'diawri', z2d, 'F', 1. )
+         CALL iom_put( "relvor", z2d )                  ! relative vorticity ( zeta )
+         !
+         CALL iom_put( "plavor", ff_f )                 ! planetary vorticity ( f )
+         !
+         DO_2D_10_10
+            ze3 = (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1)    &
+              &    + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  ) + e3t(ji+1,jj  ,1,Kmm) * e1e2t(ji+1,jj  )  ) * r1_e1e2f(ji,jj)
+            IF( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3
+            ELSE                      ;   ze3 = 0._wp
+            ENDIF
+            z2d(ji,jj) = ze3 * z2d(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'diawri', z2d, 'F', 1. )
+         CALL iom_put( "relpotvor", z2d )                  ! relative potential vorticity (zeta/h)
+         !
+         DO_2D_10_10
+            ze3 = (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1)    &
+              &    + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  ) + e3t(ji+1,jj  ,1,Kmm) * e1e2t(ji+1,jj  )  ) * r1_e1e2f(ji,jj)
+            IF( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3
+            ELSE                      ;   ze3 = 0._wp
+            ENDIF
+            z2d(ji,jj) = ze3 * ff_f(ji,jj) + z2d(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'diawri', z2d, 'F', 1. )
+         CALL iom_put( "abspotvor", z2d )                  ! absolute potential vorticity ( q )
+         !
+         DO_2D_10_10
+            z2d(ji,jj) = 0.5_wp * z2d(ji,jj)  * z2d(ji,jj)
+         END_2D
+         CALL lbc_lnk( 'diawri', z2d, 'F', 1. )
+         CALL iom_put( "Ens", z2d )                        ! potential enstrophy ( 1/2*q2 )
+         !
+      ENDIF
+
+      !
+      IF( ln_timing )   CALL timing_stop('dia_wri')
+      !
+   END SUBROUTINE dia_wri
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                  use IOIPSL  library
+   !!----------------------------------------------------------------------
+
+   INTEGER FUNCTION dia_wri_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) :: ierr
+      !!----------------------------------------------------------------------
+      IF( nn_write == -1 ) THEN
+         dia_wri_alloc = 0
+      ELSE
+         ierr = 0
+         ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
+            &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
+            &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
+         !
+         dia_wri_alloc = MAXVAL(ierr)
+         CALL mpp_sum( 'diawri', dia_wri_alloc )
+         !
+      ENDIF
+      !
+   END FUNCTION dia_wri_alloc
+
+   INTEGER FUNCTION dia_wri_alloc_abl()
+      !!----------------------------------------------------------------------
+	  ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl)
+      CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
+      !
+   END FUNCTION dia_wri_alloc_abl
+
+
+   SUBROUTINE dia_wri( kt, Kmm )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri  ***
+      !!
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
+      !!      NETCDF format is used by default
+      !!
+      !! ** Method  :   At the beginning of the first time step (nit000),
+      !!      define all the NETCDF files and fields
+      !!      At each time step call histdef to compute the mean if ncessary
+      !!      Each nn_write time step, output the instantaneous or mean fields
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index
+      !
+      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
+      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
+      INTEGER  ::   inum = 11                                ! temporary logical unit
+      INTEGER  ::   ji, jj, jk                               ! dummy loop indices
+      INTEGER  ::   ierr                                     ! error code return from allocation
+      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      INTEGER  ::   ipka                                     ! ABL
+      INTEGER  ::   jn, ierror                               ! local integers
+      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
+      !
+      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
+!!st14
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t, zgdept       ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==!
+         CALL dia_wri_state( Kmm, 'output.init' )
+         ninist = 0
+      ENDIF
+      !
+      IF( nn_write == -1 )   RETURN   ! we will never do any output
+      !
+      IF( ln_timing )   CALL timing_start('dia_wri')
+      !
+      ! 0. Initialisation
+      ! -----------------
+
+      ll_print = .FALSE.                  ! local variable for debugging
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes)
+#if defined key_diainstant
+      zsto = nn_write * rn_Dt
+      clop = "inst("//TRIM(clop)//")"
+#else
+      zsto=rn_Dt
+      clop = "ave("//TRIM(clop)//")"
+#endif
+      zout = nn_write * rn_Dt
+      zmax = ( nitend - nit000 + 1 ) * rn_Dt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+      IF(ln_abl) ipka = jpkam1
+
+      ! define time axis
+      it = kt
+      itmod = kt - nit000 + 1
+!!st15
+      ! store e3t for subsitute
+      DO jk = 1, jpk
+         ze3t  (:,:,jk) =  e3t  (:,:,jk,Kmm)
+         zgdept(:,:,jk) =  gdept(:,:,jk,Kmm)
+      END DO
+!!st15
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         ! Define the NETCDF files (one per grid)
+
+         ! Compute julian date from starting date of the run
+         CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
+         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
+            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
+         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
+                                 ' limit storage in depth = ', ipk
+
+         ! WRITE root name in date.file for use by postpro
+         IF(lwp) THEN
+            CALL dia_nam( clhstnam, nn_write,' ' )
+            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+            WRITE(inum,*) clhstnam
+            CLOSE(inum)
+         ENDIF
+
+         ! Define the T grid FILE ( nid_T )
+
+         CALL dia_nam( clhstnam, nn_write, 'grid_T' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_1d, nz_T, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume
+         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
+         !
+         IF( ln_icebergs ) THEN
+            !
+            !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after
+            !! that routine is called from nemogcm, so do it here immediately before its needed
+            ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror )
+            CALL mpp_sum( 'diawri', ierror )
+            IF( ierror /= 0 ) THEN
+               CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array')
+               RETURN
+            ENDIF
+            !
+            !! iceberg vertical coordinate is class number
+            CALL histvert( nid_T, "class", "Iceberg class",      &  ! Vertical grid: class
+               &           "number", nclasses, class_num, nb_T )
+            !
+            !! each class just needs the surface index pattern
+            ndim_bT = 3
+            DO jn = 1,nclasses
+               ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj)
+            ENDDO
+            !
+         ENDIF
+
+         ! Define the U grid FILE ( nid_U )
+
+         CALL dia_nam( clhstnam, nn_write, 'grid_U' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_1d, nz_U, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume
+         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
+
+         ! Define the V grid FILE ( nid_V )
+
+         CALL dia_nam( clhstnam, nn_write, 'grid_V' )                   ! filename
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
+            &          "m", ipk, gdept_1d, nz_V, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume
+         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
+
+         ! Define the W grid FILE ( nid_W )
+
+         CALL dia_nam( clhstnam, nn_write, 'grid_W' )                   ! filename
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rn_Dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
+            &          "m", ipk, gdepw_1d, nz_W, "down" )
+
+         IF( ln_abl ) THEN
+         ! Define the ABL grid FILE ( nid_A )
+            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' )
+            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+               &          nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
+            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept
+               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" )
+            !                                                            ! Index of ocean points
+			ALLOCATE( zw3d_abl(jpi,jpj,ipka) )
+			zw3d_abl(:,:,:) = 1._wp
+			CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume
+            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface
+			DEALLOCATE(zw3d_abl)
+         ENDIF
+
+         ! Declare all the output fields as NETCDF variables
+
+         !                                                                                      !!! nid_T : 3D
+         CALL histdef( nid_T, "votemper", "Temperature"                        , "C"      ,   &  ! tn
+            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn
+            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         IF(  .NOT.ln_linssh  ) THEN
+            CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! ze3t(:,:,:,Kmm)
+            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! ze3t(:,:,:,Kmm)
+            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! ze3t(:,:,:,Kmm)
+            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_T : 2D
+         CALL histdef( nid_T, "sosstsst", "Sea Surface temperature"            , "C"      ,   &  ! sst
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosaline", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sorunoff", "River runoffs"                      , "Kg/m2/s",   &  ! runoffs
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         IF(  ln_linssh  ) THEN
+            CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * ts(:,:,1,jp_tem,Kmm)
+            &                                                                  , "KgC/m2/s",  &  ! sosst_cd
+            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * ts(:,:,1,jp_sal,Kmm)
+            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd
+            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ENDIF
+         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "somixhgt", "Turbocline Depth"                   , "m"      ,   &  ! hmld
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01"             , "m"      ,   &  ! hmlp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         !
+         IF( ln_abl ) THEN
+            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
+#if defined key_si3
+            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
+#endif
+            CALL histend( nid_A, snc4chunks=snc4set )
+         ENDIF
+         !
+         IF( ln_icebergs ) THEN
+            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "calving_heat"        , "calving heat flux"                        , "XXXX"   , &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "berg_floating_melt"  , "Melt rate of icebergs + bits"             , "kg/m2/s", &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "berg_stored_ice"     , "Accumulated ice mass by class"            , "kg"     , &
+               &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
+            IF( ln_bergdia ) THEN
+               CALL histdef( nid_T, "berg_melt"           , "Melt rate of icebergs"                    , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_buoy_melt"      , "Buoyancy component of iceberg melt rate"  , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_eros_melt"      , "Erosion component of iceberg melt rate"   , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_conv_melt"      , "Convective component of iceberg melt rate", "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_virtual_area"   , "Virtual coverage by icebergs"             , "m2"     , &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "bits_src"           , "Mass source of bergy bits"                , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "bits_melt"          , "Melt rate of bergy bits"                  , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "bits_mass"          , "Bergy bit density field"                  , "kg/m2"  , &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_mass"           , "Iceberg density field"                    , "kg/m2"  , &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_real_calving"   , "Calving into iceberg class"               , "kg/s"   , &
+                  &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
+            ENDIF
+         ENDIF
+
+         IF( ln_ssr ) THEN
+            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ENDIF
+
+         clmx ="l_max(only(x))"    ! max index on a period
+!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX
+!            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
+#if defined key_diahth
+         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "J/m2"   ,   & ! htc3
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+
+         CALL histend( nid_T, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_U : 3D
+         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! uu(:,:,:,Kmm)
+            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+         IF( ln_wave .AND. ln_sdw) THEN
+            CALL histdef( nid_U, "sdzocrtx", "Stokes Drift Zonal Current"         , "m/s"    ,   &  ! usd
+               &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_U : 2D
+         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
+            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+
+         CALL histend( nid_U, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_V : 3D
+         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vv(:,:,:,Kmm)
+            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+         IF( ln_wave .AND. ln_sdw) THEN
+            CALL histdef( nid_V, "sdmecrty", "Stokes Drift Meridional Current"    , "m/s"    ,   &  ! vsd
+               &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_V : 2D
+         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
+            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+
+         CALL histend( nid_V, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_W : 3D
+         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! ww
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         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"  ,   &  ! avm
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+
+         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 )
+         ENDIF
+
+         IF( ln_wave .AND. ln_sdw) THEN
+            CALL histdef( nid_W, "sdvecrtz", "Stokes Drift Vertical Current"   , "m/s"    ,   &  ! wsd
+               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_W : 2D
+         CALL histend( nid_W, snc4chunks=snc4set )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
+         IF(ll_print) CALL FLUSH(numout )
+
+      ENDIF
+
+      ! 2. Start writing data
+      ! ---------------------
+
+      ! ndex(1) est utilise ssi l'avant dernier argument est different de
+      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
+      ! donne le nombre d'elements, et ndex la liste des indices a sortir
+
+      IF( lwp .AND. MOD( itmod, nn_write ) == 0 ) THEN
+         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+!!st16
+      IF( .NOT.ln_linssh ) THEN
+         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T  )   ! heat content
+         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T  )   ! salt content
+         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content
+         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content
+!!st16
+      ELSE
+         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T  )   ! temperature
+         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) , ndim_T , ndex_T  )   ! salinity
+         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) , ndim_hT, ndex_hT )   ! sea surface temperature
+         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity
+      ENDIF
+      IF( .NOT.ln_linssh ) THEN
+!!st17 if ! defined key_qco
+         zw3d(:,:,:) = ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
+         CALL histwrite( nid_T, "vovvle3t", it, ze3t (:,:,:)     , ndim_T , ndex_T  )   ! level thickness
+         CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T  )   ! t-point depth
+!!st17
+         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation
+      ENDIF
+      CALL histwrite( nid_T, "sossheig", it, ssh(:,:,Kmm)          , ndim_hT, ndex_hT )   ! sea surface height
+      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
+      CALL histwrite( nid_T, "sorunoff", it, rnf           , ndim_hT, ndex_hT )   ! river runoffs
+      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux
+                                                                                  ! (includes virtual salt flux beneath ice
+                                                                                  ! in linear free surface case)
+      IF( ln_linssh ) THEN
+         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_tem,Kmm)
+         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst
+         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_sal,Kmm)
+         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss
+      ENDIF
+      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
+      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
+      CALL histwrite( nid_T, "somixhgt", it, hmld          , ndim_hT, ndex_hT )   ! turbocline depth
+      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth
+      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction
+      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed
+      !
+      IF( ln_abl ) THEN
+         ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
+         IF( ln_mskland )   THEN
+            DO jk=1,jpka
+               zw3d_abl(:,:,jk) = tmask(:,:,1)
+            END DO
+         ELSE
+            zw3d_abl(:,:,:) = 1._wp
+         ENDIF
+         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh
+         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl
+         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl
+         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl
+         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl
+         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl
+         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl
+         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl
+#if defined key_si3
+         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i
+#endif
+         DEALLOCATE(zw3d_abl)
+      ENDIF
+      !
+      IF( ln_icebergs ) THEN
+         !
+         CALL histwrite( nid_T, "calving"             , it, berg_grid%calving      , ndim_hT, ndex_hT )
+         CALL histwrite( nid_T, "calving_heat"        , it, berg_grid%calving_hflx , ndim_hT, ndex_hT )
+         CALL histwrite( nid_T, "berg_floating_melt"  , it, berg_grid%floating_melt, ndim_hT, ndex_hT )
+         !
+         CALL histwrite( nid_T, "berg_stored_ice"     , it, berg_grid%stored_ice   , ndim_bT, ndex_bT )
+         !
+         IF( ln_bergdia ) THEN
+            CALL histwrite( nid_T, "berg_melt"           , it, berg_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_buoy_melt"      , it, buoy_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_eros_melt"      , it, eros_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_conv_melt"      , it, conv_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_virtual_area"   , it, virtual_area     , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "bits_src"            , it, bits_src         , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "bits_melt"           , it, bits_melt        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "bits_mass"           , it, bits_mass        , ndim_hT, ndex_hT   )
+            CALL histwrite( nid_T, "berg_mass"           , it, berg_mass        , ndim_hT, ndex_hT   )
+            !
+            CALL histwrite( nid_T, "berg_real_calving"   , it, real_calving     , ndim_bT, ndex_bT   )
+         ENDIF
+      ENDIF
+
+      IF( ln_ssr ) THEN
+         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+         zw2d(:,:) = erp(:,:) * ts(:,:,1,jp_sal,Kmm) * tmask(:,:,1)
+         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
+      ENDIF
+!      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
+!      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
+
+#if defined key_diahth
+      CALL histwrite( nid_T, "sothedep", it, hth           , ndim_hT, ndex_hT )   ! depth of the thermocline
+      CALL histwrite( nid_T, "so20chgt", it, hd20          , ndim_hT, ndex_hT )   ! depth of the 20 isotherm
+      CALL histwrite( nid_T, "so28chgt", it, hd28          , ndim_hT, ndex_hT )   ! depth of the 28 isotherm
+      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content
+#endif
+
+      CALL histwrite( nid_U, "vozocrtx", it, uu(:,:,:,Kmm)            , ndim_U , ndex_U )    ! i-current
+      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
+
+      CALL histwrite( nid_V, "vomecrty", it, vv(:,:,:,Kmm)            , ndim_V , ndex_V  )   ! j-current
+      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
+
+      IF( ln_zad_Aimp ) THEN
+         CALL histwrite( nid_W, "vovecrtz", it, ww + wi     , ndim_T, ndex_T )    ! vert. current
+      ELSE
+         CALL histwrite( nid_W, "vovecrtz", it, ww          , ndim_T, ndex_T )    ! vert. current
+      ENDIF
+      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T 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
+      ENDIF
+
+      ! 3. Close all files
+      ! ---------------------------------------
+      IF( kt == nitend ) THEN
+         CALL histclo( nid_T )
+         CALL histclo( nid_U )
+         CALL histclo( nid_V )
+         CALL histclo( nid_W )
+         IF(ln_abl) CALL histclo( nid_A )
+      ENDIF
+      !
+      IF( ln_timing )   CALL timing_stop('dia_wri')
+      !
+   END SUBROUTINE dia_wri
+#endif
+
+   SUBROUTINE dia_wri_state( Kmm, cdfile_name )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_wri_state  ***
+      !!
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
+      !!      the instantaneous ocean state and forcing fields.
+      !!        Used to find errors in the initial state or save the last
+      !!      ocean state in case of abnormal end of a simulation
+      !!
+      !! ** Method  :   NetCDF files using ioipsl
+      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
+      !!      File 'output.abort.nc' is created in case of abnormal job end
+      !!----------------------------------------------------------------------
+      INTEGER           , INTENT( in ) ::   Kmm              ! time level index
+      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
+      !!
+      INTEGER :: inum, jk
+!!st18  TBR
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept      ! 3D workspace !!st patch to use substitution
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
+      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
+!!st19 TBR
+      DO jk = 1, jpk
+         ze3t(:,:,jk) =  e3t(:,:,jk,Kmm)
+         zgdept(:,:,jk) =  gdept(:,:,jk,Kmm)
+      END DO
+!!st19
+#if defined key_si3
+     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
+#else
+     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
+#endif
+
+      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature
+      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity
+      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm)              )    ! sea surface height
+      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity
+      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity
+      IF( ln_zad_Aimp ) THEN
+         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi        )    ! now k-velocity
+      ELSE
+         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity
+      ENDIF
+      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity
+      CALL iom_rstput( 0, 0, inum, 'ht'     , ht(:,:)            )    ! now water column height
+
+      IF ( ln_isf ) THEN
+         IF (ln_isfcav_mlt) THEN
+            CALL iom_rstput( 0, 0, inum, 'fwfisf_cav', fwfisf_cav          )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 )
+         END IF
+         IF (ln_isfpar_mlt) THEN
+            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) )    ! now k-velocity
+            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 )
+         END IF
+      END IF
+      !
+      IF( ALLOCATED(ahtu) ) THEN
+         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point
+         CALL iom_rstput( 0, 0, inum,  'ahtv', ahtv              )    ! aht at v-point
+      ENDIF
+      IF( ALLOCATED(ahmt) ) THEN
+         CALL iom_rstput( 0, 0, inum,  'ahmt', ahmt              )    ! ahmt at u-point
+         CALL iom_rstput( 0, 0, inum,  'ahmf', ahmf              )    ! ahmf at v-point
+      ENDIF
+      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget
+      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux
+      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux
+      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction
+      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress
+      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress
+!!st20 TBR
+      IF(  .NOT.ln_linssh  ) THEN
+         CALL iom_rstput( 0, 0, inum, 'vovvldep', zgdept        )    !  T-cell depth
+         CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t          )    !  T-cell thickness
+      END IF
+      IF( ln_wave .AND. ln_sdw ) THEN
+         CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd            )    ! now StokesDrift i-velocity
+         CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd            )    ! now StokesDrift j-velocity
+         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity
+      ENDIF
+      IF ( ln_abl ) THEN
+         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind
+         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind
+         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature
+         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity
+      ENDIF
+
+#if defined key_si3
+      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
+         CALL ice_wri_state( inum )
+      ENDIF
+#endif
+      !
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE dia_wri_state
+
+   !!======================================================================
+END MODULE diawri
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/divhor.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/divhor.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/divhor.F90	(revision 13562)
@@ -0,0 +1,120 @@
+MODULE divhor
+   !!==============================================================================
+   !!                       ***  MODULE  divhor  ***
+   !! Ocean diagnostic variable : now horizontal divergence
+   !!==============================================================================
+   !! History :  1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
+   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
+   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
+   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
+   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
+   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
+   !!            3.7  ! 2014-01  (G. Madec) suppression of velocity curl from in-core memory
+   !!             -   ! 2014-12  (G. Madec) suppression of cross land advection option
+   !!             -   ! 2015-10  (G. Madec) add velocity and rnf flag in argument of div_hor
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   div_hor    : Compute the horizontal divergence field
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY : ln_rnf      ! river runoff
+   USE sbcrnf , ONLY : sbc_rnf_div ! river runoff
+   USE isf_oce, ONLY : ln_isf      ! ice shelf
+   USE isfhdiv, ONLY : isf_hdiv    ! ice shelf
+#if defined key_asminc
+   USE asminc          ! Assimilation increment
+#endif
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   div_hor    ! routine called by step.F90 and istate.F90
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: divhor.F90 12377 2020-02-12 14:39:06Z acc $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE div_hor( kt, Kbb, Kmm )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_hor  ***
+      !!
+      !! ** Purpose :   compute the horizontal divergence at now time-step
+      !!
+      !! ** Method  :   the now divergence is computed as :
+      !!         hdiv = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla)
+      !!
+      !! ** Action  : - update hdiv, the now horizontal divergence
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt        ! ocean time-step index
+      INTEGER, INTENT(in) ::   Kbb, Kmm  ! ocean time level indices
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zraur, zdep   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp
+
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('div_hor')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+         hdiv(:,:,:) = 0._wp    ! initialize hdiv for the halos at the first time step
+      ENDIF
+      !
+      DO_3D_00_00( 1, jpkm1 )
+         hdiv(ji,jj,jk) = (   e2u(ji  ,jj) *  e3u(ji  ,jj  ,jk, Kmm ) * uu(ji  ,jj,jk,Kmm)      &
+            &               - e2u(ji-1,jj) *  e3u(ji-1,jj  ,jk, Kmm ) * uu(ji-1,jj,jk,Kmm)      &
+            &               + e1v(ji,jj  ) *  e3v(ji  ,jj  ,jk, Kmm ) * vv(ji,jj  ,jk,Kmm)      &
+            &               - e1v(ji,jj-1) *  e3v(ji  ,jj-1,jk, Kmm ) * vv(ji,jj-1,jk,Kmm)  )   &
+            &            * r1_e1e2t(ji,jj) /  e3t(ji  ,jj  ,jk, Kmm)
+      END_3D
+!      DO_3D_00_00( 1, jpkm1 )
+!         hdiv(ji,jj,jk) = (   e2u(ji  ,jj) * e3u(ji  ,jj  ,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      &
+!            &               - e2u(ji-1,jj) * e3u(ji-1,jj  ,jk,Kmm) * uu(ji-1,jj,jk,Kmm)      &
+!            &               + e1v(ji,jj  ) * e3v(ji  ,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)      &
+!            &               - e1v(ji,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)  )   &
+!            &            * r1_e1e2t(ji,jj) / e3t(ji  ,jj  ,jk,Kmm)
+!      END_3D
+      !
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+         IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west
+         IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east
+         IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south
+         IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north
+      ENDIF
+#endif
+      !
+      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field)
+      !
+#if defined key_asminc
+      IF( ln_sshinc .AND. ln_asmiau )   CALL ssh_asm_div( kt, Kbb, Kmm, hdiv )   !==  SSH assimilation  ==!   (update hdiv field)
+      !
+#endif
+      !
+      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field)
+      !
+      CALL lbc_lnk( 'divhor', hdiv, 'T', 1. )   !   (no sign change)
+      !
+      IF( ln_timing )   CALL timing_stop('div_hor')
+      !
+   END SUBROUTINE div_hor
+
+   !!======================================================================
+END MODULE divhor
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/domain.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/domain.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/domain.F90	(revision 13562)
@@ -0,0 +1,762 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!                 !  1992-01  (M. Imbard) insert time step initialization
+   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
+   !!                 !  1997-02  (G. Madec) creation of domwri.F
+   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_init      : initialize the space and time domain
+   !!   dom_glo       : initialize global domain <--> local domain indices
+   !!   dom_nam       : read and contral domain namelists
+   !!   dom_ctl       : control print for the ocean domain
+   !!   domain_cfg    : read the global domain size in domain configuration file
+   !!   cfg_write     : create the domain configuration file
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce        ! domain: ocean
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE trc_oce        ! shared ocean & passive tracers variab
+   USE phycst         ! physical constants
+   USE domhgr         ! domain: set the horizontal mesh
+   USE domzgr         ! domain: set the vertical mesh
+   USE dommsk         ! domain: set the mask system
+   USE domwri         ! domain: write the meshmask file
+!!st5
+#if ! defined key_qco
+   USE domvvl         ! variable volume
+#else
+   USE domqco          ! variable volume
+#endif
+!!st5
+   USE c1d            ! 1D configuration
+   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
+   USE wet_dry, ONLY : ll_wd
+   USE closea , ONLY : dom_clo ! closed seas
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+!!an45
+!   USE usrdef_nam, ONLY : ln_45machin
+   !
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init     ! called by nemogcm.F90
+   PUBLIC   domain_cfg   ! called by nemogcm.F90
+#  include "do_loop_substitute.h90"
+   !!-------------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: domain.F90 13416 2020-08-20 10:10:55Z gm $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!-------------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_init( Kbb, Kmm, Kaa, cdstr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!
+      !! ** Purpose :   Domain initialization. Call the routines that are
+      !!              required to create the arrays which define the space
+      !!              and time domain of the ocean model.
+      !!
+      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
+      !!              - dom_hgr: compute or read the horizontal grid-point position
+      !!                         and scale factors, and the coriolis factor
+      !!              - dom_zgr: define the vertical coordinate and the bathymetry
+      !!              - dom_wri: create the meshmask file (ln_meshmask=T)
+      !!              - 1D configuration, move Coriolis, u and v at T-point
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices
+      CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
+      !
+!!st6
+      INTEGER ::   ji, jj, jk, jt   ! dummy loop indices
+!!st6
+      INTEGER ::   iconf = 0    ! local integers
+      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))"
+      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
+      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
+      REAL(wp)::   zcoeff                                     ! local real
+
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN         ! Ocean domain Parameters (control print)
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+         !
+         WRITE(numout,*)     '   Domain info'
+         WRITE(numout,*)     '      dimension of model:'
+         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
+         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
+         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
+         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
+         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
+         WRITE(numout,*)     '      mpp local domain info (mpp):'
+         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
+         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
+         WRITE(numout,*)     '              jpnij   : ', jpnij
+         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
+         SELECT CASE ( jperio )
+         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
+         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
+         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. cyclic north-south)'
+         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
+         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
+         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
+         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
+         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
+         CASE DEFAULT
+            CALL ctl_stop( 'dom_init:   jperio is out of range' )
+         END SELECT
+         WRITE(numout,*)     '      Ocean model configuration used:'
+         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
+      ENDIF
+      lwxios = .FALSE.
+      ln_xios_read = .FALSE.
+      !
+      !           !==  Reference coordinate system  ==!
+      !
+      CALL dom_glo                     ! global domain versus local domain
+      CALL dom_nam                     ! read namelist ( namrun, namdom )
+      !
+      IF( lwxios ) THEN
+!define names for restart write and set core output (restart.F90)
+         CALL iom_set_rst_vars(rst_wfields)
+         CALL iom_set_rstw_core(cdstr)
+      ENDIF
+!reset namelist for SAS
+      IF(cdstr == 'SAS') THEN
+         IF(lrxios) THEN
+               IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
+               lrxios = .FALSE.
+         ENDIF
+      ENDIF
+      !
+      CALL dom_hgr                      ! Horizontal mesh
+
+      IF( ln_closea ) CALL dom_clo      ! Read in masks to define closed seas and lakes
+
+      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry (return top and bottom ocean t-level indices)
+
+      CALL dom_msk( ik_top, ik_bot )    ! Masks
+                                        ! Penalisation fields
+      !
+# if defined key_bvp
+      !  Multiply the scale factors by the porosity field
+      !  done on the e30 as a trick.
+      ! -------------------------------------------------
+      ! La valeur des e3 dans la terre (premier point terre touchant la mer)
+      ! n'impacte pas la dynamique même si e3 = e30 + ssh
+      ! les e3 à a côte sont multpilié par des vitesses toujours masquées
+      e3t_0(:,:,:) = rpo (:,:,:) * e3t_0(:,:,:)
+      e3u_0(:,:,:) = rpou(:,:,:) * e3u_0(:,:,:)
+      e3v_0(:,:,:) = rpov(:,:,:) * e3v_0(:,:,:)
+      !
+      ! jpfillcopy mode copy the communication layer (kinf od periodic over the basin)
+      CALL lbc_lnk_multi( 'domain', e3t_0,  'T', 1._wp, e3u_0  , 'U', 1._wp ,      &
+              &                     e3v_0,  'V', 1._wp, kfillmode=jpfillcopy )
+      !
+      ! DONT USE IT IS FALSE
+      !
+      ! WRITE(numout,*) 'e1e2f not penalised'
+      !!! e3f n'est pas pénalisé mais les e1e2f !
+      ! e1e2f   (:,:) =    rpof(:,:,1) *    e1e2f(:,:)
+      ! r1_e1e2f(:,:) = r1_rpof(:,:,1) * r1_e1e2f(:,:)
+      ! WRITE(numout,*) 'e1e2f penalised !'
+      ! CALL lbc_lnk_multi( 'domain', e1e2f,  'F', 1._wp, r1_e1e2f  , 'F', 1._wp,    &
+      !         &                                         kfillmode=jpfillcopy )
+#endif
+      !
+      ht_0(:,:) = 0._wp  ! Reference ocean thickness
+      hu_0(:,:) = 0._wp
+      hv_0(:,:) = 0._wp
+      hf_0(:,:) = 0._wp
+      DO jk = 1, jpkm1
+         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
+         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
+         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
+         hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * ssfmask(:,:)     ! CAUTION : only valid in SWE, not with bathymetry
+      END DO
+      !
+      !                                 ! Inverse of reference ocean thickness
+      r1_ht_0(:,:) =  ssmask(:,:) / ( ht_0(:,:) + 1._wp -  ssmask(:,:) )
+      r1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )
+      r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
+      r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) )
+      !
+!!st7 : make it easier to use key_qco condition (gm stuff)
+#if defined key_qco
+      !           !==  initialisation of time varying coordinate  ==!   Quasi-Euerian coordinate case
+      !
+      IF( .NOT.l_offline )   CALL dom_qco_init( Kbb, Kmm, Kaa )
+      !
+      IF( ln_linssh )        CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible')
+      !
+#else
+      !           !==  time varying part of coordinate system  ==!
+      !
+      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
+         !
+         DO jt = 1, jpt                         ! depth of t- and w-grid-points
+            gdept(:,:,:,jt) = gdept_0(:,:,:)
+            gdepw(:,:,:,jt) = gdepw_0(:,:,:)
+         END DO
+            gde3w(:,:,:)    = gde3w_0(:,:,:)    ! = gdept as the sum of e3t
+         !
+         DO jt = 1, jpt                         ! vertical scale factors
+            e3t(:,:,:,jt) =  e3t_0(:,:,:)
+            e3u(:,:,:,jt) =  e3u_0(:,:,:)
+            e3v(:,:,:,jt) =  e3v_0(:,:,:)
+            e3w(:,:,:,jt) =  e3w_0(:,:,:)
+            e3uw(:,:,:,jt) = e3uw_0(:,:,:)
+            e3vw(:,:,:,jt) = e3vw_0(:,:,:)
+         END DO
+            e3f(:,:,:)    =  e3f_0(:,:,:)
+         !
+         DO jt = 1, jpt                         ! water column thickness and its inverse
+            hu(:,:,jt)    =    hu_0(:,:)
+            hv(:,:,jt)    =    hv_0(:,:)
+            r1_hu(:,:,jt) = r1_hu_0(:,:)
+            r1_hv(:,:,jt) = r1_hv_0(:,:)
+         END DO
+            ht(:,:) =    ht_0(:,:)
+         !
+      ELSE                       != time varying : initialize before/now/after variables
+         !
+         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa )
+         !
+      ENDIF
+#endif
+!!st7
+      !
+      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
+      !
+      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file
+
+      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
+      !
+      IF( ln_write_cfg   )   CALL cfg_write     ! create the configuration file
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*)
+      ENDIF
+      !
+   END SUBROUTINE dom_init
+
+
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization of global domain <--> local domain indices
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
+      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
+      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop argument
+      !!----------------------------------------------------------------------
+      !
+      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
+        mig(ji) = ji + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + njmpp - 1
+      END DO
+      !                              ! global domain indices ==> local domain indices
+      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
+      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
+      DO ji = 1, jpiglo
+        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
+        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
+      END DO
+      DO jj = 1, jpjglo
+        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
+        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
+      END DO
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
+         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*)
+         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
+         IF( nn_print >= 1 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
+            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  i-index domain'
+            WRITE(numout,*) '             starting index (mi0)'
+            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
+            WRITE(numout,*) '             ending index (mi1)'
+            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
+            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  j-index domain'
+            WRITE(numout,*) '             starting index (mj0)'
+            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
+            WRITE(numout,*) '             ending index (mj1)'
+            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
+         ENDIF
+      ENDIF
+ 25   FORMAT( 100(10x,19i4,/) )
+      !
+   END SUBROUTINE dom_glo
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      !!
+      INTEGER  ::   ios   ! Local integer
+      !
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler  , &
+         &             ln_cfmeta, ln_xios_read, nn_wxios
+      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      !
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist' )
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
+         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
+         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
+         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
+         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
+         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
+         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
+         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler
+         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
+         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
+         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
+         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
+         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
+         IF( ln_rst_list ) THEN
+            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
+         ELSE
+            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
+         ENDIF
+#if ! defined key_iomput
+         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
+#endif
+         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
+         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
+            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
+         ELSE
+            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
+            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
+         ENDIF
+      ENDIF
+
+      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      l_1st_euler = ln_1st_euler
+      IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
+         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '
+         l_1st_euler = .true.
+      ENDIF
+      !                             ! control of output frequency
+      IF( .NOT. ln_rst_list ) THEN     ! we use nn_stock
+         IF( nn_stock == -1 )   CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
+         IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
+            WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
+            CALL ctl_warn( ctmp1 )
+            nn_stock = nitend
+         ENDIF
+      ENDIF
+#if ! defined key_iomput
+      IF( nn_write == -1 )   CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
+      IF ( nn_write == 0 ) THEN
+         WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nn_write = nitend
+      ENDIF
+#endif
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+      IF(lwp) WRITE(numout,*)
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 )
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#if defined key_agrif
+      ENDIF
+#endif
+
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' )
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' )
+      IF(lwm) WRITE( numond, namdom )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
+         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
+         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
+         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt
+         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
+         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
+      ENDIF
+      !
+      !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
+      rDt  = 2._wp * rn_Dt
+      r1_Dt = 1._wp / rDt
+
+      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+         lrxios = ln_xios_read.AND.ln_rstart
+!set output file type for XIOS based on NEMO namelist
+         IF (nn_wxios > 0) lwxios = .TRUE.
+         nxioso = nn_wxios
+      ENDIF
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
+      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
+908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
+      IF(lwm) WRITE( numond, namnc4 )
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2
+      INTEGER, DIMENSION(2) ::   iloc   !
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+      !
+      IF(lk_mpp) THEN
+         CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
+         CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
+         CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
+         CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         !
+         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         imi1(1) = iloc(1) + nimpp - 1
+         imi1(2) = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         imi2(1) = iloc(1) + nimpp - 1
+         imi2(2) = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         ima1(1) = iloc(1) + nimpp - 1
+         ima1(2) = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         ima2(1) = iloc(1) + nimpp - 1
+         ima2(2) = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+
+   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!
+      !! ** Purpose :   read the domain size in domain configuration file
+      !!
+      !! ** Method  :   read the cn_domcfg NetCDF file
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
+      !
+      INTEGER ::   inum   ! local integer
+      REAL(wp) ::   zorca_res                     ! local scalars
+      REAL(wp) ::   zperio                        !   -      -
+      INTEGER, DIMENSION(4) ::   idvar, idimsz    ! size   of dimensions
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) '           '
+         WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
+         WRITE(numout,*) '~~~~~~~~~~ '
+      ENDIF
+      !
+      CALL iom_open( cn_domcfg, inum )
+      !
+      !                                   !- ORCA family specificity
+      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
+         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
+         !
+         cd_cfg = 'ORCA'
+         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) '   .'
+            WRITE(numout,*) '   ==>>>   ORCA configuration '
+            WRITE(numout,*) '   .'
+         ENDIF
+         !
+      ELSE                                !- cd_cfg & k_cfg are not used
+         cd_cfg = 'UNKNOWN'
+         kk_cfg = -9999999
+                                          !- or they may be present as global attributes
+                                          !- (netcdf only)
+         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
+         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
+         IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
+         IF( kk_cfg == -999     ) kk_cfg = -9999999
+         !
+      ENDIF
+       !
+      idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz )   ! use e3t_0, that must exist, to get jp(ijk)glo
+      kpi = idimsz(1)
+      kpj = idimsz(2)
+      kpk = idimsz(3)
+      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
+      CALL iom_close( inum )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg
+         WRITE(numout,*) '      jpiglo = ', kpi
+         WRITE(numout,*) '      jpjglo = ', kpj
+         WRITE(numout,*) '      jpkglo = ', kpk
+         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio
+      ENDIF
+      !
+   END SUBROUTINE domain_cfg
+
+
+   SUBROUTINE cfg_write
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE cfg_write  ***
+      !!
+      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
+      !!              contains all the ocean domain informations required to
+      !!              define an ocean configuration.
+      !!
+      !! ** Method  :   Write in a file all the arrays required to set up an
+      !!              ocean configuration.
+      !!
+      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
+      !!                       mesh, Coriolis parameter, and vertical scale factors
+      !!                    NB: also contain ORCA family information
+      !!----------------------------------------------------------------------
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      INTEGER           ::   inum     ! local units
+      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      !                       ! ============================= !
+      !                       !  create 'domcfg_out.nc' file  !
+      !                       ! ============================= !
+      !
+      clnam = cn_domcfg_out  ! filename (configuration information)
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
+
+      !
+      !                             !==  ORCA family specificities  ==!
+      IF( cn_cfg == "ORCA" ) THEN
+         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )
+      ENDIF
+      !
+      !                             !==  global domain size  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
+      !
+      !                             !==  domain characteristics  ==!
+      !
+      !                                   ! lateral boundary of the global domain
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !
+      !                                   ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !
+      !                                   ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+      !
+      !                             !==  horizontal mesh  !
+      !
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
+      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
+      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
+      !
+      !                             !==  vertical mesh  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
+      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
+      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
+      !
+      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
+      !
+      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
+      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
+      !
+      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
+         CALL dom_stiff( z2d )
+         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
+      ENDIF
+      !
+      IF( ll_wd ) THEN              ! wetting and drying domain
+         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
+      ENDIF
+      !
+      ! Add some global attributes ( netcdf only )
+      CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
+      CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
+      !
+      !                                ! ============================
+      !                                !        close the files
+      !                                ! ============================
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE cfg_write
+
+   !!======================================================================
+END MODULE domain
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dommsk.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dommsk.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dommsk.F90	(revision 13562)
@@ -0,0 +1,391 @@
+MODULE dommsk
+   !!======================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea mask
+   !!======================================================================
+   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
+   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
+   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
+   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask
+   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
+   !!            8.1  ! 1997-07  (G. Madec)  modification of kbat and fmask
+   !!             -   ! 1998-05  (G. Roullet)  free surface
+   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
+   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
+   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk       : compute land/ocean mask
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE usrdef_fmask   ! user defined fmask
+   USE bdy_oce        ! open boundary
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! IOM library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! Massively Parallel Processing library
+   USE usrdef_nam , ONLY : nn_cnp    ! use penalisation parameter
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk    ! routine called by inidom.F90
+
+   !                            !!* Namelist namlbc : lateral boundary condition *
+   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
+   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition
+   !                                            with analytical eqs.
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dommsk.F90 13416 2020-08-20 10:10:55Z gm $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_msk( k_top, k_bot )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) points.
+      !!
+      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top
+      !!      and ko_bot, the indices of the fist and last ocean t-levels which
+      !!      are either defined in usrdef_zgr or read in zgr_read.
+      !!                The velocity masks (umask, vmask, wmask, wumask, wvmask)
+      !!      are deduced from a product of the two neighboring tmask.
+      !!                The vorticity mask (fmask) is deduced from tmask taking
+      !!      into account the choice of lateral boundary condition (rn_shlat) :
+      !!         rn_shlat = 0, free slip  (no shear along the coast)
+      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
+      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
+      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
+      !!
+      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
+      !!                rows/lines due to cyclic or North Fold boundaries as well
+      !!                as MPP halos.
+      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines
+      !!                due to cyclic or North Fold boundaries as well as MPP halos.
+      !!
+      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask
+      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.)
+      !!               fmask   : land/ocean mask at f-point (=0., or =1., or
+      !!                         =rn_shlat along lateral boundaries)
+      !!               tmask_i : interior ocean mask
+      !!               tmask_h : halo mask
+      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! first and last ocean level
+      !
+      INTEGER  ::   ji, jj, jk, jl     ! dummy loop indices
+      INTEGER  ::   znummask       ! local integers
+      INTEGER  ::   iif, iil       ! local integers
+      INTEGER  ::   ijf, ijl       !   -       -
+      INTEGER  ::   iktop, ikbot   !   -       -
+      INTEGER  ::   ios, inum
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zwf   ! 2D workspace
+      !!
+      NAMELIST/namlbc/ rn_shlat, ln_vorlat
+      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
+         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+         &             cn_ice, nn_ice_dta,                                     &
+         &             ln_vol, nn_volctl, nn_rimwidth
+      !!---------------------------------------------------------------------
+      !
+      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist' )
+      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' )
+      IF(lwm) WRITE ( numond, namlbc )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dommsk : ocean mask '
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) '   Namelist namlbc'
+         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
+         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat
+      ENDIF
+      !
+      IF(lwp) WRITE(numout,*)
+      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
+      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
+      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
+      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
+      ELSE
+         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
+      ENDIF
+
+      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot)
+      ! ----------------------------
+      !
+      tmask(:,:,:) = 0._wp
+      DO_2D_11_11
+         iktop = k_top(ji,jj)
+         ikbot = k_bot(ji,jj)
+         IF( iktop /= 0 ) THEN       ! water in the column
+            tmask(ji,jj,iktop:ikbot  ) = 1._wp
+         ENDIF
+      END_2D
+      !
+      !
+      ! the following call is mandatory
+      ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...)
+      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions
+
+     ! Mask corrections for bdy (read in mppini2)
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' )
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' )
+      ! ------------------------
+      IF ( ln_bdy .AND. ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
+         CALL iom_close( inum )
+         DO_3D_11_11( 1, jpkm1 )
+            tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
+         END_3D
+      ENDIF
+      !
+      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
+      ! ----------------------------------------
+      ! NB: at this point, fmask is designed for free slip lateral boundary condition
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector loop
+               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
+               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
+            END DO
+            DO ji = 1, jpim1      ! NO vector opt.
+               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
+                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions
+
+      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
+      !-----------------------------------------
+      wmask (:,:,1) = tmask(:,:,1)     ! surface
+      wumask(:,:,1) = umask(:,:,1)
+      wvmask(:,:,1) = vmask(:,:,1)
+      DO jk = 2, jpk                   ! interior values
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)
+         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
+      END DO
+
+
+      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
+      ! ----------------------------------------------
+      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
+      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
+      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
+!!an
+      ! ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 )
+      DO_2D_10_10
+         ssfmask(ji,jj) = MAX(  tmask(ji,jj+1,1), tmask(ji+1,jj+1,1),  &
+            &                   tmask(ji,jj  ,1), tmask(ji+1,jj  ,1)   )
+      END_2D
+      CALL lbc_lnk( 'dommsk', ssfmask, 'F', 1._wp )
+
+!!an
+
+# if defined key_bvp
+      ! smoothing 2D
+      ! DO jl = 1, nn_cnp
+      !   DO jk = 1,jpkm1
+      !     DO_2D_00_00
+      !            rpou(ji,jj,jk) = 0.2_wp * ( rpou(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
+      !               &                                       + rpo (ji+1,jj  ,jk) + rpof(ji  ,jj-1,jk)   )
+      !            rpov(ji,jj,jk) = 0.2_wp * ( rpov(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
+      !               &                                       + rpo (ji  ,jj+1,jk) + rpof(ji-1,jj  ,jk)   )
+      !        END_2D
+      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpou,  'U', 1._wp, rpov  , 'V', 1._wp, kfillmode=jpfillcopy )
+      !     !
+      !     DO_2D_00_00
+      !            rpo (ji,jj,jk) = 0.2_wp * ( rpo (ji,jj,jk) + rpou(ji-1,jj  ,jk) + rpou(ji  ,jj  ,jk)   &
+      !               &                                       + rpov(ji  ,jj-1,jk) + rpov(ji  ,jj  ,jk)   )
+      !            rpof(ji,jj,jk) = 0.2_wp * ( rpof(ji,jj,jk) + rpou(ji  ,jj+1,jk) + rpou(ji  ,jj  ,jk)   &
+      !               &                                       + rpov(ji  ,jj  ,jk) + rpov(ji+1,jj  ,jk)   )
+      !        END_2D
+      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpo ,  'T', 1._wp, rpof,  'F', 1._wp, kfillmode=jpfillcopy )
+      !   END DO
+      ! END DO
+      !
+      DO jl = 1, nn_cnp
+            DO jk = 1,jpkm1
+              DO_2D_00_00
+                IF ( glamt(ji,jj) > -100000._wp .AND. glamt(ji,jj) < 100000._wp ) THEN
+                     rpou(ji,jj,jk) = 0.2_wp * ( rpou(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
+                        &                                       + rpo (ji+1,jj  ,jk) + rpof(ji  ,jj-1,jk)   )
+                     rpov(ji,jj,jk) = 0.2_wp * ( rpov(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
+                        &                                       + rpo (ji  ,jj+1,jk) + rpof(ji-1,jj  ,jk)   )
+                ENDIF
+              END_2D
+              CALL lbc_lnk_multi( 'usrdef_zgr', rpou,  'U', 1._wp, rpov  , 'V', 1._wp, kfillmode=jpfillcopy )
+              !
+              DO_2D_00_00
+                 IF ( glamt(ji,jj) > -100000._wp .AND. glamt(ji,jj) < 100000._wp ) THEN
+                     rpo (ji,jj,jk) = 0.2_wp * ( rpo (ji,jj,jk) + rpou(ji-1,jj  ,jk) + rpou(ji  ,jj  ,jk)   &
+                        &                                       + rpov(ji  ,jj-1,jk) + rpov(ji  ,jj  ,jk)   )
+                     rpof(ji,jj,jk) = 0.2_wp * ( rpof(ji,jj,jk) + rpou(ji  ,jj+1,jk) + rpou(ji  ,jj  ,jk)   &
+                        &                                       + rpov(ji  ,jj  ,jk) + rpov(ji+1,jj  ,jk)   )
+                 ENDIF
+              END_2D
+              CALL lbc_lnk_multi( 'usrdef_zgr', rpo ,  'T', 1._wp, rpof,  'F', 1._wp, kfillmode=jpfillcopy )
+            END DO
+      END DO
+      !
+      ! masked mean, only unmasked cells are used in the mean
+      ! Ca marche pas
+      ! DO jl = 1, nn_cnp
+      !   DO jk = 1,jpkm1
+      !     DO_2D_00_00
+      !            znummask =   1._wp / (1._wp + umask(ji,jj,jk) * ( tmask (ji  ,jj  ,jk) + ssfmask(ji  ,jj  )       &
+      !               &                                           + tmask (ji+1,jj  ,jk) + ssfmask(ji  ,jj-1)   )   )
+      !            rpou(ji,jj,jk) =  znummask * ( rpou(ji  ,jj  ,jk)                           &
+      !               &                         + rpo (ji  ,jj  ,jk) *   tmask(ji  ,jj  ,jk) * umask(ji,jj,jk)   &
+      !               &                         + rpo (ji+1,jj  ,jk) *   tmask(ji+1,jj  ,jk) * umask(ji,jj,jk)   &
+      !               &                         + rpof(ji  ,jj  ,jk) * ssfmask(ji  ,jj     ) * umask(ji,jj,jk)   &
+      !               &                         + rpof(ji  ,jj-1,jk) * ssfmask(ji  ,jj-1   ) * umask(ji,jj,jk)   )
+      !             !
+      !             znummask = 1._wp / ( 1._wp + vmask(ji,jj,jk) * ( tmask (ji  ,jj  ,jk) + ssfmask(ji  ,jj)   &
+      !                &                                           + tmask (ji  ,jj+1,jk) + ssfmask(ji-1,jj)   )   )
+      !             rpov(ji,jj,jk) =  znummask * ( rpov(ji  ,jj  ,jk)    &
+      !                &                         + rpo (ji  ,jj  ,jk) *   tmask(ji  ,jj  ,jk) * vmask(ji,jj,jk)  &
+      !                &                         + rpo (ji  ,jj+1,jk) *   tmask(ji  ,jj+1,jk) * vmask(ji,jj,jk)  &
+      !                &                         + rpof(ji  ,jj  ,jk) * ssfmask(ji  ,jj     ) * vmask(ji,jj,jk)  &
+      !                &                         + rpof(ji-1,jj  ,jk) * ssfmask(ji-1,jj     ) * vmask(ji,jj,jk)  )
+      !             !
+      !        END_2D
+      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpou,  'U', 1._wp, rpov  , 'V', 1._wp, kfillmode=jpfillcopy )
+      !     !
+      !     DO_2D_00_00
+      !     znummask = 1._wp / ( 1._wp + tmask(ji,jj,jk) * ( umask (ji-1,jj  ,jk) + umask(ji  ,jj  ,jk)   &
+      !        &                       + vmask (ji  ,jj-1,jk) + vmask(ji  ,jj  ,jk)   ) )
+      !     rpo(ji,jj,jk) =  znummask * ( rpo (ji  ,jj  ,jk)    &
+      !        &                        + rpou(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * tmask(ji,jj,jk)  &
+      !        &                        + rpou(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * tmask(ji,jj,jk)  &
+      !        &                        + rpov(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * tmask(ji,jj,jk)  &
+      !        &                        + rpov(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * tmask(ji,jj,jk)  )
+      !      !
+      !      znummask = 1._wp / ( 1._wp  + ssfmask(ji,jj) * ( umask (ji  ,jj+1,jk) + umask(ji  ,jj  ,jk)   &
+      !         &                                 + vmask (ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   ) )
+      !      rpof(ji,jj,jk) =  znummask * ( rpof(ji  ,jj  ,jk)    &
+      !         &                         + rpou(ji  ,jj  ,jk) *   umask(ji  ,jj  ,jk) * ssfmask(ji,jj)  &
+      !         &                         + rpou(ji  ,jj+1,jk) *   umask(ji  ,jj+1,jk) * ssfmask(ji,jj)  &
+      !         &                         + rpov(ji  ,jj  ,jk) *   vmask(ji  ,jj  ,jk) * ssfmask(ji,jj)  &
+      !         &                         + rpov(ji+1,jj  ,jk) *   vmask(ji+1,jj  ,jk) * ssfmask(ji,jj)  )
+      !        END_2D
+      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpo ,  'T', 1._wp, rpof,  'F', 1._wp, kfillmode=jpfillcopy )
+      !   END DO
+      ! END DO
+      !
+# endif
+
+      ! Interior domain mask  (used for global sum)
+      ! --------------------
+      !
+      iif = nn_hls   ;   iil = nlci - nn_hls + 1
+      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
+      !
+      !                          ! halo mask : 0 on the halo and 1 elsewhere
+      tmask_h(:,:) = 1._wp
+      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
+      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
+      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
+      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
+      !
+      !                          ! north fold mask
+      tpol(1:jpiglo) = 1._wp
+      fpol(1:jpiglo) = 1._wp
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
+         tpol(jpiglo/2+1:jpiglo) = 0._wp
+         fpol(     1    :jpiglo) = 0._wp
+         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
+            DO ji = iif+1, iil-1
+               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF
+      !
+      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
+         tpol(     1    :jpiglo) = 0._wp
+         fpol(jpiglo/2+1:jpiglo) = 0._wp
+      ENDIF
+      !
+      !                          ! interior mask : 2D ocean mask x halo mask
+      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
+
+
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------
+      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
+         !
+         ALLOCATE( zwf(jpi,jpj) )
+         !
+         DO jk = 1, jpk
+            zwf(:,:) = fmask(:,:,jk)
+            DO_2D_00_00
+               IF( fmask(ji,jj,jk) == 0._wp ) THEN
+                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
+                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
+               ENDIF
+            END_2D
+            DO jj = 2, jpjm1
+               IF( fmask(1,jj,jk) == 0._wp ) THEN
+                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+               ENDIF
+               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
+                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+               ENDIF
+            END DO
+            DO ji = 2, jpim1
+               IF( fmask(ji,1,jk) == 0._wp ) THEN
+                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+               ENDIF
+               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
+                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+               ENDIF
+            END DO
+#if defined key_agrif
+            IF( .NOT. AGRIF_Root() ) THEN
+               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east
+               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west
+               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north
+               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south
+            ENDIF
+#endif
+         END DO
+         !
+         DEALLOCATE( zwf )
+         !
+         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+         !
+         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
+         !
+      ENDIF
+
+      ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
+      ! --------------------------------
+      !
+      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
+      !
+   END SUBROUTINE dom_msk
+
+   !!======================================================================
+END MODULE dommsk
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dynldf_lap_blp.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dynldf_lap_blp.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dynldf_lap_blp.F90	(revision 13562)
@@ -0,0 +1,250 @@
+MODULE dynldf_lap_blp
+   !!======================================================================
+   !!                   ***  MODULE  dynldf_lap_blp  ***
+   !! Ocean dynamics:  lateral viscosity trend (laplacian and bilaplacian)
+   !!======================================================================
+   !! History : 3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian
+   !!           4.0  ! 2020-04  (A. Nasser, G. Madec)  Add symmetric mixing tensor
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_lap   : update the momentum trend with the lateral viscosity using an iso-level   laplacian operator
+   !!   dyn_ldf_blp   : update the momentum trend with the lateral viscosity using an iso-level bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE ldfslp         ! iso-neutral slopes
+   USE zdf_oce        ! ocean vertical physics
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   !
+   USE usrdef_nam , ONLY : nn_dynldf_lap_typ    ! use laplacian parameter
+   !
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_ldf_lap  ! called by dynldf.F90
+   PUBLIC dyn_ldf_blp  ! called by dynldf.F90
+!!anSYM
+   INTEGER, PUBLIC, PARAMETER ::   np_dynldf_lap_rot  = 1         ! div-rot   laplacian
+   INTEGER, PUBLIC, PARAMETER ::   np_dynldf_lap_sym  = 2         ! symmetric laplacian (Griffies&Hallberg 2000)
+   INTEGER, PUBLIC, PARAMETER ::   np_dynldf_lap_symN = 3         ! symmetric laplacian (cartesian)
+
+   !INTEGER, PUBLIC, PARAMETER ::   nn_dynldf_lap_typ = 1         ! choose type of laplacian (ideally from namelist)
+!!anSYM
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+!!st21
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dynldf_lap_blp.F90 13416 2020-08-20 10:10:55Z gm $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_lap  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal momentum diffusive
+      !!      trend and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The Laplacian operator apply on horizontal velocity is
+      !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) )
+      !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) )
+      !!
+      !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv.
+      !!
+      !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices
+      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2]
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zsign        ! local scalars
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcur, zdiv
+      REAL(wp), DIMENSION(jpi,jpj) ::   zten, zshe   ! tension (diagonal) and shearing (anti-diagonal) terms
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::   ze1e2f, zr1_e1e2f     ! not penalised scale factors
+      !!----------------------------------------------------------------------
+      !
+!!anSYM TO BE ADDED : reading of laplacian operator (ln_dynldf_lap_typ -> to be written nn_) shall be added in dyn_ldf_init
+!!                 as the writing
+!!                 and an integer as np_dynldf_lap for instance taken as argument by dyn_ldf_lap call in dyn_ldf
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '                  nn_dynldf_lap_typ = ', nn_dynldf_lap_typ
+         SELECT CASE( nn_dynldf_lap_typ )             ! print the choice of operator
+         CASE( np_dynldf_lap_rot )   ;   WRITE(numout,*) '   ==>>>   div-rot   laplacian'
+         CASE( np_dynldf_lap_sym )   ;   WRITE(numout,*) '   ==>>>   symmetric laplacian (covariant form)'
+         CASE( np_dynldf_lap_symN)   ;   WRITE(numout,*) '   ==>>>   symmetric laplacian (cartesian form)'
+         END SELECT
+      ENDIF
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign
+      ELSE                    ;   zsign = -1._wp      !  (eddy viscosity coef. >0)
+      ENDIF
+      !
+      SELECT CASE( nn_dynldf_lap_typ )
+         !
+         CASE ( np_dynldf_lap_rot )       !==  Vorticity-Divergence form  ==!
+           !
+           zr1_e1e2f(:,:) = r1_e1e2f(:,:)
+# if defined key_bvp
+           zr1_e1e2f(:,:) = r1_rpof(:,:,1) * zr1_e1e2f(:,:)
+# endif
+
+            DO jk = 1, jpkm1                                 ! Horizontal slab
+               !
+               DO_2D_01_01
+               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
+!!gm note that ahmf has already been multiplied by fmask
+            zcur(ji-1,jj-1) =  &
+               &      ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * zr1_e1e2f(ji-1,jj-1)      &
+               &  * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  &
+               &     - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  )
+            !                                      ! ahm * div        (computed from 2 to jpi/jpj)
+!!gm note that ahmt has already been multiplied by tmask
+                  zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)                                         &
+                     &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  &
+                     &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  )
+               END_2D
+               !
+               DO_2D_00_00
+                  pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * (                                             &
+                     &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   &
+                     &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                       )
+                     !
+                  pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * (                                             &
+                     &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   &
+                     &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                       )
+               END_2D
+               !
+            END DO                                           !   End of slab
+            !
+         CASE ( np_dynldf_lap_sym )       !==  Symmetric form  ==!   (Griffies&Hallberg 2000)
+            !
+            DO jk = 1, jpkm1                                 ! Horizontal slab
+               !
+               DO_2D_01_01
+                  !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask
+                  zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              &
+                     &     * (    e1f(ji-1,jj-1)    * r1_e2f(ji-1,jj-1)                                             &
+                     &         * ( pu(ji-1,jj  ,jk) * r1_e1u(ji-1,jj  )  - pu(ji-1,jj-1,jk) * r1_e1u(ji-1,jj-1) )   &
+                     &         +  e2f(ji-1,jj-1)    * r1_e1f(ji-1,jj-1)                                             &
+                     &         * ( pv(ji  ,jj-1,jk) * r1_e2v(ji  ,jj-1)  - pv(ji-1,jj-1,jk) * r1_e2v(ji-1,jj-1) )   )
+                  !                                      ! tension stress component (T-point)   NB : ahmt has already been multiplied by tmask
+                  zten(ji,jj)    = ahmt(ji,jj,jk)                                                       &
+                     &     * (    e2t(ji,jj)    * r1_e1t(ji,jj)                                         &
+                     &         * ( pu(ji,jj,jk) * r1_e2u(ji,jj)  - pu(ji-1,jj,jk) * r1_e2u(ji-1,jj) )   &
+                     &         -  e1t(ji,jj)    * r1_e2t(ji,jj)                                         &
+                     &         * ( pv(ji,jj,jk) * r1_e1v(ji,jj)  - pv(ji,jj-1,jk) * r1_e1v(ji,jj-1) )   )
+               END_2D
+               !
+               DO_2D_00_00
+                  pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               &
+                     &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       &
+                     &            - zten(ji  ,jj  ) * e2t(ji  ,jj  )*e2t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm) ) * r1_e2u(ji,jj)     &
+                     &        + (   zshe(ji  ,jj  ) * e1f(ji  ,jj  )*e1f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                           &
+                     &            - zshe(ji  ,jj-1) * e1f(ji  ,jj-1)*e1f(ji  ,jj-1) * e3f(ji  ,jj-1,jk)     ) * r1_e1u(ji,jj) )
+                  !
+                  pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                               &
+                     &    * (   (   zshe(ji  ,jj  ) * e2f(ji  ,jj  )*e2f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                           &
+                     &            - zshe(ji-1,jj  ) * e2f(ji-1,jj  )*e2f(ji-1,jj  ) * e3f(ji-1,jj  ,jk)     ) * r1_e2v(ji,jj)     &
+                     &        - (   zten(ji  ,jj+1) * e1t(ji  ,jj+1)*e1t(ji  ,jj+1) * e3t(ji  ,jj+1,jk,Kmm)                       &
+                     &            - zten(ji  ,jj  ) * e1t(ji  ,jj  )*e1t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm) ) * r1_e1v(ji,jj) )
+                   !
+               END_2D
+               !
+            END DO                                           !   End of slab
+            !
+         CASE ( np_dynldf_lap_symN )       !==  Symmetric form  ==!   (naive way)
+            !
+            DO jk = 1, jpkm1                                 ! Horizontal slab
+               !
+               DO_2D_01_01
+                  !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask
+                  zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                           &
+                     &     * (   r1_e2f(ji-1,jj-1) * ( pu(ji-1,jj  ,jk) - pu(ji-1,jj-1,jk)  )   &
+                     &         + r1_e1f(ji-1,jj-1) * ( pv(ji  ,jj-1,jk) - pv(ji-1,jj-1,jk)  )   )
+                  !                                      ! tension stress component (T-point)   NB : ahmt has already been multiplied by tmask
+                  zten(ji,jj)    = ahmt(ji,jj,jk)                                       &
+                     &     * (   r1_e1t(ji,jj) * ( pu(ji,jj,jk) - pu(ji-1,jj  ,jk)  )   &
+                     &         - r1_e2t(ji,jj) * ( pv(ji,jj,jk) - pv(ji  ,jj-1,jk)  )   )
+               END_2D
+               !
+               DO_2D_00_00
+                  pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   &
+                     &    * (   zten(ji+1,jj  ) * e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)              &
+                     &        - zten(ji  ,jj  ) * e2t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm)              &
+                     &        + zshe(ji  ,jj  ) * e1f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                  &
+                     &        - zshe(ji  ,jj-1) * e1f(ji  ,jj-1) * e3f(ji  ,jj-1,jk)                  )
+                  !
+                  pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)   &
+                     &    * (   zshe(ji  ,jj  ) * e2f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                  &
+                     &        - zshe(ji-1,jj  ) * e2f(ji-1,jj  ) * e3f(ji-1,jj  ,jk)                  &
+                     &        - zten(ji  ,jj+1) * e1t(ji  ,jj+1) * e3t(ji  ,jj+1,jk,Kmm)              &
+                     &        + zten(ji  ,jj  ) * e1t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm)              )
+                   !
+               END_2D
+               !
+            END DO                                           !   End of slab
+            !
+         CASE DEFAULT                                     ! error
+            CALL ctl_stop('STOP','dyn_ldf_lap: wrong value for nn_dynldf_lap_typ'  )
+         END SELECT
+         !
+      !
+   END SUBROUTINE dyn_ldf_lap
+
+
+   SUBROUTINE dyn_ldf_blp( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_ldf_blp  ***
+      !!
+      !! ** Purpose :   Compute the before lateral momentum viscous trend
+      !!              and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The lateral viscous trends is provided by a bilaplacian
+      !!      operator applied to before field (forward in time).
+      !!      It is computed by two successive calls to dyn_ldf_lap routine
+      !!
+      !! ** Action :   pt(:,:,:,:,Krhs)   updated with the before rotated bilaplacian diffusion
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      zulap(:,:,:) = 0._wp
+      zvlap(:,:,:) = 0._wp
+      !
+      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb)
+      !
+      CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. )             ! Lateral boundary conditions
+      !
+      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs))
+      !
+   END SUBROUTINE dyn_ldf_blp
+
+   !!======================================================================
+END MODULE dynldf_lap_blp
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dynvor.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dynvor.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dynvor.F90	(revision 13562)
@@ -0,0 +1,1151 @@
+MODULE dynvor
+   !!======================================================================
+   !!                       ***  MODULE  dynvor  ***
+   !! Ocean dynamics: Update the momentum trend with the relative and
+   !!                 planetary vorticity trends
+   !!======================================================================
+   !! History :  OPA  ! 1989-12  (P. Andrich)  vor_ens: Original code
+   !!            5.0  ! 1991-11  (G. Madec)  vor_ene, vor_mix: Original code
+   !!            6.0  ! 1996-01  (G. Madec)  s-coord, suppress work arrays
+   !!   NEMO     0.5  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!            1.0  ! 2004-02  (G. Madec)  vor_een: Original code
+   !!             -   ! 2003-08  (G. Madec)  add vor_ctl
+   !!             -   ! 2005-11  (G. Madec)  add dyn_vor (new step architecture)
+   !!            2.0  ! 2006-11  (G. Madec)  flux form advection: add metric term
+   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase
+   !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity
+   !!             -   ! 2014-06  (G. Madec)  suppression of velocity curl from in-core memory
+   !!             -   ! 2016-12  (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T)
+   !!            4.0  ! 2017-07  (G. Madec)  linear dynamics + trends diag. with Stokes-Coriolis
+   !!             -   ! 2018-03  (G. Madec)  add two new schemes (ln_dynvor_enT and ln_dynvor_eet)
+   !!             -   ! 2018-04  (G. Madec)  add pre-computed gradient for metric term calculation
+   !!            4.x  ! 2020-03  (G. Madec, A. Nasser)  make ln_dynvor_msk truly efficient on relative vorticity
+   !!            4.x  ! 2020-03  (G. Madec, A. Nasser)  alternate direction computation of vorticity tendancy
+   !!                 !                                 for ENS, ENE
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_vor       : Update the momentum trend with the vorticity trend
+   !!       vor_ens   : enstrophy conserving scheme       (ln_dynvor_ens=T)
+   !!       vor_ene   : energy conserving scheme          (ln_dynvor_ene=T)
+   !!       vor_een   : energy and enstrophy conserving   (ln_dynvor_een=T)
+   !!   dyn_vor_init  : set and control of the different vorticity option
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE dommsk         ! ocean mask
+   USE dynadv         ! momentum advection
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   USE sbcwave        ! Surface Waves (add Stokes-Coriolis force)
+   USE sbc_oce , ONLY : ln_stcor    ! use Stoke-Coriolis force
+   !
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+!!anAD only
+   USE dynkeg, ONLY : dyn_kegAD
+   USE dynadv, ONLY : nn_dynkeg
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_vor        ! routine called by step.F90
+   PUBLIC   dyn_vor_init   ! routine called by nemogcm.F90
+
+   !                                   !!* Namelist namdyn_vor: vorticity term
+   LOGICAL, PUBLIC ::   ln_dynvor_ens      !: enstrophy conserving scheme          (ENS)
+   LOGICAL, PUBLIC ::   ln_dynvor_ens_adVO   = .FALSE.   !: AD enstrophy conserving scheme       (ENS_ad)
+   LOGICAL, PUBLIC ::   ln_dynvor_ens_adKE   = .FALSE.   !: AD enstrophy conserving scheme       (ENS_ad)
+   LOGICAL, PUBLIC ::   ln_dynvor_ens_adKEVO = .FALSE.   !: AD enstrophy conserving scheme       (ENS_ad)
+   LOGICAL, PUBLIC ::   ln_dynvor_ene      !: f-point energy conserving scheme     (ENE)
+   LOGICAL, PUBLIC ::   ln_dynvor_ene_adVO   = .FALSE.   !: f-point AD energy conserving scheme  (ENE_ad)
+   LOGICAL, PUBLIC ::   ln_dynvor_ene_adKE   = .FALSE.   !: f-point AD energy conserving scheme  (ENE_ad)
+   LOGICAL, PUBLIC ::   ln_dynvor_ene_adKEVO = .FALSE.   !: f-point AD energy conserving scheme  (ENE_ad)
+   LOGICAL, PUBLIC ::   ln_dynvor_enT      !: t-point energy conserving scheme     (ENT)
+   LOGICAL, PUBLIC ::   ln_dynvor_eeT      !: t-point energy conserving scheme     (EET)
+   LOGICAL, PUBLIC ::   ln_dynvor_een      !: energy & enstrophy conserving scheme (EEN)
+   INTEGER, PUBLIC ::      nn_een_e3f         !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   LOGICAL, PUBLIC ::   ln_dynvor_mix      !: mixed scheme                         (MIX)
+   LOGICAL, PUBLIC ::   ln_dynvor_msk      !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)
+
+   INTEGER, PUBLIC ::   nvor_scheme     !: choice of the type of advection scheme
+   !                                       ! associated indices:
+   INTEGER, PUBLIC, PARAMETER ::   np_ENS = 0   ! ENS scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_ENE = 1   ! ENE scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_ENT = 2   ! ENT scheme (t-point vorticity)
+   INTEGER, PUBLIC, PARAMETER ::   np_EET = 3   ! EET scheme (EEN using e3t)
+   INTEGER, PUBLIC, PARAMETER ::   np_EEN = 4   ! EEN scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_MIX = 5   ! MIX scheme
+!!an
+   INTEGER, PUBLIC, PARAMETER ::   np_ENS_adKE   = 11   ! ENS scheme - AD scheme (KE only)
+   INTEGER, PUBLIC, PARAMETER ::   np_ENS_adVO   = 12   ! ENS scheme - AD scheme (VOR only)
+   INTEGER, PUBLIC, PARAMETER ::   np_ENS_adKEVO = 13   ! ENS scheme - AD scheme (KE+VOR)
+   INTEGER, PUBLIC, PARAMETER ::   np_ENE_adKE   = 21   ! ENE scheme - AD scheme (KE only)
+   INTEGER, PUBLIC, PARAMETER ::   np_ENE_adVO   = 22   ! ENE scheme - AD scheme (VOR only)
+   INTEGER, PUBLIC, PARAMETER ::   np_ENE_adKEVO = 23   ! ENE scheme - AD scheme (KE+VOR)
+!!an
+
+!!an ds step on pourra spécifier la valeur de ntot = np_COR ou np_COR + np_RVO
+   INTEGER, PUBLIC ::   ncor, nrvm, ntot   ! choice of calculated vorticity
+   !                               ! associated indices:
+   INTEGER, PUBLIC, PARAMETER ::   np_COR = 1         ! Coriolis (planetary)
+   INTEGER, PUBLIC, PARAMETER ::   np_RVO = 2         ! relative vorticity
+   INTEGER, PUBLIC, PARAMETER ::   np_MET = 3         ! metric term
+   INTEGER, PUBLIC, PARAMETER ::   np_CRV = 4         ! relative + planetary (total vorticity)
+   INTEGER, PUBLIC, PARAMETER ::   np_CME = 5         ! Coriolis + metric term
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       -
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2u)/(2*e1e2f)  used in F-point metric term calculation
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1v)/(2*e1e2f)   -        -      -       -
+
+   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4
+   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+!!st23
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dynvor.F90 13154 2020-06-24 13:31:32Z gm $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_vor( kt, Kbb, Kmm, puu, pvv, Krhs)
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!
+      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend
+      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative
+      !!               and planetary vorticity trends) and send them to trd_dyn
+      !!               for futher diagnostics (l_trddyn=T)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indice
+      INTEGER                             , INTENT( in  ) ::   kt               ! ocean time-step index
+      INTEGER                             , INTENT( in  ) ::   Kmm, Krhs, Kbb   ! ocean time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv         ! ocean velocity field and RHS of momentum equation
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zuu, zvv
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_timing )   CALL timing_start('dyn_vor')
+      !
+      IF( l_trddyn ) THEN     !==  trend diagnostics case : split the added trend in two parts  ==!
+         !
+         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) )
+         !
+         ztrdu(:,:,:) = puu(:,:,:,Krhs)            !* planetary vorticity trend (including Stokes-Coriolis force)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs)
+         SELECT CASE( nvor_scheme )
+         CASE( np_ENS )           ;   CALL vor_ens( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! enstrophy conserving scheme
+            IF( ln_stcor )            CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme
+            IF( ln_stcor )            CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (T-pts)
+            IF( ln_stcor )            CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (een with e3t)
+            IF( ln_stcor )            CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy & enstrophy scheme
+            IF( ln_stcor )            CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         END SELECT
+         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt, Kmm )
+         !
+         IF( n_dynadv /= np_LIN_dyn ) THEN   !* relative vorticity or metric trend (only in non-linear case)
+            ztrdu(:,:,:) = puu(:,:,:,Krhs)
+            ztrdv(:,:,:) = pvv(:,:,:,Krhs)
+            SELECT CASE( nvor_scheme )
+            CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme (T-pts)
+            CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme (een with e3t)
+            CASE( np_ENE )           ;   CALL vor_ene( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy conserving scheme
+            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! enstrophy conserving scheme
+            CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! energy & enstrophy scheme
+            END SELECT
+            ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt, Kmm )
+         ENDIF
+         !
+         DEALLOCATE( ztrdu, ztrdv )
+         !
+      ELSE              !==  total vorticity trend added to the general trend  ==!
+         !
+         SELECT CASE ( nvor_scheme )      !==  vorticity trend added to the general trend  ==!
+         CASE( np_ENT )                        !* energy conserving scheme  (T-pts)
+                             CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EET )                        !* energy conserving scheme (een scheme using e3t)
+                             CALL vor_eeT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENE )                        !* energy conserving scheme
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs), pv_rhs=pvv(:,:,:,Krhs) )
+                             CALL vor_ene(   kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+
+         CASE( np_ENE_adVO )                     !* energy conserving scheme with alternating direction
+            IF( MOD( kt , 2 ) ==  1 ) THEN           ! even time step:  u-vor then v-vor components
+
+                              !==  Alternative direction - VOR only  ==!
+
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs), pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+
+                             ALLOCATE( zuu(jpi,jpj,jpk) )
+                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             zuu(:,:,:) = puu(:,:,:,Kbb) + rDt * puu(:,:,:,Krhs) * umask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zuu(:,:,:) , 'U', -1._wp )
+                             CALL vor_ene( kt, Kmm, ntot, zuu(:,:,:)     , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             DEALLOCATE( zuu )
+            ELSE
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs), pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+
+                             ALLOCATE( zvv(jpi,jpj,jpk) )
+                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             zvv(:,:,:) = pvv(:,:,:,Kbb) + rDt * pvv(:,:,:,Krhs) * vmask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zvv(:,:,:) , 'V', -1._wp )
+                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm), zvv(:,:,:) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             DEALLOCATE( zvv )
+            ENDIF
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_ENE_adKE )                     !* energy conserving scheme with alternating direction
+            IF( MOD( kt , 2 ) ==  1 ) THEN           ! even time step:  u-vor then v-vor components
+
+                                 !==  Alternative direction - KEG only  ==!
+
+                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+
+                             ALLOCATE( zuu(jpi,jpj,jpk) )
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             zuu(:,:,:) = puu(:,:,:,Kbb) + rDt * puu(:,:,:,Krhs) * umask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zuu(:,:,:) , 'U', -1._wp )
+                             CALL dyn_kegAD( kt, nn_dynkeg, zuu(:,:,:)     , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             DEALLOCATE( zuu )
+            ELSE
+
+                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+
+                             ALLOCATE( zvv(jpi,jpj,jpk) )
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             zvv(:,:,:) = pvv(:,:,:,Kbb) + rDt * pvv(:,:,:,Krhs) * vmask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zvv(:,:,:) , 'V', -1._wp )
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm)  , zvv(:,:,:) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             DEALLOCATE( zvv )
+            ENDIF
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+
+         CASE( np_ENE_adKEVO )                     !* energy conserving scheme with alternating direction
+         ! equivalent ADE pas sur coriolis
+         ! appel vor_ene(ncor)
+            IF( MOD( kt , 2 ) ==  1 ) THEN           ! even time step:  u-vor then v-vor components
+
+                              !==  Alternative direction - KE + VOR  ==!
+
+                             ALLOCATE( zuu(jpi,jpj,jpk) )
+                             !puis call que sur nrvm
+                             CALL vor_ene(   kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   !
+                             zuu(:,:,:) = puu(:,:,:,Kbb) + rDt * puu(:,:,:,Krhs) * umask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zuu(:,:,:) , 'U', -1._wp )
+                             !puis call que sur nrvm
+                             CALL vor_ene(   kt, Kmm, ntot, zuu(:,:,:) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, zuu(:,:,:) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )
+                             DEALLOCATE( zuu )
+            ELSE
+
+                             ALLOCATE( zvv(jpi,jpj,jpk) )
+                             CALL vor_ene(   kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )
+                             zvv(:,:,:) = pvv(:,:,:,Kbb) + rDt * pvv(:,:,:,Krhs) * vmask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zvv(:,:,:) , 'V', -1._wp )
+                             CALL vor_ene(   kt, Kmm, ntot, puu(:,:,:,Kmm), zvv(:,:,:) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm), zvv(:,:,:) , pu_rhs=puu(:,:,:,Krhs) )
+                             DEALLOCATE( zvv )
+            ENDIF
+         CASE( np_ENS )                        !* enstrophy conserving scheme
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs), pv_rhs=pvv(:,:,:,Krhs) )
+                             CALL vor_ens(   kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend
+         CASE( np_ENS_adVO )                     !* enstrophy conserving scheme with alternating direction
+            IF( MOD( kt , 2 ) ==  1 ) THEN           ! even time step:  u-vor then v-vor components
+
+                                 !==  Alternative direction - VOR only  ==!
+
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs), pv_rhs=pvv(:,:,:,Krhs) )
+
+                             ALLOCATE( zuu(jpi,jpj,jpk) )
+                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             zuu(:,:,:) = puu(:,:,:,Kbb) + rDt * puu(:,:,:,Krhs) * umask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zuu(:,:,:) , 'U', -1._wp )
+                             CALL vor_ens( kt, Kmm, ntot, zuu(:,:,:)     , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             DEALLOCATE( zuu )
+            ELSE
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs), pv_rhs=pvv(:,:,:,Krhs) )
+
+                             ALLOCATE( zvv(jpi,jpj,jpk) )
+                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             zvv(:,:,:) = pvv(:,:,:,Kbb) + rDt * pvv(:,:,:,Krhs) * vmask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zvv(:,:,:) , 'V', -1._wp )
+                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , zvv(:,:,:), pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             DEALLOCATE( zvv )
+            ENDIF
+            IF( ln_stcor )   CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend
+         CASE( np_ENS_adKE )                     !* enstrophy conserving scheme with alternating direction
+            IF( MOD( kt , 2 ) ==  1 ) THEN           ! even time step:  u-vor then v-vor components
+
+                                !==  Alternative direction - KEG only  ==!
+
+                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! total vorticity trend
+
+                             ALLOCATE( zuu(jpi,jpj,jpk) )
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             zuu(:,:,:) = puu(:,:,:,Kbb) + rDt * puu(:,:,:,Krhs) * umask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zuu(:,:,:) , 'U', -1._wp )
+                             CALL dyn_kegAD( kt, nn_dynkeg, zuu(:,:,:)     , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             DEALLOCATE( zuu )
+            ELSE
+
+                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! total vorticity trend
+
+                             ALLOCATE( zvv(jpi,jpj,jpk) )
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             zvv(:,:,:) = pvv(:,:,:,Kbb) + rDt * pvv(:,:,:,Krhs) * vmask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zvv(:,:,:) , 'V', -1._wp )
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , zvv(:,:,:)  , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             DEALLOCATE( zvv )
+            ENDIF
+         CASE( np_ENS_adKEVO )                     !* enstrophy conserving scheme with alternating direction
+            IF( MOD( kt , 2 ) ==  1 ) THEN           ! even time step:  u-vor then v-vor components
+
+                              !==  Alternative direction - KE + VOR  ==!
+
+                             ALLOCATE( zuu(jpi,jpj,jpk) )
+                             CALL vor_ens(   kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pu_rhs=puu(:,:,:,Krhs) )   !
+                             zuu(:,:,:) = puu(:,:,:,Kbb) + rDt * puu(:,:,:,Krhs) * umask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zuu(:,:,:) , 'U', -1._wp )
+                             CALL vor_ens(   kt, Kmm, ntot, zuu(:,:,:) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, zuu(:,:,:) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )
+                             DEALLOCATE( zuu )
+            ELSE
+
+                             ALLOCATE( zvv(jpi,jpj,jpk) )
+                             CALL vor_ens(   kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )   ! compute and add vv-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , pv_rhs=pvv(:,:,:,Krhs) )
+                             zvv(:,:,:) = pvv(:,:,:,Kbb) + rDt * pvv(:,:,:,Krhs) * vmask(:,:,:)
+                             CALL lbc_lnk( 'dynvor', zvv(:,:,:) , 'V', -1._wp )
+                             CALL vor_ens(   kt, Kmm, ntot, puu(:,:,:,Kmm), zvv(:,:,:) , pu_rhs=puu(:,:,:,Krhs) )   ! compute and add uu-vorticity trend
+                             CALL dyn_kegAD( kt, nn_dynkeg, puu(:,:,:,Kmm), zvv(:,:,:) , pu_rhs=puu(:,:,:,Krhs) )
+                             DEALLOCATE( zvv )
+            ENDIF
+            IF( ln_stcor )   CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend
+         CASE( np_MIX )                        !* mixed ene-ens scheme
+                             CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! relative vorticity or metric trend (ens)
+                             CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! planetary vorticity trend (ene)
+            IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         CASE( np_EEN )                        !* energy and enstrophy conserving scheme
+                             CALL vor_een( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend
+         END SELECT
+         !
+      ENDIF
+      !
+      !                       ! print sum trends (used for debugging)
+      IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' vor  - Ua: ', mask1=umask,               &
+         &                                tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      IF( ln_timing )   CALL timing_stop('dyn_vor')
+      !
+   END SUBROUTINE dyn_vor
+
+
+   SUBROUTINE vor_enT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE vor_enT  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!       and t-point evaluation of vorticity (planetary and relative).
+      !!       conserves the horizontal kinetic energy.
+      !!         The general trend of momentum is increased due to the vorticity
+      !!       term which is given by:
+      !!          voru = 1/bu  mj[ ( mi(mj(bf*rvor))+bt*f_t)/e3t  mj[vn] ]
+      !!          vorv = 1/bv  mi[ ( mi(mj(bf*rvor))+bt*f_t)/e3f  mj[un] ]
+      !!       where rvor is the relative vorticity at f-point
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt               ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
+      INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zwt   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz             ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_enT : vorticity term: t-point energy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !
+      SELECT CASE( kvor )                 !== relative vorticity considered  ==!
+      CASE ( np_RVO , np_CRV )                  !* relative vorticity at f-point is used
+         DO jk = 1, jpkm1                                ! Horizontal slab
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
+            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity
+               DO_2D_10_10
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+               END_2D
+            ENDIF
+         END DO
+         CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )
+         !
+      END SELECT
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==!
+         !
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm)
+         CASE ( np_RVO )                           !* relative vorticity
+            DO_2D_01_01
+               zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   &
+                  &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) &
+                  &                * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+            END_2D
+         CASE ( np_MET )                           !* metric term
+            DO_2D_01_01
+               zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)     &
+                  &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) &
+                  &         * e3t(ji,jj,jk,Kmm)
+            END_2D
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO_2D_01_01
+               zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)      &
+                  &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) &
+                  &         * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+            END_2D
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO_2D_01_01
+               zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                             &
+                    &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)    &
+                    &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) &
+                    &       * e3t(ji,jj,jk,Kmm)
+            END_2D
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         !                                   !==  compute and add the vorticity term trend  =!
+         DO_2D_00_00
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                    &
+               &                                * (  zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) )   &
+               &                                   + zwt(ji  ,jj) * ( pv(ji  ,jj,jk) + pv(ji  ,jj-1,jk) )   )
+               !
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                    &
+               &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   &
+               &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   )
+         END_2D
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE vor_enT
+
+
+   SUBROUTINE vor_ene( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE vor_ene  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!       and the Sadourny (1975) flux form formulation : conserves the
+      !!       horizontal kinetic energy.
+      !!         The general trend of momentum is increased due to the vorticity
+      !!       term which is given by:
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v pvv(:,:,:,Kmm)) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u puu(:,:,:,Kmm)) ]
+      !!       where rvor is the relative vorticity
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
+      !!
+      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kmm              ! ocean time level index
+      INTEGER                                  , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
+      REAL(wp), DIMENSION(jpi,jpj,jpk)         , INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk),OPTIONAL, INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t        ! unpenalised scale factors
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_ene : vorticity term: energy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff_f(:,:)
+         CASE ( np_RVO )                           !* relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
+            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity
+               DO_2D_10_10
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END_2D
+            ENDIF
+         CASE ( np_MET )                           !* metric term
+            DO_2D_10_10
+               zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                        - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+            END_2D
+            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity (NOT the Coriolis term)
+               DO_2D_10_10
+                  zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)
+               END_2D
+            ENDIF
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         IF( PRESENT( pu_rhs ) .AND. PRESENT( pv_rhs ) ) THEN     !***  NO alternating direction  ***!
+            !
+            !                                   !==  horizontal fluxes and potential vorticity ==!
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            !
+            !                                   !==  compute and add the vorticity term trend  =!
+            DO_2D_00_00
+               zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1)
+               zy2 = zwy(ji,jj  ) + zwy(ji+1,jj  )
+               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
+               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
+               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+            END_2D
+            !
+            !
+         ELSEIF(       PRESENT( pu_rhs ) .AND. .NOT. PRESENT( pv_rhs ) ) THEN            !***  Alternating direction : i-component  ***!
+            !
+            !
+            !                                   !==  horizontal fluxes and potential vorticity ==!
+!!anAD remplacer pu par uu(Nnn) et on fait correctement la direction alternée
+!      on transportera (en AD) de la bonne manière
+            !zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            !
+            !                                   !==  compute and add the vorticity term trend  =!
+            DO_2D_00_00
+               zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1)
+               zy2 = zwy(ji,jj  ) + zwy(ji+1,jj  )
+               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+            END_2D
+            !
+         ELSEIF( .NOT. PRESENT( pu_rhs ) .AND.       PRESENT( pv_rhs ) ) THEN            !***  Alternating direction : j-component  ***!
+            !
+            !
+            !                                   !==  horizontal fluxes and potential vorticity ==!
+!!anAD remplacer pu par uu(Nnn) et on fait correctement la direction alternée
+            !zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            !
+            !                                   !==  compute and add the vorticity term trend  =!
+            DO_2D_00_00
+               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
+               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
+               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+            END_2D
+            !
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE vor_ene
+
+
+   SUBROUTINE vor_ens( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE vor_ens  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!      and the Sadourny (1975) flux FORM formulation : conserves the
+      !!      potential enstrophy of a horizontally non-divergent flow. the
+      !!      trend of the vorticity term is given by:
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v pvv(:,:,:,Kmm)) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u puu(:,:,:,Kmm)) ]
+      !!      Add this trend to the general momentum trend:
+      !!          (u(rhs),v(Krhs)) = (u(rhs),v(Krhs)) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs)) arrays with the now vorticity term trend
+      !!
+      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kmm              ! ocean time level index
+      INTEGER                                  , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
+      REAL(wp), DIMENSION(jpi,jpj,jpk)         , INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk),OPTIONAL, INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zuav, zvau   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   zr1_e1e2f            ! 2D workspace penalised
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_ens : vorticity term: enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      zr1_e1e2f(:,:) = r1_e1e2f(:,:)
+# if defined key_bvp
+      zr1_e1e2f(:,:) = r1_rpof(:,:,1) * zr1_e1e2f(:,:)
+# endif
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff_f(:,:)
+         CASE ( np_RVO )                           !* relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * zr1_e1e2f(ji,jj)
+            END_2D
+            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity
+               DO_2D_10_10
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END_2D
+            ENDIF
+         CASE ( np_MET )                           !* metric term
+            DO_2D_10_10
+               zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &                        - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * zr1_e1e2f(ji,jj)
+            END_2D
+            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity (NOT the Coriolis term)
+               DO_2D_10_10
+                  zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)
+               END_2D
+            ENDIF
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO_2D_10_10
+               zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         !
+!!an wut ? v et u
+         IF( PRESENT( pu_rhs ) .AND. PRESENT( pv_rhs ) ) THEN     !***  NO alternating direction  ***!
+            !
+            !                                   !==  horizontal fluxes and potential vorticity ==!
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            !
+            !                                   !==  compute and add the vorticity term trend  =!
+            DO_2D_00_00
+               zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
+                  &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
+               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
+                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
+               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+            END_2D
+            !
+         ELSEIF(       PRESENT( pu_rhs ) .AND. .NOT. PRESENT( pv_rhs ) ) THEN            !***  Alternating direction : i-component  ***!
+            !
+            !
+            !                                   !==  horizontal fluxes and potential vorticity ==!
+            zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            !
+            !                                   !==  compute and add the vorticity term trend  =!
+            DO_2D_00_00
+               zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
+                  &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
+               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+            END_2D
+            !
+         ELSEIF( .NOT. PRESENT( pu_rhs ) .AND.       PRESENT( pv_rhs ) ) THEN            !***  Alternating direction : j-component  ***!
+            !
+            !
+            !                                   !==  horizontal fluxes and potential vorticity ==!
+            zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f(:,:,jk)
+            !
+            !                                   !==  compute and add the vorticity term trend  =!
+            DO_2D_00_00
+               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
+                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
+               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+            END_2D
+            !
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE vor_ens
+
+
+   SUBROUTINE vor_een( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE vor_een  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!      and the Arakawa and Lamb (1980) flux form formulation : conserves
+      !!      both the horizontal kinetic energy and the potential enstrophy
+      !!      when horizontal divergence is zero (see the NEMO documentation)
+      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
+      !!
+      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
+      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ierr         ! local integer
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp) ::   zmsk, ze3f   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx , zwy , z1_e3f
+      REAL(wp), DIMENSION(jpi,jpj)     ::   ztnw, ztne, ztsw, ztse
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point
+         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+            DO_2D_10_10
+               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   &
+                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   &
+                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f
+               ELSE                       ;   z1_e3f(ji,jj) = 0._wp
+               ENDIF
+            END_2D
+         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+            DO_2D_10_10
+               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   &
+                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   &
+                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   &
+                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  )
+               zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
+                  &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
+               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3f
+               ELSE                       ;   z1_e3f(ji,jj) = 0._wp
+               ENDIF
+            END_2D
+         END SELECT
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj)
+            END_2D
+         CASE ( np_RVO )                           !* relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  &
+                  &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)
+            END_2D
+         CASE ( np_MET )                           !* metric term
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &              - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      &
+                  &                              - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  )   &
+                  &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                            - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+            END_2D
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO_2D_10_10
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+            END_2D
+         ENDIF
+      END DO                                           !   End of slab
+         !
+      CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )
+
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !
+         !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+
+         !                                   !==  compute and add the vorticity term trend  =!
+         jj = 2
+         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0
+         DO ji = 2, jpi          ! split in 2 parts due to vector opt.
+               ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk)
+               ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk)
+               ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk)
+               ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk)
+         END DO
+         DO jj = 3, jpj
+            DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3
+               ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk)
+               ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk)
+               ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk)
+               ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk)
+            END DO
+         END DO
+         DO_2D_00_00
+            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+               &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+            zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+               &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+         END_2D
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE vor_een
+
+
+
+   SUBROUTINE vor_eeT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE vor_eeT  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!      and the Arakawa and Lamb (1980) vector form formulation using
+      !!      a modified version of Arakawa and Lamb (1980) scheme (see vor_een).
+      !!      The change consists in
+      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+      !!
+      !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
+      !!
+      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index
+      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk     ! dummy loop indices
+      INTEGER  ::   ierr           ! local integer
+      REAL(wp) ::   zua, zva       ! local scalars
+      REAL(wp) ::   zmsk, z1_e3t   ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx , zwy
+      REAL(wp), DIMENSION(jpi,jpj)     ::   ztnw, ztne, ztsw, ztse
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ff_f(ji,jj)
+            END_2D
+         CASE ( np_RVO )                           !* relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+                  &          * r1_e1e2f(ji,jj)
+            END_2D
+         CASE ( np_MET )                           !* metric term
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &          - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO_2D_10_10
+               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    &
+                  &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) &
+                  &                         * r1_e1e2f(ji,jj)    )
+            END_2D
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO_2D_10_10
+               zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   &
+                  &                        - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+            END_2D
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO_2D_10_10
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk)
+            END_2D
+         ENDIF
+      END DO
+      !
+      CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )
+      !
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !
+         !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk)
+
+         !                                   !==  compute and add the vorticity term trend  =!
+         jj = 2
+         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0
+         DO ji = 2, jpi          ! split in 2 parts due to vector opt.
+               z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
+               ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t
+               ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t
+               ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t
+               ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t
+         END DO
+         DO jj = 3, jpj
+            DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3
+               z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
+               ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t
+               ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t
+               ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t
+               ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t
+            END DO
+         END DO
+         DO_2D_00_00
+            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+               &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+            zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+               &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+         END_2D
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE vor_eeT
+
+
+   SUBROUTINE dyn_vor_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_vor_init  ***
+      !!
+      !! ** Purpose :   Control the consistency between cpp options for
+      !!              tracer advection schemes
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk    ! dummy loop indices
+      INTEGER ::   ioptio, ios   ! local integer
+      !!
+      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_enT, ln_dynvor_eeT,   &
+         &                 ln_dynvor_een, nn_een_e3f   , ln_dynvor_mix, ln_dynvor_msk,   &
+         &                 ln_dynvor_ens_adVO, ln_dynvor_ens_adKE, ln_dynvor_ens_adKEVO, &   ! Alternative direction parameters
+         &                 ln_dynvor_ene_adVO, ln_dynvor_ene_adKE, ln_dynvor_ene_adKEVO
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_vor_init : vorticity term : read namelist and control the consistency'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      READ  ( numnam_ref, namdyn_vor, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_vor in reference namelist' )
+      READ  ( numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist' )
+      IF(lwm) WRITE ( numond, namdyn_vor )
+      !
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*) '   Namelist namdyn_vor : choice of the vorticity term scheme'
+         WRITE(numout,*) '      enstrophy conserving scheme                    ln_dynvor_ens = ', ln_dynvor_ens
+         WRITE(numout,*) '      f-point energy conserving scheme               ln_dynvor_ene = ', ln_dynvor_ene
+         WRITE(numout,*) '      t-point energy conserving scheme               ln_dynvor_enT = ', ln_dynvor_enT
+         WRITE(numout,*) '      energy conserving scheme  (een using e3t)      ln_dynvor_eeT = ', ln_dynvor_eeT
+         WRITE(numout,*) '      enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een
+         WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f
+         WRITE(numout,*) '      mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix
+         WRITE(numout,*) '      masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk
+      ENDIF
+
+!!an      IF( ln_dynvor_msk )   CALL ctl_stop( 'dyn_vor_init:   masked vorticity is not currently not available')
+
+!!gm  this should be removed when choosing a unique strategy for fmask at the coast
+      ! If energy, enstrophy or mixed advection of momentum in vector form change the value for masks
+      ! at angles with three ocean points and one land point
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat
+      IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN
+         DO_3D_10_10( 1, jpk )
+            IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              &
+               & + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp
+         END_3D
+         !
+         CALL lbc_lnk( 'dynvor', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+         !
+      ENDIF
+!!gm end
+
+      ioptio = 0                     ! type of scheme for vorticity (set nvor_scheme)
+      IF( ln_dynvor_ens ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_ENS   ;   ENDIF
+      IF( ln_dynvor_ens_adVO ) THEN   ;   ioptio = ioptio + 1     ;   nvor_scheme = np_ENS_adVO   ;   ENDIF
+      IF( ln_dynvor_ens_adKE ) THEN   ;   ioptio = ioptio + 1     ;   nvor_scheme = np_ENS_adKE   ;   ENDIF
+      IF( ln_dynvor_ens_adKEVO ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_ENS_adKEVO   ;   ENDIF
+      IF( ln_dynvor_ene ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_ENE   ;   ENDIF
+      IF( ln_dynvor_ene_adVO ) THEN   ;   ioptio = ioptio + 1     ;   nvor_scheme = np_ENE_adVO   ;   ENDIF
+      IF( ln_dynvor_ene_adKE ) THEN   ;   ioptio = ioptio + 1     ;   nvor_scheme = np_ENE_adKE   ;   ENDIF
+      IF( ln_dynvor_ene_adKEVO ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_ENE_adKEVO   ;   ENDIF
+      IF( ln_dynvor_enT ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_ENT   ;   ENDIF
+      IF( ln_dynvor_eeT ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_EET   ;   ENDIF
+      IF( ln_dynvor_een ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_EEN   ;   ENDIF
+      IF( ln_dynvor_mix ) THEN   ;   ioptio = ioptio + 1   ;   nvor_scheme = np_MIX   ;   ENDIF
+      !
+      IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' )
+      !
+      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot)
+      ncor = np_COR                       ! planetary vorticity
+      SELECT CASE( n_dynadv )
+      CASE( np_LIN_dyn )
+         IF(lwp) WRITE(numout,*) '   ==>>>   linear dynamics : total vorticity = Coriolis'
+         nrvm = np_COR        ! planetary vorticity
+         ntot = np_COR        !     -         -
+      CASE( np_VEC_c2  )
+         IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'
+         nrvm = np_RVO        ! relative vorticity
+         ntot = np_CRV        ! relative + planetary vorticity
+      CASE( np_FLX_c2 , np_FLX_ubs  )
+         IF(lwp) WRITE(numout,*) '   ==>>>   flux form dynamics : total vorticity = Coriolis + metric term'
+         nrvm = np_MET        ! metric term
+         ntot = np_CME        ! Coriolis + metric term
+         !
+         SELECT CASE( nvor_scheme )    ! pre-computed gradients for the metric term:
+         CASE( np_ENT )                      !* T-point metric term :   pre-compute di(e2u)/2 and dj(e1v)/2
+            ALLOCATE( di_e2u_2(jpi,jpj), dj_e1v_2(jpi,jpj) )
+            DO_2D_00_00
+               di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj  ) ) * 0.5_wp
+               dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji  ,jj-1) ) * 0.5_wp
+            END_2D
+            CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1. , dj_e1v_2, 'T', -1. )   ! Lateral boundary conditions
+            !
+         CASE DEFAULT                        !* F-point metric term :   pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f)
+            ALLOCATE( di_e2v_2e1e2f(jpi,jpj), dj_e1u_2e1e2f(jpi,jpj) )
+            DO_2D_10_10
+               di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj  ) - e2v(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
+               dj_e1u_2e1e2f(ji,jj) = ( e1u(ji  ,jj+1) - e1u(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj)
+            END_2D
+            CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1. , dj_e1u_2e1e2f, 'F', -1. )   ! Lateral boundary conditions
+         END SELECT
+         !
+      END SELECT
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         SELECT CASE( nvor_scheme )
+
+         CASE( np_ENS    )   ;   WRITE(numout,*) '   ==>>>   enstrophy conserving scheme (ENS)'
+         CASE( np_ENS_adVO ) ;   WRITE(numout,*) '   ==>>>   AD enstrophy conserving scheme (ENS_adVO) on vorticity only'
+         CASE( np_ENS_adKE ) ;   WRITE(numout,*) '   ==>>>   AD enstrophy conserving scheme (ENS_adKE) on kinetic energy only'
+         CASE( np_ENS_adKEVO ) ;   WRITE(numout,*) '   ==>>>   AD enstrophy conserving scheme (ENS_adKEVO) on kinetic energy and vorticity'
+
+         CASE( np_ENE    )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (Coriolis at F-points) (ENE)'
+         CASE( np_ENE_adVO ) ;   WRITE(numout,*) '   ==>>>   AD energy conserving scheme (Coriolis at F-points) (ENE_adVO) on vorticity only'
+         CASE( np_ENE_adKE ) ;   WRITE(numout,*) '   ==>>>   AD energy conserving scheme (Coriolis at F-points) (ENE_adKE) on kinetic energy only'
+         CASE( np_ENE_adKEVO ) ;   WRITE(numout,*) '   ==>>>   AD energy conserving scheme (Coriolis at F-points) (ENE_adKEVO) on kinetic energy and vorticity'
+
+         CASE( np_ENT    )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (Coriolis at T-points) (ENT)'
+         CASE( np_EET    )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (EEN scheme using e3t) (EET)'
+         CASE( np_EEN    )   ;   WRITE(numout,*) '   ==>>>   energy and enstrophy conserving scheme (EEN)'
+         CASE( np_MIX    )   ;   WRITE(numout,*) '   ==>>>   mixed enstrophy/energy conserving scheme (MIX)'
+         END SELECT
+      ENDIF
+      !
+   END SUBROUTINE dyn_vor_init
+
+   !!==============================================================================
+END MODULE dynvor
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/oce.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/oce.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/oce.F90	(revision 13562)
@@ -0,0 +1,140 @@
+MODULE oce
+   !!======================================================================
+   !!                      ***  MODULE  oce  ***
+   !! Ocean        :  dynamics and active tracers defined in memory 
+   !!======================================================================
+   !! History :  1.0  !  2002-11  (G. Madec)  F90: Free form and module
+   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory
+   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename prognostic variables in preparation for new time scheme
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
+
+   !! dynamics and tracer fields
+   !! --------------------------                            
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   uu   ,  vv     !: horizontal velocities        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ww             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wi             !: vertical vel. (adaptive-implicit) [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   hdiv           !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   rab_b,  rab_n  !: thermal/haline expansion coef. [Celsius-1,psu-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rn2b ,  rn2    !: brunt-vaisala frequency**2     [s-2]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rho0)/rho0  [no units]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   Cu_adv                   !: vertical Courant number (adaptive-implicit)
+
+   !! free surface
+   !! ------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s]
+
+# if defined key_bvp
+      !! Penalisation fields                              
+      !! ------------
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rpo             !: porosity       (phi)    [-]
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rpou            !: porosity       (phi)    [-]
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rpov            !: porosity       (phi)    [-]
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rpof            !: porosity       (phi)    [-]
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   r1_rpo          !
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   r1_rpou         !
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   r1_rpov         !
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   r1_rpof         !
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   bmpt            !: T - permeability   (sigma)  [1/s]
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   bmpu            !: U - permeability   (sigma)  [1/s]
+      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   bmpv            !: V - permeability   (sigma)  [1/s]
+#endif 
+
+   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b           !: Half step fluxes (ln_bt_fw=T)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_bf  , vn_bf           !: Asselin filtered half step fluxes (ln_bt_fw=T)
+#if defined key_agrif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b, vb2_i_b         !: Half step time integrated fluxes 
+#endif
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
+
+   !! interpolated gradient (only used in zps case)
+   !! ---------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
+
+   !! (ISF) interpolated gradient (only used for ice shelf case) 
+   !! --------------------- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtui, gtvi   !: horizontal gradient of T, S and rd at top u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   grui, grvi   !: horizontal gradient of T, S and rd at top v-point  
+   !! (ISF) ice load
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riceload
+
+   !! Energy budget of the leads (open water embedded in sea ice)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev  !: fraction of solar net radiation absorbed in the first ocean level [-]
+   INTEGER, PUBLIC, DIMENSION(2) :: noce_array                             !: unused array but seems to be needed to prevent agrif from creating an empty module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: oce.F90 12489 2020-02-28 15:55:11Z davestorkey $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(6)
+      !!----------------------------------------------------------------------
+      !
+      ierr(:) = 0 
+      ALLOCATE( uu   (jpi,jpj,jpk,jpt)  , vv   (jpi,jpj,jpk,jpt) ,                              &          
+         &      ww   (jpi,jpj,jpk)      , hdiv(jpi,jpj,jpk)      ,                              &
+         &      ts   (jpi,jpj,jpk,jpts,jpt),                                                    &
+         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             &
+         &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE( ssh(jpi,jpj,jpt)  , uu_b(jpi,jpj,jpt) , vv_b(jpi,jpj,jpt) , &
+         &      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( fraqsr_1lev(jpi,jpj) , STAT=ierr(3) )
+         !
+      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
+         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), &
+         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), &
+         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(4) )
+         !
+      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj)      , STAT=ierr(6) )
+#if defined key_agrif
+      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(6) )
+#endif
+         !
+# if defined key_bvp
+      ALLOCATE(     rpo(jpi,jpj,jpk),    rpou(jpi,jpj,jpk),    rpov(jpi,jpj,jpk),    rpof(jpi,jpj,jpk),   &
+         &       r1_rpo(jpi,jpj,jpk), r1_rpou(jpi,jpj,jpk), r1_rpov(jpi,jpj,jpk), r1_rpof(jpi,jpj,jpk),   &
+         &         bmpt(jpi,jpj,jpk),    bmpu(jpi,jpj,jpk),    bmpv(jpi,jpj,jpk),            STAT=ierr(6) )                              
+#endif 
+         !
+      oce_alloc = MAXVAL( ierr )
+      IF( oce_alloc /= 0 )   CALL ctl_stop( 'STOP', 'oce_alloc: failed to allocate arrays' )
+      !
+   END FUNCTION oce_alloc
+
+   !!======================================================================
+END MODULE oce
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/step.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/step.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/step.F90	(revision 13562)
@@ -0,0 +1,359 @@
+MODULE step
+   !!======================================================================
+   !!                       ***  MODULE step  ***
+   !! Time-stepping   : manager of the shallow water equation time stepping
+   !!======================================================================
+   !! History :  NEMO !  2020-03  (A. Nasser, G. Madec)  Original code from  4.0.2
+   !!----------------------------------------------------------------------
+#if defined key_qco
+   !!----------------------------------------------------------------------
+   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate
+   !!----------------------------------------------------------------------
+#else
+   !!----------------------------------------------------------------------
+   !!   stp             : Shallow Water time-stepping
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules
+   USE phycst           ! physical constants
+   USE usrdef_nam
+   USE lib_mpp        ! MPP library
+   USE iom              ! xIOs server
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp   ! called by nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! time level indices
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC ::   Nbb, Nnn, Naa, Nrhs   !! used by nemo_init
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: step.F90 13154 2020-06-24 13:31:32Z gm $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_agrif
+   RECURSIVE SUBROUTINE stp( )
+      INTEGER             ::   kstp   ! ocean time-step index
+#else
+   SUBROUTINE stp( kstp )
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+#endif
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE stp  ***
+      !!
+      !! ** Purpose : - Time stepping of shallow water (SHW) (momentum and ssh eqs.)
+      !!
+      !! ** Method  : -1- Update forcings
+      !!              -2- Update the ssh at Naa
+      !!              -3- Compute the momentum trends (Nrhs)
+      !!              -4- Update the horizontal velocity
+      !!              -5- Apply Asselin time filter to uu,vv,ssh
+      !!              -6- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indice
+      INTEGER ::   indic        ! error indicator if < 0
+!!gm kcall can be removed, I guess
+      INTEGER ::   kcall        ! optional integer argument (dom_vvl_sf_nxt)
+      REAL(wp)::   z1_2rho0     ! local scalars
+
+      REAL(wp) ::   zue3a, zue3n, zue3b    ! local scalars
+      REAL(wp) ::   zve3a, zve3n, zve3b    !   -      -
+      REAL(wp) ::   ze3t_tf, ze3u_tf, ze3v_tf, zua, zva
+      REAL(wp), DIMENSION(jpi,jpj)    ::   zssh
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3u, ze3v
+      !! ---------------------------------------------------------------------
+#if defined key_agrif
+      kstp = nit000 + Agrif_Nb_Step()
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
+      IF( lk_agrif_debug ) THEN
+         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---'
+         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint()
+      ENDIF
+      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE.
+# if defined key_iomput
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
+# endif
+#endif
+      !
+      IF( ln_timing )   CALL timing_start('stp')
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! model timestep
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      IF( l_1st_euler ) THEN     ! start or restart with Euler 1st time-step
+         rDt   =  rn_Dt
+         r1_Dt = 1._wp / rDt
+      ENDIF
+
+      IF ( kstp == nit000 )   ww(:,:,:) = 0._wp   ! initialize vertical velocity one for all to zero
+
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! update I/O and calendar
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             indic = 0                ! reset to no error condition
+
+      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS)
+                             CALL iom_init( cxios_context, ld_closedef=.FALSE. )   ! for model grid (including passible AGRIF zoom)
+         IF( lk_diamlr   )   CALL dia_mlr_iom_init    ! with additional setup for multiple-linear-regression analysis
+                             CALL iom_init_closedef
+         IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid
+      ENDIF
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell IOM we are at time step kstp
+      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell IOM we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update external forcing (tides, open boundaries, ice shelf interaction and surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_tide    )   CALL tide_update( kstp )                     ! update tide potential
+      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                        ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)
+      IF( ln_bdy     )   CALL bdy_dta ( kstp, Nnn )                   ! update dynamic & tracer data at open boundaries
+                         CALL sbc     ( kstp, Nbb, Nnn )              ! Sea Boundary Condition
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !  LATERAL  PHYSICS
+      !                                                                        ! eddy diffusivity coeff.
+      IF( l_ldfdyn_time )   CALL ldf_dyn( kstp, Nbb )                          ! eddy viscosity coeff.
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Ocean dynamics : hdiv, ssh, e3, u, v, w
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )    ! after ssh (includes call to div_hor)
+                         uu(:,:,:,Nrhs) = 0._wp            ! set dynamics trends to zero
+                         vv(:,:,:,Nrhs) = 0._wp
+
+      IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors
+
+      IF( ln_bdy     )      CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends
+
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())  &
+               &            CALL Agrif_Sponge_dyn        ! momentum sponge
+#endif
+
+!!an - calcul du gradient de pression horizontal (explicit)
+      zssh(:,:) = ssh(:,:,Nnn)
+# if defined key_bvp
+      !   gradient and divergence not penalised
+      zssh(:,:) = zssh(:,:) * r1_rpo(:,:,1)
+#endif
+      DO_3D_00_00( 1, jpkm1 )
+         uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - grav * ( zssh(ji+1,jj) - zssh(ji,jj) ) * r1_e1u(ji,jj)
+         vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - grav * ( zssh(ji,jj+1) - zssh(ji,jj) ) * r1_e2v(ji,jj)
+      END_3D
+      !
+!      IF( kstp == nit000 .AND. lwp ) THEN
+!         WRITE(numout,*)
+!         WRITE(numout,*) 'step.F90 : classic script used'
+!         WRITE(numout,*) '~~~~~~~'
+!         IF(       ln_dynvor_ens_adVO .OR. ln_dynvor_ens_adKE .OR. ln_dynvor_ens_adKEVO   &
+!         &    .OR. ln_dynvor_ene_adVO .OR. ln_dynvor_ene_adKE .OR. ln_dynvor_ene_adKEVO   ) THEN
+!            CALL ctl_stop('STOP','step : alternative direction asked but classis step'  )
+!         ENDIF
+!      ENDIF
+!!an
+!                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)	==> RHS
+!
+!                         CALL dyn_vor( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! vorticity           	==> RHS
+!
+!!an     In dynvor, dynkegAD is called even if not AD, so we keep the same step.F90
+
+                         CALL dyn_vor( kstp, Nbb, Nnn      , uu, vv, Nrhs)  ! vorticity           	==> RHS
+
+                         CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing
+
+      ! add wind stress forcing and layer linear friction to the RHS
+      ze3u(:,:,:) = e3u(:,:,:,Nnn)
+      ze3v(:,:,:) = e3v(:,:,:,Nnn)
+# if defined key_bvp
+      !ze3u(:,:,:) = ze3u(:,:,:) * r1_rpo(:,:,:)
+      !ze3v(:,:,:) = ze3v(:,:,:) * r1_rpo(:,:,:)
+#endif
+      z1_2rho0 = 0.5_wp * r1_rho0
+      DO_3D_00_00(1,jpkm1)
+         uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / ze3u(ji,jj,jk)   &
+            &                                  - rn_rfr * uu(ji,jj,jk,Nbb)
+         vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) + z1_2rho0 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ze3v(ji,jj,jk)   &
+            &                                  - rn_rfr * vv(ji,jj,jk,Nbb)
+      END_3D
+      !
+# if defined key_bvp
+      !  Add frictionnal term   - sigma * u
+      ! can be done via sigmaT (mean_ij)
+      DO_3D_00_00(1,jpkm1)
+         uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - bmpu(ji,jj,jk) * uu(ji,jj,jk,Nbb)
+         vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - bmpv(ji,jj,jk) * vv(ji,jj,jk,Nbb)
+      END_3D
+#endif
+      !
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Leap-Frog time splitting + Robert-Asselin time filter on u,v,e3
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+!! what about  IF( .NOT.ln_linssh )  ?
+!!an futur module dyn_nxt (a la place de dyn_atf)
+
+      IF( ln_dynadv_vec ) THEN      ! vector invariant form : applied on velocity
+         IF( l_1st_euler ) THEN           ! Euler time stepping (no Asselin filter)
+            DO_3D_00_00(1,jpkm1)
+               uu(ji,jj,jk,Naa) = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               vv(ji,jj,jk,Naa) = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+             END_3D
+         ELSE                             ! Leap Frog time stepping + Asselin filter
+            DO_3D_11_11(1,jpkm1)
+               zua = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               zva = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+               !                                                                  ! Asselin time filter on u,v (Nnn)
+               uu(ji,jj,jk,Nnn) = uu(ji,jj,jk,Nnn) + rn_atfp * (uu(ji,jj,jk,Nbb) - 2._wp * uu(ji,jj,jk,Nnn) + zua)
+               vv(ji,jj,jk,Nnn) = vv(ji,jj,jk,Nnn) + rn_atfp * (vv(ji,jj,jk,Nbb) - 2._wp * vv(ji,jj,jk,Nnn) + zva)
+               !
+               ze3u_tf = e3u(ji,jj,jk,Nnn) + rn_atfp * ( e3u(ji,jj,jk,Nbb) - 2._wp * e3u(ji,jj,jk,Nnn)  + e3u(ji,jj,jk,Naa) )
+               ze3v_tf = e3v(ji,jj,jk,Nnn) + rn_atfp * ( e3v(ji,jj,jk,Nbb) - 2._wp * e3v(ji,jj,jk,Nnn)  + e3v(ji,jj,jk,Naa) )
+               ze3t_tf = e3t(ji,jj,jk,Nnn) + rn_atfp * ( e3t(ji,jj,jk,Nbb) - 2._wp * e3t(ji,jj,jk,Nnn)  + e3t(ji,jj,jk,Naa) )
+               !
+               e3u(ji,jj,jk,Nnn) = ze3u_tf
+               e3v(ji,jj,jk,Nnn) = ze3v_tf
+               e3t(ji,jj,jk,Nnn) = ze3t_tf
+               !
+               uu(ji,jj,jk,Naa) = zua
+               vv(ji,jj,jk,Naa) = zva
+            END_3D
+         ENDIF
+         !
+      ELSE                          ! flux form : applied on thickness weighted velocity
+         IF( l_1st_euler ) THEN           ! Euler time stepping (no Asselin filter)
+            DO_3D_00_00(1,jpkm1)
+               zue3b = e3u(ji,jj,jk,Nbb) * uu(ji,jj,jk,Nbb)
+               zve3b = e3v(ji,jj,jk,Nbb) * vv(ji,jj,jk,Nbb)
+               !                                                ! LF time stepping
+               zue3a = zue3b + rDt * e3u(ji,jj,jk,Nrhs) * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               zve3a = zve3b + rDt * e3v(ji,jj,jk,Nrhs) * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+               !
+               uu(ji,jj,jk,Naa) = zue3a / e3u(ji,jj,jk,Naa)
+               vv(ji,jj,jk,Naa) = zve3a / e3v(ji,jj,jk,Naa)
+            END_3D
+         ELSE                             ! Leap Frog time stepping + Asselin filter
+            DO_3D_11_11(1,jpkm1)
+               zue3n = e3u(ji,jj,jk,Nnn) * uu(ji,jj,jk,Nnn)
+               zve3n = e3v(ji,jj,jk,Nnn) * vv(ji,jj,jk,Nnn)
+               zue3b = e3u(ji,jj,jk,Nbb) * uu(ji,jj,jk,Nbb)
+               zve3b = e3v(ji,jj,jk,Nbb) * vv(ji,jj,jk,Nbb)
+               !                                                ! LF time stepping
+               zue3a = zue3b + rDt * e3u(ji,jj,jk,Nrhs) * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               zve3a = zve3b + rDt * e3v(ji,jj,jk,Nrhs) * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+               !                                                ! Asselin time filter on e3u/v/t
+               ze3u_tf = e3u(ji,jj,jk,Nnn) + rn_atfp * ( e3u(ji,jj,jk,Nbb) - 2._wp * e3u(ji,jj,jk,Nnn)  + e3u(ji,jj,jk,Naa) )
+               ze3v_tf = e3v(ji,jj,jk,Nnn) + rn_atfp * ( e3v(ji,jj,jk,Nbb) - 2._wp * e3v(ji,jj,jk,Nnn)  + e3v(ji,jj,jk,Naa) )
+               ze3t_tf = e3t(ji,jj,jk,Nnn) + rn_atfp * ( e3t(ji,jj,jk,Nbb) - 2._wp * e3t(ji,jj,jk,Nnn)  + e3t(ji,jj,jk,Naa) )
+               !                                                ! Asselin time filter on u,v (Nnn)
+               uu(ji,jj,jk,Nnn) = ( zue3n + rn_atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_tf
+               vv(ji,jj,jk,Nnn) = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_tf
+               !
+               e3u(ji,jj,jk,Nnn) = ze3u_tf
+               e3v(ji,jj,jk,Nnn) = ze3v_tf
+               e3t(ji,jj,jk,Nnn) = ze3t_tf
+               !
+               uu(ji,jj,jk,Naa) = zue3a / e3u(ji,jj,jk,Naa)
+               vv(ji,jj,jk,Naa) = zve3a / e3v(ji,jj,jk,Naa)
+            END_3D
+         ENDIF
+      ENDIF
+
+
+      CALL lbc_lnk_multi( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.,   &   !* local domain boundaries
+         &                       uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1.    )
+
+!!an
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Set boundary conditions, time filter and swap time levels
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+!!an TO BE ADDED : dyn_nxt
+!!                         CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" velocities and scale factors
+!!an TO BE ADDED : a simplifier
+!!                         CALL ssh_atf       ( kstp, Nbb, Nnn, Naa, ssh )                     ! time filtering of "now" sea surface height
+      IF ( .NOT.( l_1st_euler ) ) THEN   ! Only do time filtering for leapfrog timesteps
+         !                                                  ! filtering "now" field
+         ssh(:,:,Nnn) = ssh(:,:,Nnn) + rn_atfp * ( ssh(:,:,Nbb) - 2 * ssh(:,:,Nnn) + ssh(:,:,Naa) )
+      ENDIF
+!!an
+
+
+      ! Swap time levels
+      Nrhs = Nbb
+      Nbb = Nnn
+      Nnn = Naa
+      Naa = Nrhs
+      !
+                         CALL dom_vvl_sf_update( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_floats  )   CALL flo_stp   ( kstp, Nbb, Nnn )      ! drifting Floats
+      IF( ln_diacfl  )   CALL dia_cfl   ( kstp,      Nnn )      ! Courant number diagnostics
+
+                         CALL dia_wri   ( kstp,      Nnn )      ! ocean model: outputs
+      !
+      IF( lrst_oce   )   CALL rst_write    ( kstp, Nbb, Nnn )   ! write output ocean restart file
+
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs      ! agrif_oce module copies of time level indices
+                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating
+
+                         IF( Agrif_NbStepint() == 0 ) THEN
+                            CALL Agrif_update_all( )                  ! Update all components
+                         ENDIF
+#endif
+      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL stp_ctl      ( kstp, Nbb, Nnn, indic )
+
+
+      IF( kstp == nit000 ) THEN                          ! 1st time step only
+                                        CALL iom_close( numror )   ! close input  ocean restart file
+         IF(lwm)                        CALL FLUSH    ( numond )   ! flush output namelist oce
+         IF(lwm .AND. numoni /= -1 )    CALL FLUSH    ( numoni )   ! flush output namelist ice (if exist)
+      ENDIF
+
+      !
+#if defined key_iomput
+      IF( kstp == nitend .OR. indic < 0 ) THEN
+                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF
+                      IF(lrxios) CALL iom_context_finalize(      crxios_context          )
+      ENDIF
+#endif
+      !
+      IF( l_1st_euler ) THEN         ! recover Leap-frog timestep
+         rDt = 2._wp * rn_Dt
+         r1_Dt = 1._wp / rDt
+         l_1st_euler = .FALSE.
+      ENDIF
+      !
+      IF( ln_timing )   CALL timing_stop('stp')
+      !
+   END SUBROUTINE stp
+#endif
+   !
+   !!======================================================================
+END MODULE step
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/stepLF.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/stepLF.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/stepLF.F90	(revision 13562)
@@ -0,0 +1,352 @@
+MODULE stpLF
+   !!======================================================================
+   !!                       ***  MODULE step  ***
+   !! Time-stepping   : manager of the shallow water equation time stepping
+   !!======================================================================
+   !! History :  NEMO !  2020-03  (A. Nasser, G. Madec)  Original code from  4.0.2
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp             : Shallow Water time-stepping
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules
+   USE phycst           ! physical constants
+   USE usrdef_nam
+   !
+   USE iom              ! xIOs server 
+   USE domqco
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp_LF   ! called by nemogcm.F90
+   
+   !!----------------------------------------------------------------------
+   !! time level indices
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC ::   Nbb, Nnn, Naa, Nrhs   !! used by nemo_init
+      
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: step.F90 12614 2020-03-26 14:59:52Z gm $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_agrif
+   RECURSIVE SUBROUTINE stp_LF( )
+      INTEGER             ::   kstp   ! ocean time-step index
+#else
+   SUBROUTINE stp_LF( kstp )
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+#endif
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE stp  ***
+      !!
+      !! ** Purpose : - Time stepping of shallow water (SHW) (momentum and ssh eqs.)
+      !!
+      !! ** Method  : -1- Update forcings
+      !!              -2- Update the ssh at Naa
+      !!              -3- Compute the momentum trends (Nrhs)
+      !!              -4- Update the horizontal velocity
+      !!              -5- Apply Asselin time filter to uu,vv,ssh
+      !!              -6- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indice
+      INTEGER ::   indic        ! error indicator if < 0
+!!gm kcall can be removed, I guess
+      INTEGER ::   kcall        ! optional integer argument (dom_vvl_sf_nxt)
+      REAL(wp)::   z1_2rho0     ! local scalars
+      
+      REAL(wp) ::   zue3a, zue3n, zue3b    ! local scalars
+      REAL(wp) ::   zve3a, zve3n, zve3b    !   -      -
+      REAL(wp) ::   ze3t_tf, ze3u_tf, ze3v_tf, zua, zva
+      !
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3du, z3dv   
+      !! ---------------------------------------------------------------------
+#if defined key_agrif
+      kstp = nit000 + Agrif_Nb_Step()
+      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
+      IF( lk_agrif_debug ) THEN
+         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---'
+         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint()
+      ENDIF
+      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE.
+# if defined key_iomput
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
+# endif
+#endif
+      !
+      IF( ln_timing )   CALL timing_start('stp_LF')
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! model timestep
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      IF( l_1st_euler ) THEN     ! start or restart with Euler 1st time-step
+         rDt   =  rn_Dt   
+         r1_Dt = 1._wp / rDt
+      ENDIF
+
+      IF ( kstp == nit000 )   ww(:,:,:) = 0._wp   ! initialize vertical velocity one for all to zero
+
+      !
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! update I/O and calendar 
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             indic = 0                ! reset to no error condition
+                             
+      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS)
+                             CALL iom_init( cxios_context, ld_closedef=.FALSE. )   ! for model grid (including passible AGRIF zoom)
+         IF( lk_diamlr   )   CALL dia_mlr_iom_init    ! with additional setup for multiple-linear-regression analysis
+                             CALL iom_init_closedef
+         IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid
+      ENDIF
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell IOM we are at time step kstp
+      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell IOM we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update external forcing (tides, open boundaries, ice shelf interaction and surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_tide    )   CALL tide_update( kstp )                     ! update tide potential
+      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                        ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
+      IF( ln_bdy     )   CALL bdy_dta ( kstp, Nnn )                   ! update dynamic & tracer data at open boundaries
+                         CALL sbc     ( kstp, Nbb, Nnn )              ! Sea Boundary Condition
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !  LATERAL  PHYSICS
+      !                                                                        ! eddy diffusivity coeff.
+      IF( l_ldfdyn_time )   CALL ldf_dyn( kstp, Nbb )                          ! eddy viscosity coeff. 
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Ocean dynamics : hdiv, ssh, e3, u, v, w
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )    ! after ssh (includes call to div_hor)
+                         uu(:,:,:,Nrhs) = 0._wp            ! set dynamics trends to zero
+                         vv(:,:,:,Nrhs) = 0._wp
+
+      IF( ln_bdy     )      CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends
+
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())  & 
+               &            CALL Agrif_Sponge_dyn        ! momentum sponge
+#endif
+!!                            CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)	==> RHS
+ 
+                            CALL dyn_vor( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! vorticity           	==> RHS
+ 
+                            CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing
+
+      IF( .NOT.ln_linssh )  CALL dom_qco_r3c   ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )   ! "after" ssh./h._0 ratio explicit
+      !IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt_st( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
+      !
+      DO_2D_00_00
+         z2d(ji,jj) = ssh(ji,jj,Nnn)
+      END_2D
+# if defined key_bvp
+      z2d(:,:) = z2d(:,:) * r1_rpo(:,:,1)  
+#endif
+!!an - calcul du gradient de pression horizontal (explicit)
+      DO_3D_00_00( 1, jpkm1 )
+         uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) - grav * ( z2d(ji+1,jj) - z2d(ji,jj) ) * r1_e1u(ji,jj)
+         vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) - grav * ( z2d(ji,jj+1) - z2d(ji,jj) ) * r1_e2v(ji,jj)
+      END_3D
+      !
+      DO_3D_00_00( 1, jpkm1 )
+         z3du(ji,jj,jk) = e3u(ji,jj,jk,Nnn)
+         z3dv(ji,jj,jk) = e3v(ji,jj,jk,Nnn)
+      END_3D
+! # if defined key_bvp
+!       z3du(:,:,:) = z3du(:,:,:) * r1_rpou(:,:,:)  
+!       z3dv(:,:,:) = z3dv(:,:,:) * r1_rpov(:,:,:)  
+! #endif
+      ! add wind stress forcing and layer linear friction to the RHS 
+      z1_2rho0 = 0.5_wp * r1_rho0
+      DO_3D_00_00(1,jpkm1)
+         uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / z3du(ji,jj,jk)   &
+            &                                  - rn_rfr * uu(ji,jj,jk,Nbb)
+         vv(ji,jj,jk,Nrhs) = vv(ji,jj,jk,Nrhs) + z1_2rho0 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / z3dv(ji,jj,jk)   &
+            &                                  - rn_rfr * vv(ji,jj,jk,Nbb)
+      END_3D   
+  
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Leap-Frog time splitting + Robert-Asselin time filter on u,v,e3 
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!st ssh_atf : add ssh filtering up there
+      IF ( .NOT.( l_1st_euler ) ) THEN   ! Only do time filtering for leapfrog timesteps
+         !                                                  ! filtering "now" field
+         ssh(:,:,Nnn) = ssh(:,:,Nnn) + rn_atfp * ( ssh(:,:,Nbb) - 2._wp * ssh(:,:,Nnn) + ssh(:,:,Naa) )
+      ENDIF
+!!st ssh_atf
+          
+!! what about  IF( .NOT.ln_linssh )  ?
+!!an futur module dyn_nxt (a la place de dyn_atf)
+      
+      IF( ln_dynadv_vec ) THEN      ! vector invariant form : applied on velocity
+         IF( l_1st_euler ) THEN           ! Euler time stepping (no Asselin filter)
+            DO_3D_00_00(1,jpkm1)
+               uu(ji,jj,jk,Naa) = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               vv(ji,jj,jk,Naa) = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+             END_3D          
+         ELSE                             ! Leap Frog time stepping + Asselin filter         
+            DO_3D_11_11(1,jpkm1)
+               zua = uu(ji,jj,jk,Nbb) + rDt * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               zva = vv(ji,jj,jk,Nbb) + rDt * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+               !                                                                  ! Asselin time filter on u,v (Nnn)
+               uu(ji,jj,jk,Nnn) = uu(ji,jj,jk,Nnn) + rn_atfp * (uu(ji,jj,jk,Nbb) - 2._wp * uu(ji,jj,jk,Nnn) + zua)
+               vv(ji,jj,jk,Nnn) = vv(ji,jj,jk,Nnn) + rn_atfp * (vv(ji,jj,jk,Nbb) - 2._wp * vv(ji,jj,jk,Nnn) + zva)
+               !              
+               uu(ji,jj,jk,Naa) = zua
+               vv(ji,jj,jk,Naa) = zva
+            END_3D
+            CALL dom_qco_r3c( ssh(:,:,Nnn), r3t(:,:,Nnn), r3u(:,:,Nnn), r3v(:,:,Nnn) )   ! "now" ssh/h_0 ratio from filtrered ssh
+#if ! defined key_qco
+            DO jk = 1, jpkm1
+               e3t(:,:,jk,Nnn) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Nnn) )
+               e3u(:,:,jk,Nnn) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Nnn) )
+               e3v(:,:,jk,Nnn) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Nnn) )
+            END DO
+#endif
+         ENDIF
+         !
+      ELSE                          ! flux form : applied on thickness weighted velocity
+         IF( l_1st_euler ) THEN           ! Euler time stepping (no Asselin filter)
+            DO_3D_00_00(1,jpkm1)
+               zue3b = e3u(ji,jj,jk,Nbb) * uu(ji,jj,jk,Nbb)
+               zve3b = e3v(ji,jj,jk,Nbb) * vv(ji,jj,jk,Nbb)
+               !                                                ! LF time stepping
+               zue3a = zue3b + rDt * e3u(ji,jj,jk,Nrhs) * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               zve3a = zve3b + rDt * e3v(ji,jj,jk,Nrhs) * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+               !
+               uu(ji,jj,jk,Naa) = zue3a / e3u(ji,jj,jk,Naa)    
+               vv(ji,jj,jk,Naa) = zve3a / e3v(ji,jj,jk,Naa)
+            END_3D
+         ELSE                             ! Leap Frog time stepping + Asselin filter
+            CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f(:,:), r3u_f(:,:), r3v_f(:,:) )   ! "now" ssh/h_0 ratio from filtrered ssh
+            DO_3D_11_11(1,jpkm1)
+               zue3n = e3u(ji,jj,jk,Nnn) * uu(ji,jj,jk,Nnn)
+               zve3n = e3v(ji,jj,jk,Nnn) * vv(ji,jj,jk,Nnn)
+               zue3b = e3u(ji,jj,jk,Nbb) * uu(ji,jj,jk,Nbb)
+               zve3b = e3v(ji,jj,jk,Nbb) * vv(ji,jj,jk,Nbb)
+               !                                                ! LF time stepping
+               zue3a = zue3b + rDt * e3u(ji,jj,jk,Nrhs) * uu(ji,jj,jk,Nrhs) * umask(ji,jj,jk)
+               zve3a = zve3b + rDt * e3v(ji,jj,jk,Nrhs) * vv(ji,jj,jk,Nrhs) * vmask(ji,jj,jk)
+               !                                                ! Asselin time filter on e3u/v/t
+               ze3u_tf = e3u(ji,jj,jk,Nnn) + rn_atfp * ( e3u(ji,jj,jk,Nbb) - 2._wp * e3u(ji,jj,jk,Nnn)  + e3u(ji,jj,jk,Naa) ) 
+               ze3v_tf = e3v(ji,jj,jk,Nnn) + rn_atfp * ( e3v(ji,jj,jk,Nbb) - 2._wp * e3v(ji,jj,jk,Nnn)  + e3v(ji,jj,jk,Naa) )
+               ze3t_tf = e3t(ji,jj,jk,Nnn) + rn_atfp * ( e3t(ji,jj,jk,Nbb) - 2._wp * e3t(ji,jj,jk,Nnn)  + e3t(ji,jj,jk,Naa) ) 
+               !                                                ! Asselin time filter on u,v (Nnn)
+               uu(ji,jj,jk,Nnn) = ( zue3n + rn_atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / (e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) ))
+               vv(ji,jj,jk,Nnn) = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / (e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) ))
+               !
+               uu(ji,jj,jk,Naa) = zue3a / e3u(ji,jj,jk,Naa)    
+               vv(ji,jj,jk,Naa) = zve3a / e3v(ji,jj,jk,Naa)
+            END_3D
+            r3t(:,:,Nnn) = r3t_f(:,:)
+            r3u(:,:,Nnn) = r3u_f(:,:)
+            r3v(:,:,Nnn) = r3v_f(:,:)
+#if ! defined key_qco
+            DO jk = 1, jpkm1
+               e3t(:,:,jk,Nnn) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Nnn) )
+               e3u(:,:,jk,Nnn) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Nnn) )
+               e3v(:,:,jk,Nnn) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Nnn) )
+            END DO
+#endif         
+         ENDIF
+      ENDIF
+
+
+      CALL lbc_lnk_multi( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.,   &   !* local domain boundaries
+         &                       uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1.    )     
+
+!!an         
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Set boundary conditions, time filter and swap time levels
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+!!an TO BE ADDED : dyn_nxt
+!!                         CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" velocities and scale factors
+!!an TO BE ADDED : a simplifier
+!                         CALL ssh_atf       ( kstp, Nbb, Nnn, Naa, ssh )                     ! time filtering of "now" sea surface height
+!!st copied above 
+!!      IF ( .NOT.( l_1st_euler ) ) THEN   ! Only do time filtering for leapfrog timesteps
+!!         !                                                  ! filtering "now" field
+!!         ssh(:,:,Nnn) = ssh(:,:,Nnn) + rn_atfp * ( ssh(:,:,Nbb) - 2 * ssh(:,:,Nnn) + ssh(:,:,Naa) )
+!!      ENDIF
+!!st      
+!!an 
+
+
+      ! Swap time levels
+      Nrhs = Nbb
+      Nbb = Nnn
+      Nnn = Naa
+      Naa = Nrhs
+      !
+!                         CALL dom_vvl_sf_update_st( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_floats  )   CALL flo_stp   ( kstp, Nbb, Nnn )      ! drifting Floats
+      IF( ln_diacfl  )   CALL dia_cfl   ( kstp,      Nnn )      ! Courant number diagnostics
+    
+                         CALL dia_wri   ( kstp,      Nnn )      ! ocean model: outputs
+
+      !
+      IF( lrst_oce   )   CALL rst_write    ( kstp, Nbb, Nnn )   ! write output ocean restart file
+          
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+                         Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs      ! agrif_oce module copies of time level indices
+                         CALL Agrif_Integrate_ChildGrids( stp_LF )       ! allows to finish all the Child Grids before updating
+
+                         IF( Agrif_NbStepint() == 0 ) THEN
+                            CALL Agrif_update_all( )                  ! Update all components
+                         ENDIF
+#endif
+      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL stp_ctl      ( kstp, Nbb, Nnn, indic )
+               
+                         
+      IF( kstp == nit000 ) THEN                          ! 1st time step only
+                                        CALL iom_close( numror )   ! close input  ocean restart file
+         IF(lwm)                        CALL FLUSH    ( numond )   ! flush output namelist oce
+         IF(lwm .AND. numoni /= -1 )    CALL FLUSH    ( numoni )   ! flush output namelist ice (if exist)
+      ENDIF
+
+      !
+#if defined key_iomput
+      IF( kstp == nitend .OR. indic < 0 ) THEN 
+                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF
+                      IF(lrxios) CALL iom_context_finalize(      crxios_context          )
+      ENDIF
+#endif
+      !
+      IF( l_1st_euler ) THEN         ! recover Leap-frog timestep
+         rDt = 2._wp * rn_Dt   
+         r1_Dt = 1._wp / rDt
+         l_1st_euler = .FALSE.      
+      ENDIF
+      !
+      IF( ln_timing )   CALL timing_stop('stp')
+      !
+   END SUBROUTINE stp_LF
+   !
+   !!======================================================================
+END MODULE stpLF
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_fmask.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_fmask.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_fmask.F90	(revision 13562)
@@ -0,0 +1,148 @@
+MODULE usrdef_fmask
+   !!======================================================================
+   !!                     ***  MODULE usrdef_fmask   ***
+   !!
+   !!                      ===  ORCA configuration  ===
+   !!                            (2 and 1 degrees)
+   !!
+   !! User defined : alteration of land/sea f-point mask in some straits
+   !!======================================================================
+   !! History :  4.0  ! 2016-06  (G. Madec, S. Flavoni)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_fmask  : alteration of f-point land/ocean mask in some straits
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! Massively Parallel Processing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_fmask    ! routine called by dommsk.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: usrdef_fmask.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_fmask( cd_cfg, kcfg, pfmsk )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   User defined alteration of the lateral boundary 
+      !!              condition on velocity.
+      !!
+      !! ** Method  :   Local change of the value of fmask at lateral ocean/land 
+      !!              boundary in straits in order to increase the viscous 
+      !!              boundary layer and thus reduce the transport through the 
+      !!              corresponding straits.
+      !!                Here only alterations in ORCA R2 and R1 cases
+      !!
+      !! ** Action :   fmask : land/ocean mask at f-point with increased value 
+      !!                       in some user defined straits
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)          , INTENT(in   ) ::   cd_cfg   ! configuration name
+      INTEGER                   , INTENT(in   ) ::   kcfg     ! configuration identifier 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pfmsk    ! Ocean/Land f-point mask including lateral boundary cond.
+      !
+      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
+      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
+      INTEGER  ::   isrow                    ! index for ORCA1 starting row
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM( cd_cfg ) == "orca" ) THEN      !==  ORCA Configurations  ==!
+         !
+         SELECT CASE ( kcfg )
+         !
+         CASE( 2 )                           !  R2 case
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R2: increase lateral friction near the following straits:'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+            !
+            IF(lwp) WRITE(numout,*) '      Gibraltar '
+            ij0 = 101   ;   ij1 = 101           ! Gibraltar strait  : partial slip (pfmsk=0.5)
+            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+            ij0 = 102   ;   ij1 = 102
+            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+            !
+            IF(lwp) WRITE(numout,*) '      Bab el Mandeb '
+            ij0 =  87   ;   ij1 =  88           ! Bab el Mandeb : partial slip (pfmsk=1)
+            ii0 = 160   ;   ii1 = 160   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+            ij0 =  88   ;   ij1 =  88
+            ii0 = 159   ;   ii1 = 159   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+            !
+            ! We keep this as an example but it is instable in this case 
+            !IF(lwp) WRITE(numout,*) '      Danish straits '
+            !         ij0 = 115   ;   ij1 = 115 ! Danish straits  : strong slip (pfmsk > 2)
+            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+            !         ij0 = 116   ;   ij1 = 116
+            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+            !
+         CASE( 1 )                           ! R1 case
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R1: increase lateral friction near the following straits:'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
+!!gm    ! This dirty section will be suppressed by simplification process:
+!!gm    ! all this will come back in input files
+!!gm    ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332)
+            !
+            isrow = 332 - jpjglo
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
+            IF(lwp) WRITE(numout,*) '      Gibraltar '
+            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait 
+            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Bhosporus '
+            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait 
+            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Makassar (Top) '
+            ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top) 
+            ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Lombok '
+            ii0 =  44           ;   ii1 =  44        ! Lombok Strait 
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Ombai '
+            ii0 =  53           ;   ii1 =  53        ! Ombai Strait 
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Timor Passage '
+            ii0 =  56           ;   ii1 =  56        ! Timor Passage 
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      West Halmahera '
+            ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait 
+            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      East Halmahera '
+            ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait 
+            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+            !
+         CASE DEFAULT
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R', kcfg,' : NO alteration of fmask in specific straits '
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
+         END SELECT
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'usr_def_fmask : NO alteration of fmask in specific straits '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !
+      CALL lbc_lnk( 'usrdef_fmask', pfmsk, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+      !
+   END SUBROUTINE usr_def_fmask
+   
+   !!======================================================================
+END MODULE usrdef_fmask
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_hgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_hgr.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_hgr.F90	(revision 13562)
@@ -0,0 +1,158 @@
+MODULE usrdef_hgr
+   !!======================================================================
+   !!                     ***  MODULE usrdef_hgr   ***
+   !!
+   !!                     ===  AM98 configuration  ===
+   !!
+   !! User defined :   mesh and Coriolis parameter of a user configuration
+   !!======================================================================
+   !! History :  4.0 ! 2016-03  (S. Flavoni)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_hgr   : initialize the horizontal mesh
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE usrdef_nam     !
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_hgr   ! called in domhgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: usrdef_hgr.F90 10069 2018-08-28 14:12:24Z nicolasmartin $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_hgr( plamt , plamu , plamv  , plamf  ,   &   ! geographic position (required)
+      &                    pphit , pphiu , pphiv  , pphif  ,   &   !
+      &                    kff   , pff_f , pff_t  ,            &   ! Coriolis parameter  (if domain not on the sphere)
+      &                    pe1t  , pe1u  , pe1v   , pe1f   ,   &   ! scale factors       (required)
+      &                    pe2t  , pe2u  , pe2v   , pe2f   ,   &   !
+      &                    ke1e2u_v      , pe1e2u , pe1e2v     )   ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE usr_def_hgr  ***
+      !!
+      !! ** Purpose :   user defined mesh and Coriolis parameter
+      !!
+      !! ** Method  :   set all intent(out) argument to a proper value
+      !!
+      !!                Here AM98 configuration :
+      !!          Rectangular mid-latitude domain
+      !!          - with axes rotated by 45 degrees
+      !!          - a constant horizontal resolution of 106 km
+      !!          - on a beta-plane
+      !!
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees)
+      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees]
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m]
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zlam1, zlam0, zcos_theta, zim1 , zjm1 , ze1  , ze1deg ! local scalars
+      REAL(wp) ::   zphi1, zphi0, zsin_theta, zim05, zjm05, znorme        !   -      -
+      REAL(wp) ::   zgl, zbl, z1d      !   -      -
+
+      !!-------------------------------------------------------------------------------
+      !
+      !     !==  beta-plane with regular grid-spacing and rotated domain ==!  (AM98 configuration)
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_hgr : AM98 configuration (beta-plane with rotated regular grid-spacing)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      !                       !==  grid point position  ==!
+      !
+      ze1 =  rn_dx / REAL(nn_AM98, wp)                   ! [m] gridspacing used
+      zgl =  rn_domsiz + 2._wp * REAL(nn_gc, wp) * ze1   ! [m] length of the square with ghostcells
+      ! fit the best square around the square + ghost cells
+      zbl = zgl * ( COS( rn_theta * rad ) + SIN( rn_theta * rad ) )   ! length side bigger domain [m]
+      !
+      zcos_theta = COS( rn_theta * rad)
+      zsin_theta = SIN( rn_theta * rad)
+      ! Translation vers le coin bas-gauche du carré tourné
+      zlam1 =  zbl * COS((rn_theta + 45. )* rad ) / SQRT( 2._wp ) - rn_domsiz/2._wp
+      zphi1 =  zbl * SIN((rn_theta + 45. )* rad ) / SQRT( 2._wp ) - rn_domsiz/2._wp
+      ! select the nearest integer coordonate point
+      zlam0 = REAL( anint( zlam1 / (ze1 * zcos_theta)  ), wp ) * ze1 * zcos_theta
+      zphi0 = REAl( anint( zphi1 / (ze1 * zcos_theta)  ), wp ) * ze1 * zcos_theta
+      !
+      ! zlam0 = REAL( anint( zlam1 / ze1 ), wp ) * ze1
+      ! zphi0 = REAl( anint( zphi1 / ze1 ), wp ) * ze1
+      !
+      IF(lwp) WRITE(numout,*) '                           origin position    zlam0   = ', zlam0/1000,   ' km'
+      IF(lwp) WRITE(numout,*) '                           origin position    zphi0   = ', zphi0/1000,   ' km'
+      ! O1M = OM x rotation_theta - OO1
+      ! zim1, zim05, zjm1, zjm05 fit for 2 ghost cells on each side
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zim1 = REAL( ji + nimpp - 1 )   ;   zim05 = REAL( ji + nimpp - 1 ) - 0.5
+            zjm1 = REAL( jj + njmpp - 1 )   ;   zjm05 = REAL( jj + njmpp - 1 ) - 0.5
+            !
+            !glamt(i,j) position (meters) at T-point
+            !gphit(i,j) position (meters) at T-point
+            plamt(ji,jj) =   zim05 * ze1 * zcos_theta - zjm05 * ze1 * zsin_theta - zlam0
+            pphit(ji,jj) = + zim05 * ze1 * zsin_theta + zjm05 * ze1 * zcos_theta - zphi0
+            !
+            !glamu(i,j) position (meters) at U-point
+            !gphiu(i,j) position (meters) at U-point
+            plamu(ji,jj) =   zim1  * ze1 * zcos_theta - zjm05 * ze1 * zsin_theta - zlam0
+            pphiu(ji,jj) = + zim1  * ze1 * zsin_theta + zjm05 * ze1 * zcos_theta - zphi0
+            !
+            !glamv(i,j) position (meters) at V-point
+            !gphiv(i,j) position (meters) at V-point
+            plamv(ji,jj) =   zim05 * ze1 * zcos_theta - zjm1  * ze1 * zsin_theta - zlam0
+            pphiv(ji,jj) = + zim05 * ze1 * zsin_theta + zjm1  * ze1 * zcos_theta - zphi0
+            !
+            !glamf(i,j) position (meters) at F-point
+            !gphif(i,j) position (meters) at F-point
+            plamf(ji,jj) =   zim1  * ze1 * zcos_theta - zjm1  * ze1 * zsin_theta - zlam0
+            pphif(ji,jj) = + zim1  * ze1 * zsin_theta + zjm1  * ze1 * zcos_theta - zphi0
+         END DO
+      END DO
+      !
+      !                       !== Horizontal scale factors ==! (in meters)
+      !
+      !                                         ! constant grid spacing
+      pe1t(:,:) =  ze1     ;      pe2t(:,:) = ze1
+      pe1u(:,:) =  ze1     ;      pe2u(:,:) = ze1
+      pe1v(:,:) =  ze1     ;      pe2v(:,:) = ze1
+      pe1f(:,:) =  ze1     ;      pe2f(:,:) = ze1
+      !
+      !                                         ! NO reduction of grid size in some straits
+      ke1e2u_v = 0                              !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
+      pe1e2u(:,:) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that
+      pe1e2v(:,:) = 0._wp                       !             require an initialization of INTENT(out) arguments
+      !
+      !
+      !                       !==  Coriolis parameter  ==!
+      kff = 1                                            !  indicate not to compute ff afterward
+      !
+      pff_f(:,:) =  REAL( rn_f0, wp ) + REAL( rn_beta, wp ) * ABS( pphif(:,:) ) ! f = f0 +beta* y
+      pff_t(:,:) =  REAL( rn_f0, wp ) + REAL( rn_beta, wp ) * ABS( pphit(:,:) ) ! f = f0 +beta* y
+      !
+      IF(lwp) WRITE(numout,*) '                           beta-plane used. f0   = ', rn_f0 ,  ' 1/s'
+      IF(lwp) WRITE(numout,*) '                           beta-plane used. beta = ', rn_beta, ' 1/(s.m)'
+      !
+   END SUBROUTINE usr_def_hgr
+
+   !!======================================================================
+END MODULE usrdef_hgr
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_istate.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_istate.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_istate.F90	(revision 13562)
@@ -0,0 +1,68 @@
+MODULE usrdef_istate
+   !!======================================================================
+   !!                   ***  MODULE  usrdef_istate   ***
+   !!
+   !!                     ===  AM98 configuration  ===
+   !!
+   !! User defined : set the initial state of a user configuration
+   !!======================================================================
+   !! History :  4.0 ! 2016-03  (S. Flavoni) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  usr_def_istate : initial state in Temperature and salinity
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_istate   ! called in istate.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: usrdef_istate.F90 10069 2018-08-28 14:12:24Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+  
+   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE usr_def_istate  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers
+      !!                Here AM98 configuration example : (double gyre with rotated domain)
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity   field
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
+      !
+      INTEGER :: ji, jj, jk  ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_istate : analytical definition of initial state '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with an horizontally uniform T and S profiles'
+      !
+      pu  (:,:,:) = 0._wp        ! ocean at rest
+      pv  (:,:,:) = 0._wp
+      pssh(:,:)   = 0._wp
+!!an   
+       IF(lwp) WRITE(numout,*) "end istate"
+        call flush(numout)
+
+      !   
+   END SUBROUTINE usr_def_istate
+
+   !!======================================================================
+END MODULE usrdef_istate
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_nam.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_nam.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_nam.F90	(revision 13562)
@@ -0,0 +1,138 @@
+MODULE usrdef_nam
+   !!======================================================================
+   !!                     ***  MODULE usrdef_nam   ***
+   !!
+   !!                     ===  AM98 configuration  ===
+   !!
+   !! User defined : set the domain characteristics of a user configuration
+   !!======================================================================
+   !! History :  4.0  ! 2016-03  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_nam   : read user defined namelist and set global domain size
+   !!   usr_def_hgr   : initialize the horizontal mesh
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_nam   ! called in nemogcm.F90 module
+   !                              !!* namusr_def namelist *!!
+   INTEGER , PUBLIC ::   nn_AM98            ! 1/nn_AM98 = the resolution chosen in degrees and thus defining the horizontal domain size
+   REAL(wp), PUBLIC ::   rn_theta           ! rotation angle (in degree) of the grid
+   INTEGER , PUBLIC ::   nn_gc              ! number of ghostcells
+   REAL(wp), PUBLIC ::   rn_domsiz          ! size of the domain (default 2000km)  [m]
+   REAL(wp), PUBLIC ::   rn_dx              ! gridspacing (default 100km)          [m]
+   REAL(wp), PUBLIC ::   rn_tau             ! wind stress on the surface           [N/m2]
+   REAL(wp), PUBLIC ::   rn_f0              !    f-plan coriolis parameter         [1/s]
+   REAL(wp), PUBLIC ::   rn_beta            ! beta-plan coriolis parameter         [1/m.s]
+   REAL(wp), PUBLIC ::   rn_modified_grav   ! modified gravity                     [m/s2]
+   REAL(wp), PUBLIC ::   rn_rfr             ! layer friction                       [1/s]
+   !                              !!* temporary *!!
+   INTEGER , PUBLIC ::   nn_dynldf_lap_typ            ! choose type of laplacian (ideally from namelist)
+   !                                                  ! = 1   divrot    laplacian
+   !                                                  ! = 2   symmetric laplacian (Griffies&Hallberg 2000)
+   !                                                  ! = 3   symmetric laplacian (cartesian)
+   LOGICAL , PUBLIC ::   ln_dynldf_lap_PM             ! if True - apply the P.Marchand boundary condition on the laplacian
+   !                              !!* penalisation *!!
+   REAL(wp), PUBLIC ::   rn_abp             ! alpha boundary parameter                                       [-]
+   INTEGER , PUBLIC ::   nn_cnp             ! number of cell on which is smoothed the porosity (phi)         [-]
+   REAL(wp), PUBLIC ::   rn_fsp             ! friction parameter 1/epsilon of the permeability               [1/s]
+   !
+   REAL(wp), PUBLIC ::   r1_abp             ! inverse alpha boundary parameter                            [-]
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: usrdef_nam.F90 11536 2019-09-11 13:54:18Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_nam( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!
+      !! ** Purpose :   read user defined namelist and define the domain size
+      !!
+      !! ** Method  :   read in namusr_def containing all the user specific namelist parameter
+      !!
+      !!                Here AM98 configuration
+      !!
+      !! ** input   : - namusr_def namelist found in namelist_cfg
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER         , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER         , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
+      INTEGER         , INTENT(out) ::   kperio          ! lateral global domain b.c.
+      !
+      INTEGER  ::   ios             ! Local integer
+      REAL(wp) ::   ze1, zgl, zbl   ! gridspacing, length of the biggest square
+      !!
+      NAMELIST/namusr_def/ nn_AM98, rn_theta, jpkglo,           &   !
+         &                 nn_gc ,rn_domsiz, rn_dx,             &   ! domain parameters
+         &                 rn_f0 ,rn_beta,                      &   ! coriolis parameter
+         &                 rn_modified_grav, rn_rfr , rn_tau,   &   ! reduced gravity, friction, wind
+         &                 nn_dynldf_lap_typ, ln_dynldf_lap_PM, &   ! temporary parameter
+         &                 rn_abp, nn_cnp, rn_fsp                   ! penalisation parameters
+      !!----------------------------------------------------------------------
+      !
+      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist' )
+      !
+      IF(lwm)   WRITE( numond, namusr_def )
+      !
+      cd_cfg = 'AM98'               ! name & resolution (not used)
+
+#if defined key_agrif
+      IF (.NOT.Agrif_root()) nn_AM98 = Agrif_parent(nn_AM98) * Agrif_irhox()
+#endif
+
+      kk_cfg = nn_AM98
+       !
+      ze1 =  rn_dx / REAL(nn_AM98, wp)                   ! [m] gridspacing used
+      zgl =  rn_domsiz + 2._wp * REAL(nn_gc, wp) * ze1   ! [m] length of the square with ghostcells
+      ! rotation
+      zbl = zgl * ( COS( rn_theta * rad ) + SIN( rn_theta * rad ) )   ! length side bigger domain [m]
+      !
+      kpi = ceiling(zbl / ze1 )    ! Global Domain size + ghost cells
+      kpj = ceiling(zbl / ze1 )    ! Global Domain size + ghost cells
+      !
+      IF( rn_modified_grav /= 0._wp) grav = rn_modified_grav   ! update the gravity
+      !
+      kpk = jpkglo
+      !                             ! Set the lateral boundary condition of the global domain
+      kperio = 0                    ! AM98 configuration : closed domain
+      !
+# if defined key_bvp
+      r1_abp = 1._wp / rn_abp
+#endif
+      !                             ! control print
+      IF(lwp) THEN
+         WRITE(numout,*) '   '
+         WRITE(numout,*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namusr_def : AM98 case'
+         WRITE(numout,*) '                                   domain size       rn_domsiz   = ', rn_domsiz, 'm'
+         WRITE(numout,*) '                                   gridspacing           rn_dx   = ', rn_dx, 'm'
+         WRITE(numout,*) '      inverse resolution & implied domain size         nn_AM98   = ', nn_AM98
+         WRITE(numout,*) '                           implied gridspacing           rn_dx   = ', rn_dx, 'm'
+         WRITE(numout,*) '                          number of ghostcells           nn_gc   = ', nn_gc
+         WRITE(numout,*) '   '
+         WRITE(numout,*) '                    rotation angle chosen             rn_theta   = ', rn_theta, 'deg'
+         WRITE(numout,*) '                    modified gravity          rn_modified_grav   = ', rn_modified_grav, 'm2/s'
+         WRITE(numout,*) '      number of model levels                              jpkglo = ', kpk
+         WRITE(numout,*) '   '
+         WRITE(numout,*) '   Lateral b.c. of the global domain set to closed        jperio = ', kperio
+      ENDIF
+      !
+   END SUBROUTINE usr_def_nam
+
+   !!======================================================================
+END MODULE usrdef_nam
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_sbc.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_sbc.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_sbc.F90	(revision 13562)
@@ -0,0 +1,123 @@
+MODULE usrdef_sbc
+   !!======================================================================
+   !!                     ***  MODULE  usrdef_sbc  ***
+   !!
+   !!                     ===  GYRE configuration  ===
+   !!
+   !! User defined :   surface forcing of a user configuration
+   !!======================================================================
+   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usrdef_sbc    : user defined surface bounday conditions in GYRE case
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE phycst         ! physical constants
+   USE usrdef_nam
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran    !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usrdef_sbc_oce       ! routine called in sbcmod module
+   PUBLIC   usrdef_sbc_ice_tau   ! routine called by icestp.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx   ! routine called by icestp.F90 for ice thermo
+      
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: usrdef_sbc.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usrdef_sbc_oce( kt, Kbb )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE usrdef_sbc  ***
+      !!              
+      !! ** Purpose :   provide at each time-step the GYRE surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   analytical seasonal cycle for GYRE configuration.
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set the ocean surface boundary condition, i.e.   
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!
+      !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb  ! ocean time index
+      !!
+      INTEGER  ::   ji, jj                ! dummy loop indices
+      REAL(wp) ::   ztauu, ztauv          ! wind intensity projeted
+      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
+      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
+      !!---------------------------------------------------------------------
+
+      ! ---------------------------- !
+      !  heat and freshwater fluxes  !   (no fluxes)
+      ! ---------------------------- !
+      
+      emp (:,:) = 0._wp
+      sfx (:,:) = 0._wp
+      qns (:,:) = 0._wp
+
+      ! ---------------------------- !
+      !       momentum fluxes        !
+      ! ---------------------------- !
+      ! rotated case (45deg)
+      ! ztauu = 0.2_wp / SQRT( 2._wp )    ! N.m-2
+      ! ztauv = 0.2_wp / SQRT( 2._wp)     ! N.m-2
+      ! non rotated
+      !ztauu = 0.2_wp                    ! N.m-2
+      !ztauv = 0._wp                     ! N.m-2
+      ! general case
+      ztauu =   REAL( rn_tau, wp ) * COS( rn_theta * rad )   ! N.m-2
+      ztauv = - REAL( rn_tau, wp ) * SIN( rn_theta * rad )   ! N.m-2
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           ! length of the domain : 2000km x 2000km 
+           utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp)
+           vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp)
+         END DO
+      END DO
+     
+      ! module of wind stress and wind speed at T-point
+      zcoef = 1. / ( zrhoa * zcdrag ) 
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+            zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
+            taum(ji,jj) = zmod
+            wndm(ji,jj) = SQRT( zmod * zcoef )
+         END DO
+      END DO
+      
+      CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. )
+      !
+   END SUBROUTINE usrdef_sbc_oce
+
+
+   SUBROUTINE usrdef_sbc_ice_tau( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_tau
+
+
+   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
+   END SUBROUTINE usrdef_sbc_ice_flx
+
+   !!======================================================================
+END MODULE usrdef_sbc
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_zgr.F90
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_zgr.F90	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/usrdef_zgr.F90	(revision 13562)
@@ -0,0 +1,616 @@
+MODULE usrdef_zgr
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_zgr  ***
+   !!
+   !!                       ===  AM98 configuration  ===
+   !!
+   !! User defined : vertical coordinate system of a user configuration
+   !!======================================================================
+   !! History :  4.0  ! 2016-06  (G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_zgr   : user defined vertical coordinate system
+   !!      zgr_z      : reference 1D z-coordinate
+   !!      zgr_top_bot: ocean top and bottom level indices
+   !!      zgr_zco    : 3D verticl coordinate in pure z-coordinate case
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce        ! ocean domain
+   USE depth_e3       ! depth <=> e3
+   USE usrdef_nam
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+
+   USE usrdef_nam , ONLY : rn_dx, nn_AM98, rn_abp, r1_abp    ! use penalisation parameter
+
+   IMPLICIT NONE
+   PRIVATE
+   !
+   INTEGER, PARAMETER, PRIVATE  ::   nT  = 1
+   INTEGER, PARAMETER, PRIVATE  ::   nU  = 2
+   INTEGER, PARAMETER, PRIVATE  ::   nV  = 3
+   INTEGER, PARAMETER, PRIVATE  ::   nF  = 4
+   !
+   PUBLIC   usr_def_zgr        ! called by domzgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: usrdef_zgr.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
+      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
+      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
+      &                    pe3t  , pe3u  , pe3v   , pe3f ,             &   ! vertical scale factors
+      &                    pe3w  , pe3uw , pe3vw         ,             &   !     -      -      -
+      &                    k_top , k_bot                 )                 ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE usr_def_zgr  ***
+      !!
+      !! ** Purpose :   User defined the vertical coordinates
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
+      !
+      INTEGER  ::   inum   ! local logical unit
+      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_zgr : AM98 configuration (z-coordinate closed flat box ocean without cavities)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
+      ld_zco    = .FALSE.         ! AM98 case:  z-coordinate without ocean cavities
+      ld_zps    = .FALSE.
+      ld_sco    = .TRUE.
+      ld_isfcav = .FALSE.
+      !
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+      CALL zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
+      !
+      CALL zgr_msk_top_bot( k_top , k_bot)                 ! masked top and bottom ocean t-level indices
+      !
+      !                                                     ! z-coordinate (3D arrays) from the 1D z-coord.
+      CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in  : 1D reference vertical coordinate
+         &          pdept   , pdepw   ,                     &   ! out : 3D t & w-points depth
+         &          pe3t    , pe3u    , pe3v   , pe3f   ,   &   !       vertical scale factors
+         &          pe3w    , pe3uw   , pe3vw             )     !           -      -      -
+      !
+   END SUBROUTINE usr_def_zgr
+
+
+   SUBROUTINE zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z  ***
+      !!
+      !! ** Purpose :   set the 1D depth of model levels and the resulting
+      !!              vertical scale factors.
+      !!
+      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
+      !!       The depth of model levels is set from dep(k), an analytical function:
+      !!                   w-level: depw_1d  = dep(k)
+      !!                   t-level: dept_1d  = dep(k+0.5)
+      !!       The scale factors are the discrete derivative of the depth:
+      !!                   e3w_1d(jk) = dk[ dept_1d ]
+      !!                   e3t_1d(jk) = dk[ depw_1d ]
+      !!           with at top and bottom :
+      !!                   e3w_1d( 1 ) = 2 * ( dept_1d( 1 ) - depw_1d( 1 ) )
+      !!                   e3t_1d(jpk) = 2 * ( dept_1d(jpk) - depw_1d(jpk) )
+      !!       The depth are then re-computed from the sum of e3. This ensures
+      !!    that depths are identical when reading domain configuration file.
+      !!    Indeed, only e3. are saved in this file, depth are compute by a call
+      !!    to the e3_to_depth subroutine.
+      !!
+      !!       Here the Madec & Imbard (1996) function is used.
+      !!
+      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
+      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!
+      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!             Madec and Imbard, 1996, Clim. Dyn.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
+      !
+      INTEGER  ::   jk       ! dummy loop indices
+        !!----------------------------------------------------------------------
+      !
+        !
+      IF(lwp) THEN            ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates '
+         WRITE(numout,*) '    ~~~~~~~'
+      ENDIF
+
+      !
+      ! 1D Reference z-coordinate    (using Madec & Imbard 1996 function)
+      ! -------------------------
+      !
+      ! depth at T and W-points
+      pdepw_1d(1) =   0._wp
+      pdept_1d(1) = 250._wp
+      !
+      pdepw_1d(2) = 500._wp
+      pdept_1d(2) = 750._wp
+      !
+      !                       ! e3t and e3w from depth
+      CALL depth_to_e3( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d )
+      !
+      !                       ! recompute depths from SUM(e3)  <== needed
+      CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      !
+   END SUBROUTINE zgr_z
+
+
+
+
+   SUBROUTINE zgr_msk_top_bot( k_top , k_bot)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_msk_top_bot  ***
+      !!
+      !! ** Purpose :   set the masked top and bottom ocean t-levels
+      !!
+      !! ** Method  :   AM98 case = closed flat box ocean without ocean cavities
+      !!                   k_top = 1     except along north, south, east and west boundaries
+      !!                   k_bot = jpk-1 except along north, south, east and west boundaries
+      !!
+      !! ** Action  : - k_top : first wet ocean level index
+      !!              - k_bot : last  wet ocean level index
+      !!----------------------------------------------------------------------
+      INTEGER , DIMENSION(:,:), INTENT(out) ::   k_top , k_bot   ! first & last wet ocean level
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace
+      INTEGER  ::   ji, jj,jk, jl                    ! dummy loop indices
+      REAL(wp) ::   zylim0, zylim1, zxlim0, zxlim1 ! limit of the domain [m]
+      REAL(WP) ::   zcoeff    ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_top_bot : defines the top and bottom wet ocean levels.'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '       AM98 case : closed flat box ocean without ocean cavities'
+      !
+      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom
+      !
+      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed)
+      !
+      !
+# if defined key_bvp
+      ! Faire la pénalisation
+      ! ktop = where phi flotte < 1% puis envoie au mask
+      !  Penalize the first inner layer of fluid
+      ! -----------------------------------------------------
+      zylim0 =  10000._wp     ! +   10km
+      zylim1 = 2010000._wp    !   2010km
+      zxlim0 = -200000._wp    ! -  200km   - zgr_pse
+      zxlim1 = 2010000._wp    !   2010km
+      rpo (:,:,:) = rn_abp  ;   rpou(:,:,:) = rn_abp  ;   rpov(:,:,:) = rn_abp   ;   rpof(:,:,:) = rn_abp
+      !
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+           ! it is "largely" whithin the box
+           IF ( gphit(ji,jj) > zylim0 .AND. gphit(ji,jj) < zylim1 .AND. &
+              & glamt(ji,jj) > zxlim0 .AND. glamt(ji,jj) < zxlim1       )  THEN
+              CALL zgr_pse (ji,jj,1,glamf,gphif,rpo , nT )
+              CALL zgr_pse (ji,jj,1,glamt,gphit,rpof, nF )
+              CALL zgr_pse (ji,jj,1,glamv,gphiv,rpou, nU )
+              CALL zgr_pse (ji,jj,1,glamu,gphiu,rpov, nV )
+           END IF
+        END DO
+      END DO
+      !
+      r1_rpo (:,:,:) = r1_abp ; r1_rpou(:,:,:) = r1_abp ; r1_rpov(:,:,:) = r1_abp
+      bmpt   (:,:,:) = 0._wp  ; bmpu   (:,:,:) = 0._wp  ; bmpv   (:,:,:) = 0._wp
+      !
+      r1_rpof(:,:,:) = r1_abp
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           !
+           ! thinner
+           !bmpu(ji,jj, 1:jpkm1) = rn_fsp * ( 1._wp - rpou(ji,jj,1:jpkm1) )
+           !bmpv(ji,jj, 1:jpkm1) = rn_fsp * ( 1._wp - rpov(ji,jj,1:jpkm1) )
+           ! classic constant
+           IF( rpou(ji,jj,1) < 1._wp )   bmpu(ji,jj, 1:jpkm1) = rn_fsp
+           IF( rpov(ji,jj,1) < 1._wp )   bmpv(ji,jj, 1:jpkm1) = rn_fsp
+           !
+           r1_rpo (ji,jj,1:jpkm1) = 1._wp / rpo (ji,jj,1:jpkm1)
+           r1_rpou(ji,jj,1:jpkm1) = 1._wp / rpou(ji,jj,1:jpkm1)
+           r1_rpov(ji,jj,1:jpkm1) = 1._wp / rpov(ji,jj,1:jpkm1)
+           r1_rpof(ji,jj,1:jpkm1) = 1._wp / rpof(ji,jj,1:jpkm1)
+        END DO
+      END DO
+      !
+      WHERE(rpo(:,:,1) <= rn_abp )
+        rpo  (:,:,1) = rn_abp
+      END WHERE
+      WHERE(rpou(:,:,1) <= rn_abp )
+        rpou  (:,:,1) = rn_abp
+      END WHERE
+      WHERE(rpov(:,:,1) <= rn_abp )
+        rpov  (:,:,1) = rn_abp
+      END WHERE
+      WHERE(rpof(:,:,1) <= rn_abp )
+        rpof  (:,:,1) = rn_abp
+      END WHERE
+      !
+      ! definition du mask
+      k_top(:,:) = 1    ! = ocean
+      k_bot(:,:) = NINT( z2d(:,:) )
+      WHERE(rpo(:,:,1) <= rn_abp )
+        k_top(:,:) = 0    ! = land
+        k_bot(:,:) = 0
+      END WHERE
+      !
+      CALL lbc_lnk_multi( 'usrdef_zgr', rpo , 'T', 1._wp, r1_rpo  , 'T', 1._wp,                   &
+             &                          rpou, 'U', 1._wp, r1_rpou , 'U', 1._wp, bmpu, 'U', 1._wp,    &
+             &                          rpov, 'V', 1._wp, r1_rpov , 'V', 1._wp, bmpv, 'V', 1._wp,    &
+             &                          rpof, 'F', 1._wp, r1_rpof , 'F', 1._wp, kfillmode=jpfillcopy )
+# else
+      ! Dans l'idéal, j'aimerais bien pouvoir me passer de cette boucle
+      zylim0 =   10000._wp    !  +10km
+      zylim1 = 2010000._wp    ! 2010km
+      zxlim0 =   10000._wp    !  +10km
+      zxlim1 = 2010000._wp    ! 2010km
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+         ! if T point in the 2000 km x 2000 km domain
+         ! IF ( gphit(ji,jj) > zylim0 .AND. gphit(ji,jj) < zylim1 .AND. &
+         !   & glamt(ji,jj) > zxlim0 .AND. glamt(ji,jj) < zxlim1       )  THEN
+         ! if U,V points are in the 2000 km x 2000 km domain
+         IF ( gphiv(ji,jj) > zylim0 .AND. gphiv(ji,jj) < zylim1 .AND. &
+            & glamu(ji,jj) > zxlim0 .AND. glamu(ji,jj) < zxlim1       )  THEN
+         k_top(ji,jj) = 1    ! = ocean
+         k_bot(ji,jj) = NINT( z2d(ji,jj) )
+         ELSE
+         k_top(ji,jj) = 0    ! = land
+         k_bot(ji,jj) = 0
+         END IF
+         END DO
+      END DO
+      ! mask the lonely corners
+      DO jj = 2, jpim1
+         DO ji = 2, jpim1
+         zcoeff = k_top(ji+1,jj) + k_top(ji,jj+1)   &
+            +     k_top(ji-1,jj) + k_top(ji,jj-1)
+         IF ( zcoeff <= 1._wp )   THEN
+            k_top(ji,jj) = 0    ! = land
+            k_bot(ji,jj) = 0
+         END IF
+         END DO
+      END DO
+
+# endif
+
+   END SUBROUTINE zgr_msk_top_bot
+
+
+   SUBROUTINE zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in : 1D reference vertical coordinate
+      &                pdept   , pdepw   ,                     &   ! out: 3D t & w-points depth
+      &                pe3t    , pe3u    , pe3v   , pe3f   ,   &   !      vertical scale factors
+      &                pe3w    , pe3uw   , pe3vw             )     !          -      -      -
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zco  ***
+      !!
+      !! ** Purpose :   define the reference z-coordinate system
+      !!
+      !! ** Method  :   set 3D coord. arrays to reference 1D array
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
+      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth          [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
+      !
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         pdept(:,:,jk) = pdept_1d(jk)
+         pdepw(:,:,jk) = pdepw_1d(jk)
+         pe3t (:,:,jk) = pe3t_1d (jk)
+         pe3u (:,:,jk) = pe3t_1d (jk)
+         pe3v (:,:,jk) = pe3t_1d (jk)
+         pe3f (:,:,jk) = pe3t_1d (jk)
+         pe3w (:,:,jk) = pe3w_1d (jk)
+         pe3uw(:,:,jk) = pe3w_1d (jk)
+         pe3vw(:,:,jk) = pe3w_1d (jk)
+      END DO
+      !
+   END SUBROUTINE zgr_zco
+
+
+   SUBROUTINE zgr_pse( ki, kj, kk,                  &
+      &                pglam,pgphi,prpo,            &
+      &                cpoint                       )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_pse  ***
+      !!
+      !! ** Purpose :   Estimate the porosity field within the cell
+      !!
+      !! ** Method  :   find the intersection points with the boundaries
+      !!                calculate the area land/water
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   ki, kj, kk    ! coordinate of the center of the cell
+      REAL, DIMENSION(:,:)      , INTENT(in   ) ::   pglam, pgphi  ! grid-point position          [m]
+      REAL, DIMENSION(:,:,:)    , INTENT(inout) ::   prpo          ! porosity field
+      INTEGER                   , INTENT(in   ) ::   cpoint        ! type of point in the C-grid
+                                                                   ! T : 1, U : 2, V : 3, F : 4
+      INTEGER  ::  jtype, jlen                     ! geometrical figure ; nearest land(=0)/water(=1) point
+      REAL ::   z1d, z1_dx, zl                     ! dummy variable
+      REAL, DIMENSION(2) ::   zA, zB, zC, zD, zM   ! coordinate array M(x,y)
+      !
+      INTEGER  ::   jkM                      ! local index of intersection points
+      REAL,    DIMENSION(2)    :: zlm        ! save the lenght alond the edges
+      INTEGER, DIMENSION(4)    :: zsp, zss   ! Sign Points, sum sign
+                                             ! define the positions of points to the limit
+      !!----------------------------------------------------------------------
+      !
+      z1_dx =   REAL(nn_AM98, wp) / rn_dx       ! [1/m] inverse gridspacing used
+      !REAL :: dx = 1.
+      !REAL :: z1_dx =   1.       ! [1/m] inverse gridspacing used
+      !
+      ! WRITE(*,*) 'BEGINNING of the routine zgr_pse'
+      !                                      !==  Preparatory work  ==!
+      SELECT CASE ( cpoint )                     !* Defining vertices
+        CASE ( nT )                                               ! F coordinates
+          zA(1) = pglam(ki-1,kj-1 ) ; zA(2) = pgphi(ki-1,kj-1 )
+          zB(1) = pglam(ki  ,kj-1 ) ; zB(2) = pgphi(ki  ,kj-1 )
+          zC(1) = pglam(ki  ,kj   ) ; zC(2) = pgphi(ki  ,kj   )
+          zD(1) = pglam(ki-1,kj   ) ; zD(2) = pgphi(ki-1,kj   )
+        CASE ( nF )                                               ! T coordinates
+          zA(1) = pglam(ki  ,kj   ) ; zA(2) = pgphi(ki  ,kj   )
+          zB(1) = pglam(ki+1,kj   ) ; zB(2) = pgphi(ki+1,kj   )
+          zC(1) = pglam(ki+1,kj+1 ) ; zC(2) = pgphi(ki+1,kj+1 )
+          zD(1) = pglam(ki  ,kj+1 ) ; zD(2) = pgphi(ki  ,kj+1 )
+        CASE ( nU )                                               ! V coordinates
+          zA(1) = pglam(ki  ,kj-1 ) ; zA(2) = pgphi(ki  ,kj-1 )
+          zB(1) = pglam(ki+1,kj-1 ) ; zB(2) = pgphi(ki+1,kj-1 )
+          zC(1) = pglam(ki+1,kj   ) ; zC(2) = pgphi(ki+1,kj   )
+          zD(1) = pglam(ki  ,kj   ) ; zD(2) = pgphi(ki  ,kj   )
+        CASE ( nV )                                               ! U coordinates
+          zA(1) = pglam(ki-1,kj   ) ; zA(2) = pgphi(ki-1,kj   )
+          zB(1) = pglam(ki  ,kj   ) ; zB(2) = pgphi(ki  ,kj   )
+          zC(1) = pglam(ki  ,kj+1 ) ; zC(2) = pgphi(ki  ,kj+1 )
+          zD(1) = pglam(ki-1,kj+1 ) ; zD(2) = pgphi(ki-1,kj+1 )
+      END SELECT
+      !
+        ! WRITE(*,*) ' zA = ',zA
+        ! WRITE(*,*) ' zB = ',zB
+        ! WRITE(*,*) ' zC = ',zC
+        ! WRITE(*,*) ' zD = ',zD
+      !
+      !                                       zss(3)
+      !                                zsp(4)   |     zsp(3)
+      !      D --------- C                 D --------- C
+      !      |           |                 |           |
+      !      |     +     |         zss(4)--|     +     |-- zss(2)
+      !      |  (ki,kj)  |                 |           |
+      !      A --------- B                 A --------- B
+      !                                zsp(1)   |     zsp(2)
+      !                                       zss(1)
+      !
+      ! !! case 1 : (x=)glam = 0             !* Defining position to the boundary
+      ! !! 1 = is in water ; 0 in land
+      ! zsp(:) = 0   ;   zss(:) = 0
+      ! IF ( zA(1) > ( 0. )  )   zsp(1) = 1    ! A
+      ! IF ( zB(1) > ( 0. )  )   zsp(2) = 1    ! B
+      ! IF ( zC(1) > ( 0. )  )   zsp(3) = 1    ! C
+      ! IF ( zD(1) > ( 0. )  )   zsp(4) = 1    ! D
+      ! !
+      !! case 1 : (x=)glam = 0             !* Defining position to the boundary
+      !! 1 = is in water ; 0 in land
+      zsp(:) = 0   ;   zss(:) = 0
+      IF ( zA(1) > ( 0. )  )   zsp(1) = 1    ! A
+      IF ( zB(1) > ( 0. )  )   zsp(2) = 1    ! B
+      IF ( zC(1) > ( 0. )  )   zsp(3) = 1    ! C
+      IF ( zD(1) > ( 0. )  )   zsp(4) = 1    ! D
+      !
+      ! !! case 2 : (x=)gphi = 2000 km       !* Defining position to the boundary
+      ! !! 1 = is in water ; 0 in land
+      ! zsp(:) = 0   ;   zss(:) = 0
+      ! IF ( zA(2) < ( 200000. )  )   zsp(1) = 1    ! A
+      ! IF ( zB(2) < ( 200000. )  )   zsp(2) = 1    ! B
+      ! IF ( zC(2) < ( 200000. )  )   zsp(3) = 1    ! C
+      ! IF ( zD(2) < ( 200000. )  )   zsp(4) = 1    ! D
+      !
+      zss(1) = zsp(1) + zsp(2)
+      zss(2) = zsp(2) + zsp(3)
+      zss(3) = zsp(3) + zsp(4)
+      zss(4) = zsp(4) + zsp(1)
+      !
+      IF      ( SUM( zsp(:) ) == 3 )  THEN
+         jtype = 1   ;   jlen = 0
+         ! WRITE(*,*) 'land triangle'
+      ELSE IF ( SUM( zsp(:) ) == 2 )  THEN
+         jtype = 2   ;  jlen = 1
+         ! WRITE(*,*) 'water trapeze'
+      ELSE IF ( SUM( zsp(:) ) == 1 )  THEN
+         jtype = 3    ;  jlen = 1
+         ! WRITE(*,*) 'water triangle'
+      ELSE IF ( pglam(ki,kj) > 0._wp ) THEN
+         ! SUM( zsp(:) ) == 4
+         ! prpo(ki,kj,kk) = prpo(ki,kj,kk) + 1._wp
+         prpo(ki,kj,kk) =  1._wp
+         ! full water
+         RETURN
+      ELSE
+        ! full land
+        RETURN
+      ENDIF
+      !
+      ! WRITE(*,*) ' zsp = ',zsp(4), zsp(3)
+      ! WRITE(*,*) '       ',zsp(1), zsp(2)
+      !
+      zlm(:) = 0.
+      !                            !==  Searching for the intersection points  ==!
+      !!                                !* NS west boundary
+      zM(1) = 0.
+      ! WRITE(*,*) ' zlm = ',zlm
+      jkM = 1
+       !    A ------- B
+      IF ( zss(1) == 1 ) THEN
+        zM(2) = weightedMx(zA,zB, z1_dx, 0.)
+        !
+        IF (zsp(1) == jlen) THEN
+          ! WRITE(*,*) ' AM '
+          zlm(jkM) = lenght(zA,zM)
+        ELSE
+          ! WRITE(*,*) ' MB '
+          zlm(jkM) = lenght(zB,zM)
+        ENDIF
+        jkM = jkM + 1
+        ! WRITE(*,*) ' '
+        ! WRITE(*,*) ' zM = ', zM
+        ! WRITE(*,*) ' zlm = ',zlm
+      ENDIF
+       !   C
+       !   |
+       !   |
+       !   |
+       !   B
+      IF ( zss(2) == 1 ) THEN
+        zM(2) = weightedMx(zB,zC, z1_dx,0.)
+        !
+        IF (zsp(2) == jlen) THEN
+          zlm(jkM) = lenght(zB,zM)
+        ELSE
+          zlm(jkM) = lenght(zC,zM)
+        ENDIF
+        jkM = jkM + 1
+        ! WRITE(*,*) ' '
+        ! WRITE(*,*) ' BC '
+        ! WRITE(*,*) ' zM = ', zM
+        ! WRITE(*,*) ' zlm = ',zlm
+      ENDIF
+      !  !      D ------- C
+      IF ( zss(3) == 1 ) THEN
+        zM(2) = weightedMx(zC,zD, z1_dx,0.)
+        !
+        IF (zsp(3) == jlen) THEN
+          ! WRITE(*,*) ' CM '
+          zlm(jkM) = lenght(zC,zM)
+        ELSE
+          ! WRITE(*,*) ' MD '
+          zlm(jkM) = lenght(zD,zM)
+        ENDIF
+        jkM = jkM + 1
+        ! WRITE(*,*) ' '
+        ! WRITE(*,*) ' zM = ', zM
+        ! WRITE(*,*) ' zlm = ',zlm
+      ENDIF
+      !  !   D
+      !      |
+      !      |
+      !      |
+      !      A
+      IF ( zss(4) == 1 ) THEN
+        zM(2) = weightedMx(zD,zA, z1_dx, 0.)
+        !
+        IF (zsp(4) == jlen) THEN
+          zlm(jkM) = lenght(zD,zM)
+        ELSE
+          zlm(jkM) = lenght(zA,zM)
+        ENDIF
+        jkM = jkM + 1
+        ! WRITE(*,*) ' '
+        ! WRITE(*,*) ' DA '
+        ! WRITE(*,*) ' zM = ', zM
+        ! WRITE(*,*) ' zlm = ',zlm
+      ENDIF
+      ! WRITE(*,*) 'ENDIF  zlm = ',zlm
+      !
+      !
+      !                           !==  Calculating land area  ==!
+      !  ratio of water upon the surface
+      IF     (jtype == 1) THEN    ! land triangle
+        z1d = 1. - 0.5 * zlm(1) * zlm(2) * z1_dx * z1_dx
+      ELSEIF (jtype == 2) THEN    ! water trapeze
+        z1d =      0.5 * ( zlm(1) + zlm(2) ) * z1_dx
+      ELSEIF (jtype == 3) THEN    ! water triangle
+        z1d =      0.5 * zlm(1) * zlm(2) * z1_dx * z1_dx
+      ENDIF
+      ! update the porosity field in += manner
+      ! prpo(ki,kj,kk) = prpo(ki,kj,kk) + z1d
+      prpo(ki,kj,kk) = z1d
+      ! WRITE(*,*) 'prpo(ki,kj,kk)=',prpo(ki,kj,kk)
+      ! ...
+      ! NS east boundary
+      ! WE south boundary
+      ! WE north boundary
+      !
+      !
+      ! WRITE(*,*) 'END of the routine zgr_pse'
+      !
+   END SUBROUTINE zgr_pse
+
+
+   FUNCTION weightedMx(A,B,z1_dx,xl)  RESULT(f)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE weightedM  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, DIMENSION(2), INTENT(in) :: A,B
+      REAL,                 INTENT(in) :: z1_dx, xl
+      REAL                             ::  f                 ! result
+      !!----------------------------------------------------------------------
+      !
+      f  =    (   A(2) * ( B(1) - xl     )    &
+         &    +   B(2) * ( xl     - A(1) )    )   &
+         &    /            ( B(1) - A(1) )
+      !
+   END FUNCTION weightedMx
+
+   FUNCTION lenght(A,B)  RESULT(f)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE weighted_lenght_X  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, DIMENSION(2), INTENT(in) :: A,B
+      REAL             ::  f                   ! result
+      !!----------------------------------------------------------------------
+      !
+      f  = SQRT(   ( A(1) - B(1) ) * ( A(1) - B(1) )    &
+         &     +   ( A(2) - B(2) ) * ( A(2) - B(2) )    )
+      !
+   END FUNCTION lenght
+
+
+   !!======================================================================
+END MODULE usrdef_zgr
Index: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/cpp_penzAM98.fcm
===================================================================
--- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/cpp_penzAM98.fcm	(revision 13562)
+++ NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/cpp_penzAM98.fcm	(revision 13562)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys  key_mpp_mpi key_iomput 
